source: cprs/branches/tmg-cprs/CPRS-Chart/Templates/mTemplateFieldButton.pas@ 1802

Last change on this file since 1802 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69

File size: 3.6 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit mTemplateFieldButton;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 StdCtrls, ExtCtrls;
9
10type
11 TfraTemplateFieldButton = class(TFrame)
12 pnlBtn: TPanel;
13 lblText: TLabel;
14 pbFocus: TPaintBox;
15 procedure pnlBtnMouseDown(Sender: TObject; Button: TMouseButton;
16 Shift: TShiftState; X, Y: Integer);
17 procedure pnlBtnMouseUp(Sender: TObject; Button: TMouseButton;
18 Shift: TShiftState; X, Y: Integer);
19 procedure pnlBtnEnter(Sender: TObject);
20 procedure pnlBtnExit(Sender: TObject);
21 procedure pbFocusPaint(Sender: TObject);
22 private
23 FBtnDown: boolean;
24 FItems: TStringList;
25 FOnChange: TNotifyEvent;
26 procedure ButtonKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
27 procedure ButtonKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
28 function GetButtonText: string;
29 procedure SetButtonText(const Value: string);
30 public
31 constructor Create(AOwner: TComponent); override;
32 destructor Destroy; override;
33 property ButtonText: string read GetButtonText write SetButtonText;
34 property Items: TStringList read FItems;
35 property OnChange: TNotifyEvent read FOnChange write FOnChange;
36 end;
37
38implementation
39
40{$R *.DFM}
41
42uses
43 ORFn;
44
45procedure TfraTemplateFieldButton.pnlBtnMouseDown(Sender: TObject; Button: TMouseButton;
46 Shift: TShiftState; X, Y: Integer);
47var
48 txt: string;
49 i, idx: integer;
50
51begin
52 if(not FBtnDown) then
53 begin
54 FBtnDown := TRUE;
55 pnlBtn.BevelOuter := bvLowered;
56 if(FItems.Count > 0) then
57 begin
58 txt := ButtonText;
59 idx := FItems.Count-1;
60 for i := 0 to FItems.Count-1 do
61 begin
62 if(txt = FItems[i]) then
63 begin
64 idx := i;
65 break;
66 end;
67 end;
68 inc(idx);
69 if(idx >= FItems.Count) then
70 idx := 0;
71 ButtonText := FItems[idx];
72 if assigned(FOnChange) then
73 FOnChange(Self);
74 end;
75 SetFocus;
76 end;
77end;
78
79procedure TfraTemplateFieldButton.pnlBtnMouseUp(Sender: TObject; Button: TMouseButton;
80 Shift: TShiftState; X, Y: Integer);
81begin
82 if(FBtnDown) then
83 begin
84 FBtnDown := FALSE;
85 pnlBtn.BevelOuter := bvRaised;
86 end;
87end;
88
89procedure TfraTemplateFieldButton.pnlBtnEnter(Sender: TObject);
90begin
91 pbFocus.Invalidate;
92end;
93
94procedure TfraTemplateFieldButton.pnlBtnExit(Sender: TObject);
95begin
96 pbFocus.Invalidate;
97end;
98
99constructor TfraTemplateFieldButton.Create(AOwner: TComponent);
100begin
101 inherited;
102 FItems := TStringList.Create;
103 OnKeyDown := ButtonKeyDown;
104 OnKeyUp := ButtonKeyUp;
105 Font.Size := MainFontSize;
106end;
107
108procedure TfraTemplateFieldButton.ButtonKeyDown(Sender: TObject; var Key: Word;
109 Shift: TShiftState);
110begin
111 if Key = VK_SPACE then
112 pnlBtnMouseDown(Sender, mbLeft, [], 0, 0);
113end;
114
115procedure TfraTemplateFieldButton.ButtonKeyUp(Sender: TObject; var Key: Word;
116 Shift: TShiftState);
117begin
118 pnlBtnMouseUp(Sender, mbLeft, [], 0, 0);
119end;
120
121function TfraTemplateFieldButton.GetButtonText: string;
122begin
123 Result := lblText.Caption;
124end;
125
126procedure TfraTemplateFieldButton.SetButtonText(const Value: string);
127begin
128 lblText.Caption := Value;
129end;
130
131procedure TfraTemplateFieldButton.pbFocusPaint(Sender: TObject);
132var
133 R: TRect;
134begin
135 if(Focused) then
136 begin
137 R := Rect(1, 0, pnlBtn.Width - 3, pnlBtn.Height-2);
138 pbFocus.Canvas.DrawFocusRect(R);
139 end;
140end;
141
142destructor TfraTemplateFieldButton.Destroy;
143begin
144 FItems.Free;
145 inherited;
146end;
147
148end.
Note: See TracBrowser for help on using the repository browser.