source: cprs/branches/foia-cprs/CPRS-Chart/Templates/mTemplateFieldButton.pas

Last change on this file was 459, checked in by Kevin Toppenberg, 16 years ago

Adding foia-cprs branch

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