Fév 26

Ecran de veille avec FireMonkey

Delphi , Développement Ajouter un commentaire

Je vais sauvegarder mes paramètres dans la base de registre de Windows. Cela permet ainsi de voir comment y accéder depuis une application FireMonkey. Comme tout le restant du code de ce projet, des optimisations/améliorations peuvent être faites… ;)
Pour cela, j’ai codé l’unité uShared ainsi :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
unit uShared;

interface

uses System.Win.Registry, Winapi.Windows;

const
  REGISTRY_PATH = '\Software\Whiler\wSnowflakes';
  REG_SIZE      = 'Size';
  REG_FREQUENCY = 'Frequency';

type
  TConfig = class
  private
    class procedure SetSize(dSize: Double); static;
    class function  GetSize: Double; static;
    class procedure SetFrequency(iFrequency: Integer); static;
    class function  GetFrequency: Integer; static;
  public
    class property Size     : Double  read GetSize      write SetSize;
    class property Frequency: Integer read GetFrequency write SetFrequency;
  end;

implementation

{ TConfig }

class function TConfig.GetFrequency: Integer;
var
  reg: TRegistry;
begin
  Result := 25;
  reg    := TRegistry.Create;
  try
    reg.RootKey := HKEY_CURRENT_USER;
    reg.OpenKeyReadOnly(REGISTRY_PATH);
    if reg.ValueExists(REG_FREQUENCY) then
    begin
      Result := reg.ReadInteger(REG_FREQUENCY);
    end;
    reg.CloseKey;
  finally
    reg.Free;
  end;
end;

class function TConfig.GetSize: Double;
var
  reg: TRegistry;
begin
  Result := 0.25;
  reg    := TRegistry.Create;
  try
    reg.RootKey := HKEY_CURRENT_USER;
    reg.OpenKeyReadOnly(REGISTRY_PATH);
    if reg.ValueExists(REG_SIZE) then
    begin
      Result := reg.ReadFloat(REG_SIZE);
    end;
    reg.CloseKey;
  finally
    reg.Free;
  end;
end;

class procedure TConfig.SetFrequency(iFrequency: Integer);
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CURRENT_USER;
    reg.OpenKey(REGISTRY_PATH, True);
    reg.WriteInteger(REG_FREQUENCY, iFrequency);
    reg.CloseKey;
  finally
    reg.Free;
  end;
end;

class procedure TConfig.SetSize(dSize: Double);
var
  reg  : TRegistry;
  value: Extended;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CURRENT_USER;
    reg.OpenKey(REGISTRY_PATH, True);
    reg.WriteFloat(REG_SIZE, dSize);
    reg.CloseKey;
  finally
    reg.Free;
  end;
end;

end.

Je conçois l’interface graphique de la fiche pour la configuration, frmConfig, ainsi :

Conception de la fiche pour la configuration

Conception de la fiche pour la configuration


Son code associé est le suivant :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
unit fConfig;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Objects, Winapi.ShellAPI, Winapi.Windows, FMX.Layouts;

type
  TfrmConfig = class(TForm)
    tbSize: TTrackBar;
    lblSize: TLabel;
    lblFrequency: TLabel;
    tbFrequency: TTrackBar;
    btnCancel: TButton;
    imgCancel: TImage;
    btnOk: TButton;
    imgOk: TImage;
    cpnlfrequency: TCalloutPanel;
    cpnlSize: TCalloutPanel;
    lblSizevalue: TLabel;
    lblFrequencyValue: TLabel;
    Image1: TImage;
    GroupBox1: TGroupBox;
    ScaledLayout1: TScaledLayout;
    procedure btnCancelClick(Sender: TObject);
    procedure btnOkClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure tbSizeChange(Sender: TObject);
    procedure tbFrequencyChange(Sender: TObject);
    procedure Image1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmConfig: TfrmConfig;

implementation

{$R *.fmx}

uses uShared;

procedure TfrmConfig.btnCancelClick(Sender: TObject);
begin
  Self.Close;
end;

procedure TfrmConfig.btnOkClick(Sender: TObject);
var
  value: Extended;
