source: cprs/trunk/VA/VA2006Utils.pas@ 1710

Last change on this file since 1710 was 1679, checked in by healthsevak, 9 years ago

Updating the working copy to CPRS version 28

File size: 2.6 KB
Line 
1unit VA2006Utils;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Controls, ComCtrls, CommCtrl,
7 Forms;
8
9type
10
11 //This class exists to workaround TFrame tabstop set to True
12 //Known defect with Delphi 2006: http://qc.embarcadero.com/wc/qcmain.aspx?d=12257
13 TfraTabStopFalse = class(TFrame)
14 private
15 function GetTabStop: Boolean;
16 procedure SetTabStop(const Value: Boolean);
17 published
18 property TabStop: Boolean read GetTabStop write SetTabStop stored False;
19 end;
20
21// Fixes bug in Delphi 2006, where clicking on a header control section after
22// any other section have been added or deleted could cause access violations
23procedure FixHeaderControlDelphi2006Bug(HeaderControl: THeaderControl);
24
25implementation
26
27uses
28 VAUtils;
29
30type
31
32 THeaderControl2006BugFixer = class(TComponent)
33 private
34 FHeaderControl: THeaderControl;
35 procedure HeaderControlMessageHandler(var Msg: TMessage; var Handled: Boolean);
36 protected
37 procedure Notification(AComponent: TComponent; Operation: TOperation); override;
38 public
39 constructor CreateWrapper(HeaderControl: THeaderControl);
40 end;
41
42procedure THeaderControl2006BugFixer.HeaderControlMessageHandler
43 (var Msg: TMessage; var Handled: Boolean);
44var
45 OnSectionClick: TSectionNotifyEvent;
46begin
47 if (Msg.Msg = CN_NOTIFY) and (PHDNotify(Msg.LParam)^.Hdr.code = HDN_ITEMCLICK) then
48 begin
49 Handled := TRUE;
50 Msg.Result := 0;
51 OnSectionClick := FHeaderControl.OnSectionClick;
52 if assigned(OnSectionClick) then
53 OnSectionClick(FHeaderControl, FHeaderControl.Sections[PHDNotify(Msg.lParam)^.Item]);
54 end;
55end;
56
57procedure THeaderControl2006BugFixer.Notification(AComponent: TComponent;
58 Operation: TOperation);
59begin
60 inherited;
61 if (Operation = opRemove) and (AComponent = FHeaderControl) then
62 begin
63 RemoveMessageHandler(FHeaderControl, HeaderControlMessageHandler);
64 Self.Free;
65 end;
66end;
67
68constructor THeaderControl2006BugFixer.CreateWrapper(HeaderControl: THeaderControl);
69begin
70 inherited Create(nil);
71 FHeaderControl := HeaderControl;
72 FHeaderControl.FreeNotification(HeaderControl);
73 AddMessageHandler(HeaderControl, HeaderControlMessageHandler);
74end;
75
76procedure FixHeaderControlDelphi2006Bug(HeaderControl: THeaderControl);
77begin
78 THeaderControl2006BugFixer.CreateWrapper(HeaderControl);
79end;
80
81{ TfraTabStopFalse }
82
83function TfraTabStopFalse.GetTabStop: Boolean;
84begin
85 Result := False;
86end;
87
88procedure TfraTabStopFalse.SetTabStop(const Value: Boolean);
89begin
90 //Do nothing here, just ignore the Value
91end;
92
93end.
Note: See TracBrowser for help on using the repository browser.