root / UFTarif.pas
Historique | Voir | Annoter | Télécharger (4,04 ko)
1 | 3 | avalancogn | unit UFTarif ;
|
---|---|---|---|
2 | |||
3 | interface
|
||
4 | |||
5 | uses
|
||
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, |
||
7 | Dialogs, Grids, ValEdit, StdCtrls, PBNumEdit, UVariables, gnugettext; |
||
8 | |||
9 | type
|
||
10 | TFTarif = class(TForm)
|
||
11 | LBAliment: TListBox; |
||
12 | LAliment: TLabel; |
||
13 | PBPrix: TPBNumEdit; |
||
14 | LMonnaie: TLabel; |
||
15 | procedure FormClose(Sender: TObject; var Action: TCloseAction); |
||
16 | procedure FormShow(Sender: TObject);
|
||
17 | procedure FormActivate(Sender: TObject);
|
||
18 | procedure FormDeactivate(Sender: TObject);
|
||
19 | procedure LBAlimentClick(Sender: TObject);
|
||
20 | procedure PBPrixChange(Sender: TObject);
|
||
21 | procedure LBAlimentDrawItem(Control: TWinControl; Index: Integer;
|
||
22 | Rect: TRect; State: TOwnerDrawState); |
||
23 | procedure PBPrixKeyPress(Sender: TObject; var Key: Char); |
||
24 | procedure FormCreate(Sender: TObject);
|
||
25 | private
|
||
26 | { D?clarations priv?es }
|
||
27 | Update, Modified : boolean ; |
||
28 | procedure Save ;
|
||
29 | public
|
||
30 | { D?clarations publiques }
|
||
31 | end;
|
||
32 | |||
33 | var
|
||
34 | FTarif: TFTarif; |
||
35 | |||
36 | implementation
|
||
37 | |||
38 | uses
|
||
39 | UStrings, UInit, UFindRec ; |
||
40 | |||
41 | {$R *.dfm}
|
||
42 | |||
43 | { TFTarif }
|
||
44 | |||
45 | procedure TFTarif.FormCreate(Sender: TObject);
|
||
46 | begin
|
||
47 | if Screen.Fonts.IndexOf('Arial Unicode MS') <> -1 |
||
48 | then
|
||
49 | Font.Name := 'Arial Unicode MS';
|
||
50 | TranslateComponent(Self); |
||
51 | Constraints.MinWidth := 304 + (Width - ClientWidth);
|
||
52 | Width := Constraints.MinWidth; |
||
53 | Constraints.MinHeight := 328 + (Height - ClientHeight);
|
||
54 | Height := Constraints.MinHeight; |
||
55 | end;
|
||
56 | |||
57 | procedure TFTarif.FormShow (Sender : TObject) ;
|
||
58 | begin
|
||
59 | Modified := FALSE ; |
||
60 | end ;
|
||
61 | |||
62 | procedure TFTarif.FormClose (Sender : TObject ; var Action : TCloseAction) ; |
||
63 | begin
|
||
64 | if Modified then Save ; |
||
65 | Action := caFree ; |
||
66 | NumWinTarif := -1 ;
|
||
67 | end ;
|
||
68 | |||
69 | procedure TFTarif.FormActivate (Sender : TObject) ;
|
||
70 | begin
|
||
71 | LMonnaie.Caption := Format ('%s / 1000 %s', [CurrencySign, StrKg]) ;
|
||
72 | StringsAliment (LBAliment.Items, 0, TRUE) ;
|
||
73 | LBAlimentClick (nil) ;
|
||
74 | end ;
|
||
75 | |||
76 | procedure TFTarif.FormDeactivate (Sender : TObject) ;
|
||
77 | begin
|
||
78 | if Modified then Save ; |
||
79 | end ;
|
||
80 | |||
81 | procedure TFTarif.Save ;
|
||
82 | begin
|
||
83 | Modified := FALSE ; |
||
84 | if MessageDlg (MsgSave, mtConfirmation, [mbYes, mbNo], 0) = mrYes |
||
85 | then
|
||
86 | SaveAliment |
||
87 | else
|
||
88 | begin
|
||
89 | LoadAliment ; |
||
90 | LBAliment.Repaint ; |
||
91 | end ;
|
||
92 | end ;
|
||
93 | |||
94 | procedure TFTarif.LBAlimentClick (Sender : TObject) ;
|
||
95 | begin
|
||
96 | if LBAliment.ItemIndex = -1 |
||
97 | then
|
||
98 | begin
|
||
99 | PBPrix.Enabled := FALSE ; |
||
100 | Update := TRUE ; |
||
101 | PBPrix.Text := '' ;
|
||
102 | Update := FALSE ; |
||
103 | end
|
||
104 | else
|
||
105 | begin
|
||
106 | PBPrix.Enabled := TRUE ; |
||
107 | Update := TRUE ; |
||
108 | PAliment := ListAliment[FindIdxAliment (LBAliment.Items[LBAliment.ItemIndex])] ; |
||
109 | PBPrix.AsFloat := PAliment.Prix ; |
||
110 | Update := FALSE ; |
||
111 | ActiveControl := PBPrix ; |
||
112 | PBPrix.SelectAll ; |
||
113 | end ;
|
||
114 | end ;
|
||
115 | |||
116 | procedure TFTarif.LBAlimentDrawItem (Control : TWinControl ; Index : Integer ;
|
||
117 | Rect : TRect ; State : TOwnerDrawState) ; |
||
118 | begin
|
||
119 | with (Control as TListBox).Canvas do |
||
120 | begin
|
||
121 | // Cadre principal
|
||
122 | FillRect (Rect) ; |
||
123 | // Nom
|
||
124 | SetTextAlign (Handle, TA_LEFT) ; |
||
125 | TextRect (Rect, Rect.Left + 2, Rect.Top, LBAliment.Items[Index]) ;
|
||
126 | // Prix
|
||
127 | Rect.Left := 224 ;
|
||
128 | if (LBAliment.Items.Count > 20) |
||
129 | then
|
||
130 | Rect.Right := Rect.Right - 1
|
||
131 | else
|
||
132 | // L'ascensseur fait 17 pixels
|
||
133 | Rect.Right := Rect.Right - 18 ;
|
||
134 | SetTextAlign (Handle, TA_RIGHT) ; |
||
135 | PAliment := ListAliment[FindIdxAliment (LBAliment.Items[Index])] ; |
||
136 | TextRect (Rect, Rect.Right - 2, Rect.Top, Format ('%6.2f', [PAliment.Prix])) ; |
||
137 | end ;
|
||
138 | end ;
|
||
139 | |||
140 | procedure TFTarif.PBPrixChange (Sender : TObject) ;
|
||
141 | begin
|
||
142 | if not Update |
||
143 | then
|
||
144 | begin
|
||
145 | Modified := TRUE ; |
||
146 | PAliment := ListAliment[FindIdxAliment (LBAliment.Items[LBAliment.ItemIndex])] ; |
||
147 | PAliment.Prix := PBPrix.AsFloat ; |
||
148 | LBAliment.Repaint ; |
||
149 | end ;
|
||
150 | end ;
|
||
151 | |||
152 | procedure TFTarif.PBPrixKeyPress(Sender: TObject; var Key: Char); |
||
153 | begin
|
||
154 | if Key = #13 |
||
155 | then
|
||
156 | if LBAliment.ItemIndex < LBAliment.Count - 1 |
||
157 | then
|
||
158 | begin
|
||
159 | LBAliment.ItemIndex := LBAliment.ItemIndex + 1 ;
|
||
160 | LBAlimentClick (nil) ;
|
||
161 | Key := #0 ;
|
||
162 | end ;
|
||
163 | end;
|
||
164 | |||
165 | end. |