begin
  // Sauvegarder
  value := 8 - tbSize.Value;
  if (value = 0) then
  begin
    value := 2;
  end
  else
  begin
    value := 1 / value;
  end;
  TConfig.Size      := value;
  TConfig.Frequency := Round(tbFrequency.Value);

  Self.Close;
end;

procedure TfrmConfig.FormCreate(Sender: TObject);
var
  value: Extended;
begin
  // Initialiser
  value := TConfig.Size;
  if (value > 1) then
  begin
    value := 8;
  end
  else
  begin
    value := 8 - Round(1 / value);
  end;
  tbSize.Value      := value;
  tbFrequency.Value := TConfig.Frequency;

  tbSizeChange(tbSize);
  tbFrequencyChange(tbFrequency);
end;

procedure TfrmConfig.Image1Click(Sender: TObject);
begin
  ShellExecute(0, 'OPEN', 'https://dragonartz.wordpress.com/2008/10/28/snow-flakes-vector-set/', nil, nil, SW_SHOWNORMAL);
end;

procedure TfrmConfig.tbFrequencyChange(Sender: TObject);
begin
  lblFrequencyValue.Text := IntToStr(Round(tbFrequency.Value)) + ' ms';
end;

procedure TfrmConfig.tbSizeChange(Sender: TObject);
begin
  lblSizevalue.Text    := IntToStr(Succ(Round(tbSize.Value)));
  lblSizevalue.Scale.X := 0.5 + (tbSize.Value) / 10;
  lblSizevalue.Scale.Y := lblSizevalue.Scale.X;
end;

end.

Sur la page suivante, le code pour la gestion d’un flocon ainsi que la fiche pour l’écran de veille, frmMain…

Share

Pages : 1 2 3 4

Lien permanent vers Ecran de veille avec FireMonkey Rédigé par Whiler \\ Tags : , , , ,

6 réponses pour “Ecran de veille avec FireMonkey”

  1. Whiler a dit : Le 26 février 2012 à 15 h 23 mn

    Version 1.0.1.1 :

    • Ajout de l’affichage d’informations :si l’on appuie sur la touche i de son clavier, les infos sont affichées/masquées

    Informations

    Répondre

  2. philgoodgood a dit : Le 26 février 2012 à 16 h 12 mn

    bonjour
    @Whiler : j’adore mais au lieu de gérer un flocon (on en a assez eu cet hiver non ! |-( ) mois j’aimerais bien avec une petite araignée
    Si on pouvait choisir son bitmap (bow)

    ps : ton répertoire http://www.whiler.com/freewares/dl/ est accessible …et par là à ta liste de dvd 8-) normal ?

    bonne fin de semaine

    Répondre

  3. Whiler a dit : Le 26 février 2012 à 16 h 26 mn

    @ philgoodgood : Merci pour la sécurité du répertoire… c’est corrigé… (y)

    Pour ce qui est du bitmap, j’y ai pensé.. mais typiquement, une araignée, ça peut aller dans tous les sens (lol) pas seulement descendre… ça serait bizarre… |-(
    Si tu me files une jolie araignée sur fond transparent, et encore mieux, des sprites pour lui faire bouger les pattes… pourquoi pas ;)

    Répondre

  4. philgoodgood a dit : Le 26 février 2012 à 16 h 32 mn

    @Whiler : Ah ben tu es plus rapide que le fbi … déjà verrouillé …

    oui a l’occasion j’dis pas non (lol)

    ++

    Répondre

  5. Whiler a dit : Le 26 février 2012 à 16 h 40 mn

    @ philgoodgood : Pour info, en bas à droite de chaque message, il y a un bouton Répondre… si tu cliques dessus, ça t’évitera de taper le @user comme tu sembles le faire ;)

    Répondre

  6. philgoodgood a dit : Le 26 février 2012 à 18 h 51 mn

    @ Whiler : à yes While … comme je suis strong (devil)

    Répondre

Laisser une réponse

(requis)

(requis)

Code Anti-spam

*

;) (lol) (y) |-( (hi) 8-) (angel) :s (clap) (bow) (tmi) (:| plus »

Ce site utilise Akismet pour réduire les indésirables. En savoir plus sur la façon dont les données de vos commentaires sont traitées.