source: cprs/branches/tmg-cprs/CPRS-Chart/TMG_Extra/HTMLEdit/EwbFocusControl.pas@ 1806

Last change on this file since 1806 was 541, checked in by Kevin Toppenberg, 15 years ago

TMG Ver 1.1 Added HTML Support, better demographics editing

File size: 6.2 KB
Line 
1//***********************************************************
2// TEWBFocusControl unit *
3// *
4// For Delphi 5 to 2009 *
5// Freeware Component *
6// by *
7// (smot) *
8// *
9// Documentation and updated versions: *
10// *
11// http://www.bsalsa.com *
12//***********************************************************
13{*******************************************************************************}
14{LICENSE:
15THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND,
16EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED
17WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
18YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE
19AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE
20AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE
21OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED
22OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS,
23INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR
24OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS,
25AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY
26DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE.
27
28You may use, change or modify the component under 4 conditions:
291. In your website, add a link to "http://www.bsalsa.com"
302. In your application, add credits to "Embedded Web Browser"
313. Mail me (bsalsa@gmail.com) any code change in the unit
32 for the benefit of the other users.
334. Please, consider donation in our web site!
34{*******************************************************************************}
35
36unit EwbFocusControl;
37
38{$I EWB.inc}
39
40interface
41
42uses
43 Windows, Messages, Classes, Forms, Controls;
44
45// -- TEWBFocusControl ---------------------------------------------------------
46
47type
48 TEWBFocusControl = class { Singleton }
49 private
50 constructor Create;
51 public
52 class procedure Activate(Value: Boolean);
53 end;
54
55 // Enable TEWBApplicationHook, if accessible at runtime only
56 // Enable_HookMainWindow must be defined in EWB.inc
57 // EWBHookMainWindow is activated by default.
58
59var
60 EWBEnableFocusControl: Boolean = True; // DO NOT CHANGE HERE
61
62implementation
63
64uses
65 EwbCoreTools;
66
67// -- FreeAndNil (SysUtils) ----------------------------------------------------
68
69procedure FreeAndNil(var Obj);
70var
71 Temp: TObject;
72begin
73 try
74 Temp := TObject(Obj);
75 finally
76 Pointer(Obj) := nil;
77 end;
78 Temp.Free;
79end;
80
81// -- TAppHookWindow ----------------------------------------------------------
82
83type
84 TAppHookWindow = class(TWinControl)
85 private
86 FHookSet: Boolean;
87 function MessageHook(var Msg: TMessage): Boolean;
88 public
89 destructor Destroy; override;
90 procedure Activate;
91 procedure Deactivate;
92 end;
93
94var
95 EWBAppHookInstance: TAppHookWindow;
96
97 // -- TEWBFocusControl ---------------------------------------------------------
98
99constructor TEWBFocusControl.Create;
100begin
101 inherited;
102 if EWBEnableFocusControl then
103 begin
104 if EWBAppHookInstance = nil then
105 begin
106 EWBAppHookInstance := TAppHookWindow.Create(nil);
107 EWBAppHookInstance.Activate;
108 end;
109 end;
110end;
111
112class procedure TEWBFocusControl.Activate(Value: Boolean)
113 {: TEWBApplicationHook};
114const
115{$J+}
116 Instance: TEWBFocusControl = nil;
117{$J-}
118begin
119 if EWBEnableFocusControl then
120 case Value of
121 True:
122 begin
123 if not Assigned(Instance) then
124 Instance := Create;
125 end;
126 False:
127 begin
128 if Assigned(EWBAppHookInstance) then
129 FreeAndNil(EWBAppHookInstance);
130 if Assigned(Instance) then
131 FreeAndNil(Instance);
132 end;
133 end;
134end;
135
136// -- TAppHookWindow -----------------------------------------------------------
137
138function TAppHookWindow.MessageHook(var Msg: TMessage): Boolean;
139var
140 ActiveControl: TWinControl;
141 ActiveForm: TCustomForm;
142 bContinue: Boolean;
143// s: string;
144begin
145 Result := False;
146 if (Msg.Msg = WM_WINDOWPOSCHANGING) or (Msg.Msg = CM_ACTIVATE) then
147 begin
148 ActiveForm := Screen.ActiveForm;
149 if Assigned(ActiveForm) then
150 begin
151 if Screen.ActiveForm.FormStyle = fsMDIChild then // Check if MDI
152 bContinue := IsChild(GetActiveWindow, ActiveForm.Handle)
153 else
154 bContinue := not Forms.Application.Terminated and (ActiveForm.Handle = GetActiveWindow);
155
156 if bContinue and (ActiveForm.CanFocus) then
157 begin
158 ActiveControl := ActiveForm.ActiveControl;
159 // s := '** MessageHook ' + ActiveControl.ClassName + ' ' + Inttostr(ActiveForm.Handle) + ' ' + Inttostr(GetFocus);
160 // OutputDebugString(PChar(s));
161 if Assigned(ActiveControl) and ((ActiveControl.ClassName = 'TEmbeddedWB') or
162 (ActiveControl.ClassName = 'TEWBCore')) then
163 if GetFocus <> ActiveControl.Handle then
164 begin
165 PostMessage(ActiveControl.Handle, WM_SETWBFOCUS, Integer(ActiveControl), 0);
166 // OutputDebugString(PChar('Focus set'));
167 // ActiveControl.SetFocus doesn't work when switching between forms.
168 end;
169 end;
170 end;
171 end;
172end;
173
174destructor TAppHookWindow.Destroy;
175begin
176 inherited;
177 Deactivate;
178end;
179
180procedure TAppHookWindow.Activate;
181begin
182 if (not FHookSet) and EWBEnableFocusControl then
183 if Assigned(Application) then
184 begin
185 Application.HookMainWindow(MessageHook);
186 FHookSet := True;
187 end;
188end;
189
190procedure TAppHookWindow.Deactivate;
191begin
192 if Assigned(Application) then
193 begin
194 Application.UnHookMainWindow(MessageHook);
195 FHookSet := False;
196 end;
197end;
198
199end.
Note: See TracBrowser for help on using the repository browser.