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 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
| unit Classe2;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls;
type
TForm1 = class(TForm)
BtTest: TButton;
Edit1: TEdit;
procedure BtTestClick(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
procedure cmdValideClick(Sender:TObject);
procedure tbChoixChange(Sender:TObject);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.cmdValideClick(Sender:TObject);
begin
TForm(TButton(Sender).Parent).ModalResult :=mrOk;
end;
procedure TForm1.tbChoixChange(Sender:TObject);
begin
// TForm(TTrackBar(Sender).Parent).lblResult.Caption:= IntToStr(Sender.Position);
end;
procedure TForm1.BtTestClick(Sender: TObject);
var
Fiche : TForm;
tbChoix : TTrackBar;
cmdValide : TButton;
lblTitre : TLabel;
lblResult : TLabel;
begin
Fiche:=TForm.Create(nil); // Crée la nouvelle fiche
With Fiche do // qui contiendra l'ensemble
Begin
BorderIcons :=[]; // Enlève menu system
Caption :=''; // Enlève le titre
BorderStyle :=bsToolWindow; // Resize impossible
Color := clTeal; // Couleur
Position := poScreenCenter; // Position au entre de l'écran
End;
SetWindowPos(Fiche.Handle,HWND_TOPMOST,
0,0,0,0,SWP_NOSIZE+SWP_NOMOVE); //Make the Window TOPMOST
lblResult:=TLabel.Create(nil); // Crée le nouveau TLabel qui
With lblResult do // Affiche la position de tbChoix
Begin
Caption :='...';
AutoSize := True;
Top :=((Fiche.ClientHeight div 5)*4)-(Height div 2);
Left :=(Fiche.ClientWidth div 2)-(Width div 2);
Height := 22;
Font.Charset := ANSI_CHARSET;
Font.Color := clYellow;
Font.Height := -30;
Font.Name := 'Bas Relief';
Font.Style := [fsBold];
ParentFont := False;
Parent := Fiche;
End;
tbChoix:=TTrackBar.Create(nil); // Crée le nouveau TTrackBar
With tbChoix do
Begin
OnChange := tbChoixChange; //associe OnChange
Width :=(Fiche.Width div 10)*8; //80% de la largeur de la fenêtre
Top :=(Fiche.ClientHeight div 2)-(Height div 2);
Left :=(Fiche.ClientWidth div 2)-(Width div 2);
Min :=1;
Max :=20;
Parent := Fiche;
End;
cmdValide:=TButton.Create(nil);
With cmdValide do
Begin
OnClick := cmdValideClick; //associe OnClick
Caption :='Valide!';
Top := tbChoix.Top + tbChoix.Height+3;
Left :=(Fiche.ClientWidth div 2)-(Width div 2);
Parent :=Fiche;
End;
lblTitre:=TLabel.Create(nil); // Crée le nouveau TLabel qui
With lblTitre do // Affiche le Titre
Begin
Caption :='FORCE';
AutoSize := True;
Top :=(Fiche.ClientHeight div 5)-(Height div 2);
Left :=(Fiche.ClientWidth div 2)-(width div 2);
Height := 22;
Font.Charset := ANSI_CHARSET;
Font.Color := clYellow;
Font.Height := -30;
Font.Name := 'Bas Relief';
Font.Style := [fsBold];
ParentFont := False;
Parent := Fiche;
End;
Application.ProcessMessages;
Fiche.ShowModal; //Montre la fenêtre
try
Edit1.Text := IntToStr(tbChoix.Position);
finally
lblResult.Destroy();
lblTitre.Destroy();
tbChoix.Destroy();
cmdValide.Destroy();
Fiche.Hide();
Fiche.Release();
end;
end;
end. |
Partager