1 | unit mTemplateFieldButton;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
7 | StdCtrls, ExtCtrls, uDlgComponents, VA508AccessibilityManager;
|
---|
8 |
|
---|
9 | type
|
---|
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 |
|
---|
39 | implementation
|
---|
40 |
|
---|
41 | {$R *.DFM}
|
---|
42 |
|
---|
43 | uses
|
---|
44 | ORFn, VA508AccessibilityRouter;
|
---|
45 |
|
---|
46 | procedure TfraTemplateFieldButton.pnlBtnMouseDown(Sender: TObject; Button: TMouseButton;
|
---|
47 | Shift: TShiftState; X, Y: Integer);
|
---|
48 | var
|
---|
49 | txt: string;
|
---|
50 | i, idx: integer;
|
---|
51 |
|
---|
52 | begin
|
---|
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;
|
---|
85 | end;
|
---|
86 |
|
---|
87 | procedure TfraTemplateFieldButton.pnlBtnMouseUp(Sender: TObject; Button: TMouseButton;
|
---|
88 | Shift: TShiftState; X, Y: Integer);
|
---|
89 | begin
|
---|
90 | if(FBtnDown) then
|
---|
91 | begin
|
---|
92 | FBtnDown := FALSE;
|
---|
93 | pnlBtn.BevelOuter := bvRaised;
|
---|
94 | end;
|
---|
95 | end;
|
---|
96 |
|
---|
97 | type
|
---|
98 | TWinControlFriend = class(TWinControl);
|
---|
99 |
|
---|
100 | procedure TfraTemplateFieldButton.FrameEnter(Sender: TObject);
|
---|
101 | begin
|
---|
102 | pbFocus.Invalidate;
|
---|
103 | end;
|
---|
104 |
|
---|
105 | procedure TfraTemplateFieldButton.FrameExit(Sender: TObject);
|
---|
106 | begin
|
---|
107 | pbFocus.Invalidate;
|
---|
108 | end;
|
---|
109 |
|
---|
110 | constructor TfraTemplateFieldButton.Create(AOwner: TComponent);
|
---|
111 | begin
|
---|
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');
|
---|
119 | end;
|
---|
120 |
|
---|
121 | procedure TfraTemplateFieldButton.ButtonKeyDown(Sender: TObject; var Key: Word;
|
---|
122 | Shift: TShiftState);
|
---|
123 | begin
|
---|
124 | if Key = VK_SPACE then
|
---|
125 | pnlBtnMouseDown(Sender, mbLeft, [], 0, 0);
|
---|
126 | end;
|
---|
127 |
|
---|
128 | procedure TfraTemplateFieldButton.ButtonKeyUp(Sender: TObject; var Key: Word;
|
---|
129 | Shift: TShiftState);
|
---|
130 | begin
|
---|
131 | pnlBtnMouseUp(Sender, mbLeft, [], 0, 0);
|
---|
132 | end;
|
---|
133 |
|
---|
134 | function TfraTemplateFieldButton.GetButtonText: string;
|
---|
135 | begin
|
---|
136 | Result := lblText.Caption;
|
---|
137 | end;
|
---|
138 |
|
---|
139 | procedure TfraTemplateFieldButton.SetButtonText(const Value: string);
|
---|
140 | begin
|
---|
141 | lblText.Caption := Value;
|
---|
142 | end;
|
---|
143 |
|
---|
144 | procedure TfraTemplateFieldButton.pbFocusPaint(Sender: TObject);
|
---|
145 | var
|
---|
146 | R: TRect;
|
---|
147 | begin
|
---|
148 | if(Focused) then
|
---|
149 | begin
|
---|
150 | R := Rect(1, 0, pnlBtn.Width - 3, pnlBtn.Height-2);
|
---|
151 | pbFocus.Canvas.DrawFocusRect(R);
|
---|
152 | end;
|
---|
153 | end;
|
---|
154 |
|
---|
155 | destructor TfraTemplateFieldButton.Destroy;
|
---|
156 | begin
|
---|
157 | FItems.Free;
|
---|
158 | FCPRSDialogData := nil;
|
---|
159 | inherited;
|
---|
160 | end;
|
---|
161 |
|
---|
162 | initialization
|
---|
163 | SpecifyFormIsNotADialog(TfraTemplateFieldButton);
|
---|
164 |
|
---|
165 | end.
|
---|