source: cprs/trunk/CPRS-Chart/Templates/mTemplateFieldButton.pas@ 1684

Last change on this file since 1684 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27

File size: 4.2 KB
Line 
1unit mTemplateFieldButton;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ExtCtrls, uDlgComponents, VA508AccessibilityManager;
8
9type
10 TfraTemplateFieldButton = class(TFrame, ICPRSDialogComponent)
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 FrameEnter(Sender: TObject);
19 procedure FrameExit(Sender: TObject);
20 procedure pbFocusPaint(Sender: TObject);
21 private
22 FCPRSDialogData: ICPRSDialogComponent;
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 property CPRSDialogData: ICPRSDialogComponent read FCPRSDialogData implements ICPRSDialogComponent;
37 end;
38
39implementation
40
41{$R *.DFM}
42
43uses
44 ORFn, VA508AccessibilityRouter;
45
46procedure TfraTemplateFieldButton.pnlBtnMouseDown(Sender: TObject; Button: TMouseButton;
47 Shift: TShiftState; X, Y: Integer);
48var
49 txt: string;
50 i, idx: integer;
51
52begin
53 if(not FBtnDown) then
54 begin
55 FBtnDown := TRUE;
56 pnlBtn.BevelOuter := bvLowered;
57 if(FItems.Count > 0) then
58 begin
59 txt := ButtonText;
60 idx := FItems.Count-1;
61 for i := 0 to FItems.Count-1 do
62 begin
63 if(txt = FItems[i]) then
64 begin
65 idx := i;
66 break;
67 end;
68 end;
69 inc(idx);
70 if(idx >= FItems.Count) then
71 idx := 0;
72 ButtonText := FItems[idx];
73 if ScreenReaderSystemActive then
74 begin
75 txt := FItems[idx];
76 if Trim(txt) = '' then
77 txt := 'blank';
78 GetScreenReader.Speak(txt);
79 end;
80 if assigned(FOnChange) then
81 FOnChange(Self);
82 end;
83 SetFocus;
84 end;
85end;
86
87procedure TfraTemplateFieldButton.pnlBtnMouseUp(Sender: TObject; Button: TMouseButton;
88 Shift: TShiftState; X, Y: Integer);
89begin
90 if(FBtnDown) then
91 begin
92 FBtnDown := FALSE;
93 pnlBtn.BevelOuter := bvRaised;
94 end;
95end;
96
97type
98 TWinControlFriend = class(TWinControl);
99
100procedure TfraTemplateFieldButton.FrameEnter(Sender: TObject);
101begin
102 pbFocus.Invalidate;
103end;
104
105procedure TfraTemplateFieldButton.FrameExit(Sender: TObject);
106begin
107 pbFocus.Invalidate;
108end;
109
110constructor TfraTemplateFieldButton.Create(AOwner: TComponent);
111begin
112 inherited Create(AOwner);
113 TabStop := TRUE;
114 FItems := TStringList.Create;
115 OnKeyDown := ButtonKeyDown;
116 OnKeyUp := ButtonKeyUp;
117 Font.Size := MainFontSize;
118 FCPRSDialogData := TCPRSDialogComponent.Create(Self, 'multi value button');
119end;
120
121procedure TfraTemplateFieldButton.ButtonKeyDown(Sender: TObject; var Key: Word;
122 Shift: TShiftState);
123begin
124 if Key = VK_SPACE then
125 pnlBtnMouseDown(Sender, mbLeft, [], 0, 0);
126end;
127
128procedure TfraTemplateFieldButton.ButtonKeyUp(Sender: TObject; var Key: Word;
129 Shift: TShiftState);
130begin
131 pnlBtnMouseUp(Sender, mbLeft, [], 0, 0);
132end;
133
134function TfraTemplateFieldButton.GetButtonText: string;
135begin
136 Result := lblText.Caption;
137end;
138
139procedure TfraTemplateFieldButton.SetButtonText(const Value: string);
140begin
141 lblText.Caption := Value;
142end;
143
144procedure TfraTemplateFieldButton.pbFocusPaint(Sender: TObject);
145var
146 R: TRect;
147begin
148 if(Focused) then
149 begin
150 R := Rect(1, 0, pnlBtn.Width - 3, pnlBtn.Height-2);
151 pbFocus.Canvas.DrawFocusRect(R);
152 end;
153end;
154
155destructor TfraTemplateFieldButton.Destroy;
156begin
157 FItems.Free;
158 FCPRSDialogData := nil;
159 inherited;
160end;
161
162initialization
163 SpecifyFormIsNotADialog(TfraTemplateFieldButton);
164
165end.
Note: See TracBrowser for help on using the repository browser.