1 |
|
---|
2 | {*****************************************************************************}
|
---|
3 | { }
|
---|
4 | { Tnt Delphi Unicode Controls }
|
---|
5 | { http://www.tntware.com/delphicontrols/unicode/ }
|
---|
6 | { Version: 2.3.0 }
|
---|
7 | { }
|
---|
8 | { Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
|
---|
9 | { }
|
---|
10 | {*****************************************************************************}
|
---|
11 |
|
---|
12 | unit TntActnList;
|
---|
13 |
|
---|
14 | {$INCLUDE TntCompilers.inc}
|
---|
15 |
|
---|
16 | interface
|
---|
17 |
|
---|
18 | uses
|
---|
19 | Classes, Controls, ActnList, Buttons, ExtCtrls, ComCtrls, StdCtrls, Menus;
|
---|
20 |
|
---|
21 | type
|
---|
22 | {TNT-WARN TActionList}
|
---|
23 | TTntActionList = class(TActionList{TNT-ALLOW TActionList})
|
---|
24 | private
|
---|
25 | FCheckActionsTimer: TTimer;
|
---|
26 | procedure CheckActions(Sender: TObject);
|
---|
27 | public
|
---|
28 | constructor Create(AOwner: TComponent); override;
|
---|
29 | end;
|
---|
30 |
|
---|
31 | ITntAction = interface
|
---|
32 | ['{59D0AE37-8161-4AD6-9102-14B28E5761EB}']
|
---|
33 | end;
|
---|
34 |
|
---|
35 | //---------------------------------------------------------------------------------------------
|
---|
36 | // ACTIONS
|
---|
37 | //---------------------------------------------------------------------------------------------
|
---|
38 |
|
---|
39 | {TNT-WARN TCustomAction}
|
---|
40 | TTntCustomAction = class(TCustomAction{TNT-ALLOW TCustomAction}, ITntAction)
|
---|
41 | private
|
---|
42 | function GetCaption: WideString;
|
---|
43 | procedure SetCaption(const Value: WideString);
|
---|
44 | function GetHint: WideString;
|
---|
45 | procedure SetHint(const Value: WideString);
|
---|
46 | protected
|
---|
47 | procedure DefineProperties(Filer: TFiler); override;
|
---|
48 | public
|
---|
49 | procedure Assign(Source: TPersistent); override;
|
---|
50 | public
|
---|
51 | property Caption: WideString read GetCaption write SetCaption;
|
---|
52 | property Hint: WideString read GetHint write SetHint;
|
---|
53 | end;
|
---|
54 |
|
---|
55 | {TNT-WARN TAction}
|
---|
56 | TTntAction = class(TAction{TNT-ALLOW TAction}, ITntAction)
|
---|
57 | private
|
---|
58 | function GetCaption: WideString;
|
---|
59 | procedure SetCaption(const Value: WideString);
|
---|
60 | function GetHint: WideString;
|
---|
61 | procedure SetHint(const Value: WideString);
|
---|
62 | protected
|
---|
63 | procedure DefineProperties(Filer: TFiler); override;
|
---|
64 | public
|
---|
65 | procedure Assign(Source: TPersistent); override;
|
---|
66 | published
|
---|
67 | property Caption: WideString read GetCaption write SetCaption;
|
---|
68 | property Hint: WideString read GetHint write SetHint;
|
---|
69 | end;
|
---|
70 |
|
---|
71 | //---------------------------------------------------------------------------------------------
|
---|
72 |
|
---|
73 | // MENU ACTION LINK
|
---|
74 | //---------------------------------------------------------------------------------------------
|
---|
75 |
|
---|
76 | {TNT-WARN TMenuActionLink}
|
---|
77 | TTntMenuActionLink = class(TMenuActionLink{TNT-ALLOW TMenuActionLink})
|
---|
78 | protected
|
---|
79 | function IsCaptionLinked: Boolean; override;
|
---|
80 | function IsHintLinked: Boolean; override;
|
---|
81 | procedure SetCaption(const Value: string{TNT-ALLOW string}); override;
|
---|
82 | procedure SetHint(const Value: string{TNT-ALLOW string}); override;
|
---|
83 | end;
|
---|
84 |
|
---|
85 | //---------------------------------------------------------------------------------------------
|
---|
86 | // CONTROL ACTION LINKS
|
---|
87 | //---------------------------------------------------------------------------------------------
|
---|
88 |
|
---|
89 | {TNT-WARN TListViewActionLink}
|
---|
90 | TTntListViewActionLink = class(TListViewActionLink{TNT-ALLOW TListViewActionLink})
|
---|
91 | protected
|
---|
92 | function IsCaptionLinked: Boolean; override;
|
---|
93 | function IsHintLinked: Boolean; override;
|
---|
94 | procedure SetCaption(const Value: string{TNT-ALLOW string}); override;
|
---|
95 | procedure SetHint(const Value: string{TNT-ALLOW string}); override;
|
---|
96 | end;
|
---|
97 |
|
---|
98 | {TNT-WARN TComboBoxExActionLink}
|
---|
99 | TTntComboBoxExActionLink = class(TComboBoxExActionLink{TNT-ALLOW TComboBoxExActionLink})
|
---|
100 | protected
|
---|
101 | function IsCaptionLinked: Boolean; override;
|
---|
102 | function IsHintLinked: Boolean; override;
|
---|
103 | procedure SetCaption(const Value: string{TNT-ALLOW string}); override;
|
---|
104 | procedure SetHint(const Value: string{TNT-ALLOW string}); override;
|
---|
105 | end;
|
---|
106 |
|
---|
107 | {TNT-WARN TSpeedButtonActionLink}
|
---|
108 | TTntSpeedButtonActionLink = class(TSpeedButtonActionLink{TNT-ALLOW TSpeedButtonActionLink})
|
---|
109 | protected
|
---|
110 | function IsCaptionLinked: Boolean; override;
|
---|
111 | function IsHintLinked: Boolean; override;
|
---|
112 | procedure SetCaption(const Value: string{TNT-ALLOW string}); override;
|
---|
113 | procedure SetHint(const Value: string{TNT-ALLOW string}); override;
|
---|
114 | {$IFDEF COMPILER_10_UP}
|
---|
115 | function IsImageIndexLinked: Boolean; override;
|
---|
116 | procedure SetImageIndex(Value: Integer); override;
|
---|
117 | {$ENDIF}
|
---|
118 | end;
|
---|
119 |
|
---|
120 | {$IFDEF COMPILER_10_UP}
|
---|
121 | {TNT-WARN TBitBtnActionLink}
|
---|
122 | TTntBitBtnActionLink = class(TBitBtnActionLink{TNT-ALLOW TBitBtnActionLink})
|
---|
123 | protected
|
---|
124 | function IsCaptionLinked: Boolean; override;
|
---|
125 | function IsHintLinked: Boolean; override;
|
---|
126 | procedure SetCaption(const Value: string{TNT-ALLOW string}); override;
|
---|
127 | procedure SetHint(const Value: string{TNT-ALLOW string}); override;
|
---|
128 | {$IFDEF COMPILER_10_UP}
|
---|
129 | function IsImageIndexLinked: Boolean; override;
|
---|
130 | procedure SetImageIndex(Value: Integer); override;
|
---|
131 | {$ENDIF}
|
---|
132 | end;
|
---|
133 | {$ENDIF}
|
---|
134 |
|
---|
135 | {TNT-WARN TToolButtonActionLink}
|
---|
136 | TTntToolButtonActionLink = class(TToolButtonActionLink{TNT-ALLOW TToolButtonActionLink})
|
---|
137 | protected
|
---|
138 | function IsCaptionLinked: Boolean; override;
|
---|
139 | function IsHintLinked: Boolean; override;
|
---|
140 | procedure SetCaption(const Value: string{TNT-ALLOW string}); override;
|
---|
141 | procedure SetHint(const Value: string{TNT-ALLOW string}); override;
|
---|
142 | end;
|
---|
143 |
|
---|
144 | {TNT-WARN TButtonActionLink}
|
---|
145 | TTntButtonActionLink = class(TButtonActionLink{TNT-ALLOW TButtonActionLink})
|
---|
146 | protected
|
---|
147 | function IsCaptionLinked: Boolean; override;
|
---|
148 | function IsHintLinked: Boolean; override;
|
---|
149 | procedure SetCaption(const Value: string{TNT-ALLOW string}); override;
|
---|
150 | procedure SetHint(const Value: string{TNT-ALLOW string}); override;
|
---|
151 | end;
|
---|
152 |
|
---|
153 | {TNT-WARN TWinControlActionLink}
|
---|
154 | TTntWinControlActionLink = class(TWinControlActionLink{TNT-ALLOW TWinControlActionLink})
|
---|
155 | protected
|
---|
156 | function IsCaptionLinked: Boolean; override;
|
---|
157 | function IsHintLinked: Boolean; override;
|
---|
158 | procedure SetCaption(const Value: string{TNT-ALLOW string}); override;
|
---|
159 | procedure SetHint(const Value: string{TNT-ALLOW string}); override;
|
---|
160 | end;
|
---|
161 |
|
---|
162 | {TNT-WARN TControlActionLink}
|
---|
163 | TTntControlActionLink = class(TControlActionLink{TNT-ALLOW TControlActionLink})
|
---|
164 | protected
|
---|
165 | function IsCaptionLinked: Boolean; override;
|
---|
166 | function IsHintLinked: Boolean; override;
|
---|
167 | procedure SetCaption(const Value: string{TNT-ALLOW string}); override;
|
---|
168 | procedure SetHint(const Value: string{TNT-ALLOW string}); override;
|
---|
169 | end;
|
---|
170 |
|
---|
171 | //---------------------------------------------------------------------------------------------
|
---|
172 | // helper procs
|
---|
173 | //---------------------------------------------------------------------------------------------
|
---|
174 |
|
---|
175 | //-- TCustomAction helper routines
|
---|
176 | procedure TntAction_SetCaption(Action: TCustomAction{TNT-ALLOW TCustomAction}; const Value: WideString);
|
---|
177 | function TntAction_GetCaption(Action: TCustomAction{TNT-ALLOW TCustomAction}): WideString;
|
---|
178 | function TntAction_GetNewCaption(Action: TCustomAction{TNT-ALLOW TCustomAction}; const Default: WideString): WideString;
|
---|
179 | procedure TntAction_SetHint(Action: TCustomAction{TNT-ALLOW TCustomAction}; const Value: WideString);
|
---|
180 | function TntAction_GetHint(Action: TCustomAction{TNT-ALLOW TCustomAction}): WideString;
|
---|
181 | function TntAction_GetNewHint(Action: TCustomAction{TNT-ALLOW TCustomAction}; const Default: WideString): WideString;
|
---|
182 | procedure TntAction_AfterInherited_Assign(Action: TCustomAction{TNT-ALLOW TCustomAction}; Source: TPersistent);
|
---|
183 |
|
---|
184 | // -- TControl helper routines
|
---|
185 | function TntControl_GetActionLinkClass(Control: TControl; InheritedLinkClass: TControlActionLinkClass): TControlActionLinkClass;
|
---|
186 | procedure TntControl_BeforeInherited_ActionChange(Control: TControl; Sender: TObject; CheckDefaults: Boolean);
|
---|
187 |
|
---|
188 | // -- TControlActionLink helper routines
|
---|
189 | function TntActionLink_IsCaptionLinked(InheritedIsCaptionLinked: Boolean; Action: TBasicAction; FClient: TControl): Boolean;
|
---|
190 | function TntActionLink_IsHintLinked(InheritedIsHintLinked: Boolean; Action: TBasicAction; FClient: TControl): Boolean;
|
---|
191 | procedure TntActionLink_SetCaption(IsCaptionLinked: Boolean; Action: TBasicAction; FClient: TControl; const Value: string{TNT-ALLOW string});
|
---|
192 | procedure TntActionLink_SetHint(IsHintLinked: Boolean; Action: TBasicAction; FClient: TControl; const Value: string{TNT-ALLOW string});
|
---|
193 |
|
---|
194 | type
|
---|
195 | TUpgradeActionListItemsProc = procedure (ActionList: TTntActionList);
|
---|
196 |
|
---|
197 | var
|
---|
198 | UpgradeActionListItemsProc: TUpgradeActionListItemsProc;
|
---|
199 |
|
---|
200 | implementation
|
---|
201 |
|
---|
202 | uses
|
---|
203 | SysUtils, TntMenus, TntClasses, TntControls;
|
---|
204 |
|
---|
205 | { TActionListList }
|
---|
206 |
|
---|
207 | type
|
---|
208 | TActionListList = class(TList)
|
---|
209 | private
|
---|
210 | FActionList: TTntActionList;
|
---|
211 | protected
|
---|
212 | procedure Notify(Ptr: Pointer; Action: TListNotification); override;
|
---|
213 | end;
|
---|
214 |
|
---|
215 | procedure TActionListList.Notify(Ptr: Pointer; Action: TListNotification);
|
---|
216 | begin
|
---|
217 | inherited;
|
---|
218 | if (Action = lnAdded) and (FActionList <> nil) and (Ptr <> nil)
|
---|
219 | and (not Supports(TObject(Ptr), ITntAction)) then
|
---|
220 | begin
|
---|
221 | FActionList.FCheckActionsTimer.Enabled := False;
|
---|
222 | FActionList.FCheckActionsTimer.Enabled := True;
|
---|
223 | end;
|
---|
224 | end;
|
---|
225 |
|
---|
226 | { THackActionList }
|
---|
227 |
|
---|
228 | type
|
---|
229 | {$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
|
---|
230 | THackCustomActionList = class(TComponent)
|
---|
231 | private
|
---|
232 | FActions: TList;
|
---|
233 | end;
|
---|
234 | {$ENDIF}
|
---|
235 | {$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
|
---|
236 | THackCustomActionList = class(TComponent)
|
---|
237 | private
|
---|
238 | FActions: TList;
|
---|
239 | end;
|
---|
240 | {$ENDIF}
|
---|
241 | {$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
|
---|
242 | THackCustomActionList = class(TComponent)
|
---|
243 | private
|
---|
244 | FActions: TList;
|
---|
245 | end;
|
---|
246 | {$ENDIF}
|
---|
247 | {$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
|
---|
248 | THackCustomActionList = class(TComponent)
|
---|
249 | private
|
---|
250 | FActions: TList;
|
---|
251 | end;
|
---|
252 | {$ENDIF}
|
---|
253 |
|
---|
254 | { TTntActionList }
|
---|
255 |
|
---|
256 | constructor TTntActionList.Create(AOwner: TComponent);
|
---|
257 | begin
|
---|
258 | inherited;
|
---|
259 | if (csDesigning in ComponentState) then begin
|
---|
260 | FCheckActionsTimer := TTimer.Create(Self);
|
---|
261 | FCheckActionsTimer.Enabled := False;
|
---|
262 | FCheckActionsTimer.Interval := 50;
|
---|
263 | FCheckActionsTimer.OnTimer := CheckActions;
|
---|
264 | //
|
---|
265 | THackCustomActionList(Self).FActions.Free;
|
---|
266 | THackCustomActionList(Self).FActions := TActionListList.Create;
|
---|
267 | TActionListList(THackCustomActionList(Self).FActions).FActionList := Self;
|
---|
268 | end;
|
---|
269 | end;
|
---|
270 |
|
---|
271 | procedure TTntActionList.CheckActions(Sender: TObject);
|
---|
272 | begin
|
---|
273 | if FCheckActionsTimer <> nil then begin
|
---|
274 | FCheckActionsTimer.Enabled := False;
|
---|
275 | end;
|
---|
276 | Assert(csDesigning in ComponentState);
|
---|
277 | Assert(Assigned(UpgradeActionListItemsProc));
|
---|
278 | UpgradeActionListItemsProc(Self);
|
---|
279 | end;
|
---|
280 |
|
---|
281 | { TCustomActionHelper }
|
---|
282 |
|
---|
283 | type
|
---|
284 | TCustomActionHelper = class(TComponent)
|
---|
285 | private
|
---|
286 | FAction: TCustomAction{TNT-ALLOW TCustomAction};
|
---|
287 | private
|
---|
288 | FCaption: WideString;
|
---|
289 | FSettingNewCaption: Boolean;
|
---|
290 | FOldWideCaption: WideString;
|
---|
291 | FNewAnsiCaption: AnsiString;
|
---|
292 | procedure SetAnsiCaption(const Value: AnsiString);
|
---|
293 | function SettingNewCaption: Boolean;
|
---|
294 | procedure SetCaption(const Value: WideString);
|
---|
295 | function GetCaption: WideString;
|
---|
296 | private
|
---|
297 | FHint: WideString;
|
---|
298 | FSettingNewHint: Boolean;
|
---|
299 | FOldWideHint: WideString;
|
---|
300 | FNewAnsiHint: AnsiString;
|
---|
301 | procedure SetAnsiHint(const Value: AnsiString);
|
---|
302 | function SettingNewHint: Boolean;
|
---|
303 | procedure SetHint(const Value: WideString);
|
---|
304 | function GetHint: WideString;
|
---|
305 | end;
|
---|
306 |
|
---|
307 | procedure TCustomActionHelper.SetAnsiCaption(const Value: AnsiString);
|
---|
308 | begin
|
---|
309 | FAction.Caption := Value;
|
---|
310 | if (Value = '') and (FNewAnsiCaption <> '') then
|
---|
311 | FOldWideCaption := '';
|
---|
312 | end;
|
---|
313 |
|
---|
314 | function TCustomActionHelper.SettingNewCaption: Boolean;
|
---|
315 | begin
|
---|
316 | Result := FSettingNewCaption and (FAction.Caption <> FNewAnsiCaption);
|
---|
317 | end;
|
---|
318 |
|
---|
319 | function TCustomActionHelper.GetCaption: WideString;
|
---|
320 | begin
|
---|
321 | if SettingNewCaption then
|
---|
322 | Result := FOldWideCaption
|
---|
323 | else
|
---|
324 | Result := GetSyncedWideString(FCaption, FAction.Caption)
|
---|
325 | end;
|
---|
326 |
|
---|
327 | procedure TCustomActionHelper.SetCaption(const Value: WideString);
|
---|
328 | begin
|
---|
329 | FOldWideCaption := GetCaption;
|
---|
330 | FNewAnsiCaption := Value;
|
---|
331 | FSettingNewCaption := True;
|
---|
332 | try
|
---|
333 | SetSyncedWideString(Value, FCaption, FAction.Caption, SetAnsiCaption)
|
---|
334 | finally
|
---|
335 | FSettingNewCaption := False;
|
---|
336 | end;
|
---|
337 | end;
|
---|
338 |
|
---|
339 | procedure TCustomActionHelper.SetAnsiHint(const Value: AnsiString);
|
---|
340 | begin
|
---|
341 | FAction.Hint := Value;
|
---|
342 | if (Value = '') and (FNewAnsiHint <> '') then
|
---|
343 | FOldWideHint := '';
|
---|
344 | end;
|
---|
345 |
|
---|
346 | function TCustomActionHelper.SettingNewHint: Boolean;
|
---|
347 | begin
|
---|
348 | Result := FSettingNewHint and (FAction.Hint <> FNewAnsiHint);
|
---|
349 | end;
|
---|
350 |
|
---|
351 | function TCustomActionHelper.GetHint: WideString;
|
---|
352 | begin
|
---|
353 | if SettingNewHint then
|
---|
354 | Result := FOldWideHint
|
---|
355 | else
|
---|
356 | Result := GetSyncedWideString(FHint, FAction.Hint)
|
---|
357 | end;
|
---|
358 |
|
---|
359 | procedure TCustomActionHelper.SetHint(const Value: WideString);
|
---|
360 | begin
|
---|
361 | FOldWideHint := GetHint;
|
---|
362 | FNewAnsiHint := Value;
|
---|
363 | FSettingNewHint := True;
|
---|
364 | try
|
---|
365 | SetSyncedWideString(Value, FHint, FAction.Hint, SetAnsiHint)
|
---|
366 | finally
|
---|
367 | FSettingNewHint := False;
|
---|
368 | end;
|
---|
369 | end;
|
---|
370 |
|
---|
371 | function FindActionHelper(Action: TCustomAction{TNT-ALLOW TCustomAction}): TCustomActionHelper;
|
---|
372 | var
|
---|
373 | i: integer;
|
---|
374 | begin
|
---|
375 | Assert(Action <> nil);
|
---|
376 | Result := nil;
|
---|
377 | if Supports(Action, ITntAction) then begin
|
---|
378 | for i := 0 to Action.ComponentCount - 1 do begin
|
---|
379 | if Action.Components[i] is TCustomActionHelper then begin
|
---|
380 | Result := TCustomActionHelper(Action.Components[i]);
|
---|
381 | break;
|
---|
382 | end;
|
---|
383 | end;
|
---|
384 | if Result = nil then begin
|
---|
385 | Result := TCustomActionHelper.Create(Action);
|
---|
386 | Result.FAction := Action;
|
---|
387 | end;
|
---|
388 | end;
|
---|
389 | end;
|
---|
390 |
|
---|
391 | //-- TCustomAction helper routines
|
---|
392 |
|
---|
393 | procedure TntAction_SetCaption(Action: TCustomAction{TNT-ALLOW TCustomAction}; const Value: WideString);
|
---|
394 | begin
|
---|
395 | if Supports(Action, ITntAction) then
|
---|
396 | with FindActionHelper(Action) do
|
---|
397 | SetCaption(Value)
|
---|
398 | else
|
---|
399 | Action.Caption := Value;
|
---|
400 | end;
|
---|
401 |
|
---|
402 | function TntAction_GetCaption(Action: TCustomAction{TNT-ALLOW TCustomAction}): WideString;
|
---|
403 | begin
|
---|
404 | if Supports(Action, ITntAction) then
|
---|
405 | with FindActionHelper(Action) do
|
---|
406 | Result := GetCaption
|
---|
407 | else
|
---|
408 | Result := Action.Caption;
|
---|
409 | end;
|
---|
410 |
|
---|
411 | function TntAction_GetNewCaption(Action: TCustomAction{TNT-ALLOW TCustomAction}; const Default: WideString): WideString;
|
---|
412 | begin
|
---|
413 | Result := Default;
|
---|
414 | if Supports(Action, ITntAction) then
|
---|
415 | with FindActionHelper(Action) do
|
---|
416 | if SettingNewCaption then
|
---|
417 | Result := FCaption;
|
---|
418 | end;
|
---|
419 |
|
---|
420 | procedure TntAction_SetHint(Action: TCustomAction{TNT-ALLOW TCustomAction}; const Value: WideString);
|
---|
421 | begin
|
---|
422 | if Supports(Action, ITntAction) then
|
---|
423 | with FindActionHelper(Action) do
|
---|
424 | SetHint(Value)
|
---|
425 | else
|
---|
426 | Action.Hint := Value;
|
---|
427 | end;
|
---|
428 |
|
---|
429 | function TntAction_GetHint(Action: TCustomAction{TNT-ALLOW TCustomAction}): WideString;
|
---|
430 | begin
|
---|
431 | if Supports(Action, ITntAction) then
|
---|
432 | with FindActionHelper(Action) do
|
---|
433 | Result := GetHint
|
---|
434 | else
|
---|
435 | Result := Action.Hint;
|
---|
436 | end;
|
---|
437 |
|
---|
438 | function TntAction_GetNewHint(Action: TCustomAction{TNT-ALLOW TCustomAction}; const Default: WideString): WideString;
|
---|
439 | begin
|
---|
440 | Result := Default;
|
---|
441 | if Supports(Action, ITntAction) then
|
---|
442 | with FindActionHelper(Action) do
|
---|
443 | if SettingNewHint then
|
---|
444 | Result := FHint;
|
---|
445 | end;
|
---|
446 |
|
---|
447 | procedure TntAction_AfterInherited_Assign(Action: TCustomAction{TNT-ALLOW TCustomAction}; Source: TPersistent);
|
---|
448 | begin
|
---|
449 | with Action do begin
|
---|
450 | if (Source is TCustomAction{TNT-ALLOW TCustomAction}) then begin
|
---|
451 | Caption := TntAction_GetCaption(Source as TCustomAction{TNT-ALLOW TCustomAction});
|
---|
452 | Hint := TntAction_GetHint(Source as TCustomAction{TNT-ALLOW TCustomAction});
|
---|
453 | end else if (Source is TControl) then begin
|
---|
454 | Caption := TntControl_GetText(Source as TControl);
|
---|
455 | Hint := TntControl_GetHint(Source as TControl);
|
---|
456 | end;
|
---|
457 | end;
|
---|
458 | end;
|
---|
459 |
|
---|
460 | // -- TControl helper routines
|
---|
461 |
|
---|
462 | function TntControl_GetActionLinkClass(Control: TControl; InheritedLinkClass: TControlActionLinkClass): TControlActionLinkClass;
|
---|
463 | begin
|
---|
464 | if Control is TCustomListView{TNT-ALLOW TCustomListView} then
|
---|
465 | Result := TTntListViewActionLink
|
---|
466 | else if Control is TComboBoxEx then
|
---|
467 | Result := TTntComboBoxExActionLink
|
---|
468 | else if Control is TSpeedButton{TNT-ALLOW TSpeedButton} then
|
---|
469 | Result := TTntSpeedButtonActionLink
|
---|
470 | {$IFDEF COMPILER_10_UP}
|
---|
471 | else if Control is TBitBtn{TNT-ALLOW TBitBtn} then
|
---|
472 | Result := TTntBitBtnActionLink
|
---|
473 | {$ENDIF}
|
---|
474 | else if Control is TToolButton{TNT-ALLOW TToolButton} then
|
---|
475 | Result := TTntToolButtonActionLink
|
---|
476 | else if Control is TButtonControl then
|
---|
477 | Result := TTntButtonActionLink
|
---|
478 | else if Control is TWinControl then
|
---|
479 | Result := TTntWinControlActionLink
|
---|
480 | else
|
---|
481 | Result := TTntControlActionLink;
|
---|
482 |
|
---|
483 | Assert(Result.ClassParent = InheritedLinkClass);
|
---|
484 | end;
|
---|
485 |
|
---|
486 | procedure TntControl_BeforeInherited_ActionChange(Control: TControl; Sender: TObject; CheckDefaults: Boolean);
|
---|
487 | begin
|
---|
488 | if (Sender is TCustomAction{TNT-ALLOW TCustomAction}) and Supports(Sender, ITntAction) then begin
|
---|
489 | if not CheckDefaults or (TntControl_GetText(Control) = '') or (TntControl_GetText(Control) = Control.Name) then
|
---|
490 | TntControl_SetText(Control, TntAction_GetCaption(TCustomAction{TNT-ALLOW TCustomAction}(Sender)));
|
---|
491 | if not CheckDefaults or (TntControl_GetHint(Control) = '') then
|
---|
492 | TntControl_SetHint(Control, TntAction_GetHint(TCustomAction{TNT-ALLOW TCustomAction}(Sender)));
|
---|
493 | end;
|
---|
494 | end;
|
---|
495 |
|
---|
496 | // -- TControlActionLink helper routines
|
---|
497 |
|
---|
498 | function TntActionLink_IsCaptionLinked(InheritedIsCaptionLinked: Boolean; Action: TBasicAction; FClient: TControl): Boolean;
|
---|
499 | begin
|
---|
500 | Result := InheritedIsCaptionLinked
|
---|
501 | and (TntAction_GetCaption(Action as TCustomAction{TNT-ALLOW TCustomAction}) = TntControl_GetText(FClient));
|
---|
502 | end;
|
---|
503 |
|
---|
504 | function TntActionLink_IsHintLinked(InheritedIsHintLinked: Boolean; Action: TBasicAction; FClient: TControl): Boolean;
|
---|
505 | begin
|
---|
506 | Result := InheritedIsHintLinked
|
---|
507 | and (TntAction_GetHint(Action as TCustomAction{TNT-ALLOW TCustomAction}) = TntControl_GetHint(FClient));
|
---|
508 | end;
|
---|
509 |
|
---|
510 | procedure TntActionLink_SetCaption(IsCaptionLinked: Boolean; Action: TBasicAction; FClient: TControl; const Value: string{TNT-ALLOW string});
|
---|
511 | begin
|
---|
512 | if IsCaptionLinked then
|
---|
513 | TntControl_SetText(FClient, TntAction_GetNewCaption(Action as TCustomAction{TNT-ALLOW TCustomAction}, Value));
|
---|
514 | end;
|
---|
515 |
|
---|
516 | procedure TntActionLink_SetHint(IsHintLinked: Boolean; Action: TBasicAction; FClient: TControl; const Value: string{TNT-ALLOW string});
|
---|
517 | begin
|
---|
518 | if IsHintLinked then
|
---|
519 | TntControl_SetHint(FClient, TntAction_GetNewHint(Action as TCustomAction{TNT-ALLOW TCustomAction}, Value));
|
---|
520 | end;
|
---|
521 |
|
---|
522 | //---------------------------------------------------------------------------------------------
|
---|
523 | // ACTIONS
|
---|
524 | //---------------------------------------------------------------------------------------------
|
---|
525 |
|
---|
526 | { TTntCustomAction }
|
---|
527 |
|
---|
528 | procedure TTntCustomAction.Assign(Source: TPersistent);
|
---|
529 | begin
|
---|
530 | inherited;
|
---|
531 | TntAction_AfterInherited_Assign(Self, Source);
|
---|
532 | end;
|
---|
533 |
|
---|
534 | procedure TTntCustomAction.DefineProperties(Filer: TFiler);
|
---|
535 | begin
|
---|
536 | inherited;
|
---|
537 | TntPersistent_AfterInherited_DefineProperties(Filer, Self);
|
---|
538 | end;
|
---|
539 |
|
---|
540 | function TTntCustomAction.GetCaption: WideString;
|
---|
541 | begin
|
---|
542 | Result := TntAction_GetCaption(Self);
|
---|
543 | end;
|
---|
544 |
|
---|
545 | procedure TTntCustomAction.SetCaption(const Value: WideString);
|
---|
546 | begin
|
---|
547 | TntAction_SetCaption(Self, Value);
|
---|
548 | end;
|
---|
549 |
|
---|
550 | function TTntCustomAction.GetHint: WideString;
|
---|
551 | begin
|
---|
552 | Result := TntAction_GetHint(Self);
|
---|
553 | end;
|
---|
554 |
|
---|
555 | procedure TTntCustomAction.SetHint(const Value: WideString);
|
---|
556 | begin
|
---|
557 | TntAction_SetHint(Self, Value);
|
---|
558 | end;
|
---|
559 |
|
---|
560 | { TTntAction }
|
---|
561 |
|
---|
562 | procedure TTntAction.Assign(Source: TPersistent);
|
---|
563 | begin
|
---|
564 | inherited;
|
---|
565 | TntAction_AfterInherited_Assign(Self, Source);
|
---|
566 | end;
|
---|
567 |
|
---|
568 | procedure TTntAction.DefineProperties(Filer: TFiler);
|
---|
569 | begin
|
---|
570 | inherited;
|
---|
571 | TntPersistent_AfterInherited_DefineProperties(Filer, Self);
|
---|
572 | end;
|
---|
573 |
|
---|
574 | function TTntAction.GetCaption: WideString;
|
---|
575 | begin
|
---|
576 | Result := TntAction_GetCaption(Self);
|
---|
577 | end;
|
---|
578 |
|
---|
579 | procedure TTntAction.SetCaption(const Value: WideString);
|
---|
580 | begin
|
---|
581 | TntAction_SetCaption(Self, Value);
|
---|
582 | end;
|
---|
583 |
|
---|
584 | function TTntAction.GetHint: WideString;
|
---|
585 | begin
|
---|
586 | Result := TntAction_GetHint(Self);
|
---|
587 | end;
|
---|
588 |
|
---|
589 | procedure TTntAction.SetHint(const Value: WideString);
|
---|
590 | begin
|
---|
591 | TntAction_SetHint(Self, Value);
|
---|
592 | end;
|
---|
593 |
|
---|
594 | //---------------------------------------------------------------------------------------------
|
---|
595 | // MENU ACTION LINK
|
---|
596 | //---------------------------------------------------------------------------------------------
|
---|
597 |
|
---|
598 | { TTntMenuActionLink }
|
---|
599 |
|
---|
600 | function TTntMenuActionLink.IsCaptionLinked: Boolean;
|
---|
601 | begin
|
---|
602 | Result := inherited IsCaptionLinked
|
---|
603 | and WideSameCaption(TntAction_GetCaption(Action as TCustomAction{TNT-ALLOW TCustomAction}), (FClient as TTntMenuItem).Caption);
|
---|
604 | end;
|
---|
605 |
|
---|
606 | function TTntMenuActionLink.IsHintLinked: Boolean;
|
---|
607 | begin
|
---|
608 | Result := inherited IsHintLinked
|
---|
609 | and (TntAction_GetHint(Action as TCustomAction{TNT-ALLOW TCustomAction}) = (FClient as TTntMenuItem).Hint);
|
---|
610 | end;
|
---|
611 |
|
---|
612 | procedure TTntMenuActionLink.SetCaption(const Value: string{TNT-ALLOW string});
|
---|
613 | begin
|
---|
614 | if IsCaptionLinked then
|
---|
615 | (FClient as TTntMenuItem).Caption := TntAction_GetNewCaption(Action as TCustomAction{TNT-ALLOW TCustomAction}, Value);
|
---|
616 | end;
|
---|
617 |
|
---|
618 | procedure TTntMenuActionLink.SetHint(const Value: string{TNT-ALLOW string});
|
---|
619 | begin
|
---|
620 | if IsHintLinked then
|
---|
621 | (FClient as TTntMenuItem).Hint := TntAction_GetNewHint(Action as TCustomAction{TNT-ALLOW TCustomAction}, Value);
|
---|
622 | end;
|
---|
623 |
|
---|
624 | //---------------------------------------------------------------------------------------------
|
---|
625 | // CONTROL ACTION LINKS
|
---|
626 | //---------------------------------------------------------------------------------------------
|
---|
627 |
|
---|
628 | { TTntListViewActionLink }
|
---|
629 |
|
---|
630 | function TTntListViewActionLink.IsCaptionLinked: Boolean;
|
---|
631 | begin
|
---|
632 | Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
|
---|
633 | end;
|
---|
634 |
|
---|
635 | function TTntListViewActionLink.IsHintLinked: Boolean;
|
---|
636 | begin
|
---|
637 | Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
|
---|
638 | end;
|
---|
639 |
|
---|
640 | procedure TTntListViewActionLink.SetCaption(const Value: string{TNT-ALLOW string});
|
---|
641 | begin
|
---|
642 | TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
|
---|
643 | end;
|
---|
644 |
|
---|
645 | procedure TTntListViewActionLink.SetHint(const Value: string{TNT-ALLOW string});
|
---|
646 | begin
|
---|
647 | TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
|
---|
648 | end;
|
---|
649 |
|
---|
650 | { TTntComboBoxExActionLink }
|
---|
651 |
|
---|
652 | function TTntComboBoxExActionLink.IsCaptionLinked: Boolean;
|
---|
653 | begin
|
---|
654 | Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
|
---|
655 | end;
|
---|
656 |
|
---|
657 | function TTntComboBoxExActionLink.IsHintLinked: Boolean;
|
---|
658 | begin
|
---|
659 | Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
|
---|
660 | end;
|
---|
661 |
|
---|
662 | procedure TTntComboBoxExActionLink.SetCaption(const Value: string{TNT-ALLOW string});
|
---|
663 | begin
|
---|
664 | TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
|
---|
665 | end;
|
---|
666 |
|
---|
667 | procedure TTntComboBoxExActionLink.SetHint(const Value: string{TNT-ALLOW string});
|
---|
668 | begin
|
---|
669 | TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
|
---|
670 | end;
|
---|
671 |
|
---|
672 | { TTntSpeedButtonActionLink }
|
---|
673 |
|
---|
674 | function TTntSpeedButtonActionLink.IsCaptionLinked: Boolean;
|
---|
675 | begin
|
---|
676 | Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
|
---|
677 | end;
|
---|
678 |
|
---|
679 | function TTntSpeedButtonActionLink.IsHintLinked: Boolean;
|
---|
680 | begin
|
---|
681 | Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
|
---|
682 | end;
|
---|
683 |
|
---|
684 | procedure TTntSpeedButtonActionLink.SetCaption(const Value: string{TNT-ALLOW string});
|
---|
685 | begin
|
---|
686 | TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
|
---|
687 | end;
|
---|
688 |
|
---|
689 | procedure TTntSpeedButtonActionLink.SetHint(const Value: string{TNT-ALLOW string});
|
---|
690 | begin
|
---|
691 | TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
|
---|
692 | end;
|
---|
693 |
|
---|
694 | {$IFDEF COMPILER_10_UP}
|
---|
695 | // bug fix for VCL where ImageIndex on Action ALWAYS overrides the Glyph.
|
---|
696 |
|
---|
697 | function TTntSpeedButtonActionLink.IsImageIndexLinked: Boolean;
|
---|
698 | begin
|
---|
699 | Result := Action is TCustomAction{TNT-ALLOW TCustomAction}; // taken from TActionLink.IsImageIndexLinked
|
---|
700 | end;
|
---|
701 |
|
---|
702 | procedure TTntSpeedButtonActionLink.SetImageIndex(Value: Integer);
|
---|
703 | begin
|
---|
704 | ; // taken from TActionLink.IsImageIndexLinked
|
---|
705 | end;
|
---|
706 | {$ENDIF}
|
---|
707 |
|
---|
708 | {$IFDEF COMPILER_10_UP}
|
---|
709 | { TTntBitBtnActionLink }
|
---|
710 |
|
---|
711 | function TTntBitBtnActionLink.IsCaptionLinked: Boolean;
|
---|
712 | begin
|
---|
713 | Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
|
---|
714 | end;
|
---|
715 |
|
---|
716 | function TTntBitBtnActionLink.IsHintLinked: Boolean;
|
---|
717 | begin
|
---|
718 | Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
|
---|
719 | end;
|
---|
720 |
|
---|
721 | procedure TTntBitBtnActionLink.SetCaption(const Value: string{TNT-ALLOW string});
|
---|
722 | begin
|
---|
723 | TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
|
---|
724 | end;
|
---|
725 |
|
---|
726 | procedure TTntBitBtnActionLink.SetHint(const Value: string{TNT-ALLOW string});
|
---|
727 | begin
|
---|
728 | TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
|
---|
729 | end;
|
---|
730 |
|
---|
731 | {$IFDEF COMPILER_10_UP}
|
---|
732 | // bug fix for VCL where ImageIndex on Action ALWAYS overrides the Glyph.
|
---|
733 |
|
---|
734 | function TTntBitBtnActionLink.IsImageIndexLinked: Boolean;
|
---|
735 | begin
|
---|
736 | Result := Action is TCustomAction{TNT-ALLOW TCustomAction}; // taken from TActionLink.IsImageIndexLinked
|
---|
737 | end;
|
---|
738 |
|
---|
739 | procedure TTntBitBtnActionLink.SetImageIndex(Value: Integer);
|
---|
740 | begin
|
---|
741 | ; // taken from TActionLink.IsImageIndexLinked
|
---|
742 | end;
|
---|
743 | {$ENDIF}
|
---|
744 |
|
---|
745 | {$ENDIF}
|
---|
746 |
|
---|
747 | { TTntToolButtonActionLink }
|
---|
748 |
|
---|
749 | function TTntToolButtonActionLink.IsCaptionLinked: Boolean;
|
---|
750 | begin
|
---|
751 | Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
|
---|
752 | end;
|
---|
753 |
|
---|
754 | function TTntToolButtonActionLink.IsHintLinked: Boolean;
|
---|
755 | begin
|
---|
756 | Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
|
---|
757 | end;
|
---|
758 |
|
---|
759 | procedure TTntToolButtonActionLink.SetCaption(const Value: string{TNT-ALLOW string});
|
---|
760 | begin
|
---|
761 | TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
|
---|
762 | end;
|
---|
763 |
|
---|
764 | procedure TTntToolButtonActionLink.SetHint(const Value: string{TNT-ALLOW string});
|
---|
765 | begin
|
---|
766 | TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
|
---|
767 | end;
|
---|
768 |
|
---|
769 | { TTntButtonActionLink }
|
---|
770 |
|
---|
771 | function TTntButtonActionLink.IsCaptionLinked: Boolean;
|
---|
772 | begin
|
---|
773 | Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
|
---|
774 | end;
|
---|
775 |
|
---|
776 | function TTntButtonActionLink.IsHintLinked: Boolean;
|
---|
777 | begin
|
---|
778 | Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
|
---|
779 | end;
|
---|
780 |
|
---|
781 | procedure TTntButtonActionLink.SetCaption(const Value: string{TNT-ALLOW string});
|
---|
782 | begin
|
---|
783 | TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
|
---|
784 | end;
|
---|
785 |
|
---|
786 | procedure TTntButtonActionLink.SetHint(const Value: string{TNT-ALLOW string});
|
---|
787 | begin
|
---|
788 | TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
|
---|
789 | end;
|
---|
790 |
|
---|
791 | { TTntWinControlActionLink }
|
---|
792 |
|
---|
793 | function TTntWinControlActionLink.IsCaptionLinked: Boolean;
|
---|
794 | begin
|
---|
795 | Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
|
---|
796 | end;
|
---|
797 |
|
---|
798 | function TTntWinControlActionLink.IsHintLinked: Boolean;
|
---|
799 | begin
|
---|
800 | Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
|
---|
801 | end;
|
---|
802 |
|
---|
803 | procedure TTntWinControlActionLink.SetCaption(const Value: string{TNT-ALLOW string});
|
---|
804 | begin
|
---|
805 | TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
|
---|
806 | end;
|
---|
807 |
|
---|
808 | procedure TTntWinControlActionLink.SetHint(const Value: string{TNT-ALLOW string});
|
---|
809 | begin
|
---|
810 | TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
|
---|
811 | end;
|
---|
812 |
|
---|
813 | { TTntControlActionLink }
|
---|
814 |
|
---|
815 | function TTntControlActionLink.IsCaptionLinked: Boolean;
|
---|
816 | begin
|
---|
817 | Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
|
---|
818 | end;
|
---|
819 |
|
---|
820 | function TTntControlActionLink.IsHintLinked: Boolean;
|
---|
821 | begin
|
---|
822 | Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
|
---|
823 | end;
|
---|
824 |
|
---|
825 | procedure TTntControlActionLink.SetCaption(const Value: string{TNT-ALLOW string});
|
---|
826 | begin
|
---|
827 | TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
|
---|
828 | end;
|
---|
829 |
|
---|
830 | procedure TTntControlActionLink.SetHint(const Value: string{TNT-ALLOW string});
|
---|
831 | begin
|
---|
832 | TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
|
---|
833 | end;
|
---|
834 |
|
---|
835 | end.
|
---|