source: cprs/branches/tmg-cprs/CPRS-Chart/TMG_Extra/HTMLEdit/EwbControlComponent.pas@ 1802

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

TMG Ver 1.1 Added HTML Support, better demographics editing

File size: 11.2 KB
Line 
1//***********************************************************
2// EwbControl component *
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 EwbControlComponent;
37
38interface
39
40{$I EWB.inc}
41
42uses
43 Windows, Messages, SysUtils, Classes, Forms, EWBMouseHook;
44
45{============================================================================}
46// Mouse WheelFix
47{============================================================================}
48type
49 TMouseWheelFix = class(TPersistent)
50 private
51 FActive: Boolean;
52 FActiveFormOnly: Boolean;
53 FEWBMouseHook: TEWBMouseHook;
54 FDesignMode: Boolean;
55 procedure SetActive(const Value: Boolean);
56 procedure SetActiveFormOnly(const Value: Boolean);
57 public
58 OnMouseWheel: TMouseWheelEvent;
59 published
60 property Active: Boolean read FActive write SetActive default True;
61 property ActiveFormOnly: Boolean read FActiveFormOnly write SetActiveFormOnly
62 default False;
63 end;
64
65 {============================================================================}
66 // FocusControl
67 {============================================================================}
68type
69 TFocusControl = class(TPersistent)
70 private
71 FActive: Boolean;
72 FDesignMode: Boolean;
73 procedure SetActive(const Value: Boolean);
74 published
75 property Active: Boolean read FActive write SetActive default True;
76 end;
77
78 {============================================================================}
79 // OnMessage Handler
80 {============================================================================}
81{
82type
83 TMessageHandler = class(TPersistent)
84 private
85 FActive: Boolean;
86 FDesignMode: Boolean;
87 FOnMessage: TMessageEvent;
88 procedure SetActive(const Value: Boolean);
89 published
90 property Active: Boolean read FActive write SetActive default True;
91 end;
92}
93
94{$IFDEF Enable_InternetFeatures}
95 {============================================================================}
96 { Feature Controls }
97 { http://msdn.microsoft.com/en-us/library/ms537169(VS.85).aspx }
98 { TInternetFeatures = (
99    FEATURE_OBJECT_CACHING
100    FEATURE_ZONE_ELEVATION
101    FEATURE_MIME_HANDLING
102    FEATURE_MIME_SNIFFING
103    FEATURE_WINDOW_RESTRICTIONS
104    FEATURE_WEBOC_POPUPMANAGEMENT
105    FEATURE_BEHAVIORS
106    FEATURE_DISABLE_MK_PROTOCOL
107    FEATURE_LOCALMACHINE_LOCKDOWN
108    FEATURE_SECURITYBAND
109    FEATURE_RESTRICT_ACTIVEXINSTALL
110    FEATURE_VALIDATE_NAVIGATE_URL
111    FEATURE_RESTRICT_FILEDOWNLOAD
112    FEATURE_ADDON_MANAGEMENT
113    FEATURE_PROTOCOL_LOCKDOWN
114    FEATURE_HTTP_USERNAME_PASSWORD_DISABLE
115    FEATURE_SAFE_BINDTOOBJECT
116    FEATURE_UNC_SAVEDFILECHECK
117    FEATURE_GET_URL_DOM_FILEPATH_UNENCODED
118    FEATURE_TABBED_BROWSING
119    FEATURE_SSLUX
120    FEATURE_DISABLE_NAVIGATION_SOUNDS
121    FEATURE_DISABLE_LEGACY_COMPRESSION
122    FEATURE_FORCE_ADDR_AND_STATUS
123    FEATURE_XMLHTTP
124    FEATURE_DISABLE_TELNET_PROTOCOL
125    FEATURE_FEEDS
126    FEATURE_BLOCK_INPUT_PROMPTS
127    FEATURE_ENTRY_COUNT);
128 }
129
130 TInternetFeatureList = (
131 ObjectCaching, ZoneElevation, MimeHandling, MimeSniffing, WindowRestrictions,
132 WebocPopupManagement, Behaviors, DisableMkProtocol, LocalMachineLockDown,
133 Securityband, RestrictActivexInstall, ValidateNavigateUrl, RestrictFileDownload,
134 AddonManagement, ProtocolLockdown, HttpUsernamePasswordDisable, SafeBindToObject,
135 UncSavedFileCheck, GetUrlDomFilePathUnencoded, TabbedBrowsing, Sslux,
136 DisableNavigationSounds, DisableLegacyCompression, ForceAddrAndStatus,
137 XmlHttp, DisableTelnetProtocol, Feeds, BlockInputPrompts, EntryCount
138 );
139 TInternetFeatures = set of TInternetFeatureList;
140{$ENDIF Enable_InternetFeatures}
141
142{============================================================================}
143// TEwbControl
144{============================================================================}
145
146type
147 TEwbControl = class(TComponent)
148 private
149 { Private declarations }
150 FMouseWheelFix: TMouseWheelFix;
151 FFocusControl: TFocusControl;
152 // FMessageHandler: TMessageHandler;
153 // FOnMessage: TMessageEvent;
154 FOnMouseWheel: TMouseWheelEvent;
155 FDesignMode: Boolean;
156{$IFDEF Enable_InternetFeatures}
157 FInternetFeatures: TInternetFeatures;
158 procedure SetInternetFeatures(const Value: TInternetFeatures);
159{$ENDIF}
160 // procedure DoMessage(var Msg: TMsg; var Handled: Boolean);
161 protected
162 { Protected declarations }
163 // procedure ProcessWBEvents(var Msg: TMsg; var Handled: Boolean);
164{$IFDEF Enable_InternetFeatures}
165 procedure UpdateInternetFeatures;
166 procedure SetDefaultInternetFeatures;
167{$ENDIF}
168
169 public
170 { Public declarations }
171 constructor Create(AOwner: TComponent); override;
172 destructor Destroy; override;
173 procedure Loaded; override;
174 published
175 { Published declarations }
176 property MouseWheelFix: TMouseWheelFix read FMouseWheelFix write
177 FMouseWheelFix;
178 property FocusControl: TFocusControl read FFocusControl write FFocusControl;
179 // property MessageHandler: TMessageHandler read FMessageHandler write FMessageHandler;
180 // property OnMessage: TMessageEvent read FOnMessage write FOnMessage;
181 property OnMouseWheel: TMouseWheelEvent read FOnMouseWheel write
182 FOnMouseWheel;
183{$IFDEF Enable_InternetFeatures}
184 property InternetFeatures: TInternetFeatures read FInternetFeatures
185 write SetInternetFeatures default [];
186{$ENDIF}
187 end;
188
189implementation
190
191uses
192 EwbFocusControl, EwbAcc, IEConst;
193
194procedure TFocusControl.SetActive(const Value: Boolean);
195begin
196 FActive := Value;
197 if not FDesignMode then
198 TEWBFocusControl.Activate(Value);
199end;
200
201{procedure TMessageHandler.SetActive(const Value: Boolean);
202begin
203 FActive := Value;
204 if not FDesignMode then
205 begin
206 if FActive then
207 Application.OnMessage := FOnMessage;
208 end;
209end; }
210
211procedure TMouseWheelFix.SetActiveFormOnly(const Value: Boolean);
212begin
213 FActiveFormOnly := Value;
214 if Assigned(FEWBMouseHook) then
215 FEWBMouseHook.FActiveFormOnly := FActiveFormOnly;
216end;
217
218procedure TMouseWheelFix.SetActive(const Value: Boolean);
219begin
220 FActive := Value;
221 if not FDesignMode then
222 if Value then
223 begin
224 if FEWBMouseHook = nil then
225 begin
226 FEWBMouseHook := TEWBMouseHook.Create;
227 FEWBMouseHook.OnMouseWheel := OnMouseWheel;
228 FEWBMouseHook.FActiveFormOnly := FActiveFormOnly;
229 FEWBMouseHook.Activate;
230 end;
231 end
232 else
233 begin
234 if Assigned(FEWBMouseHook) then
235 begin
236 try
237 FEWBMouseHook.Deactivate;
238 finally
239 FreeAndNil(FEWBMouseHook);
240 end;
241 end;
242 end;
243end;
244
245procedure TEwbControl.Loaded;
246begin
247 inherited Loaded;
248 if Assigned(FMouseWheelFix) then
249 FMouseWheelFix.OnMouseWheel := OnMouseWheel;
250 { if Assigned(FMessageHandler) then
251 FMessageHandler.FOnMessage := DoMessage; }
252end;
253
254constructor TEwbControl.Create(AOwner: TComponent);
255begin
256 inherited Create(AOwner);
257
258 FDesignMode := (csDesigning in ComponentState);
259
260 FMouseWheelFix := TMouseWheelFix.Create;
261 FMouseWheelFix.FDesignMode := FDesignMode;
262 FMouseWheelFix.FActive := True;
263
264 FFocusControl := TFocusControl.Create;
265 FFocusControl.FDesignMode := FDesignMode;
266 FFocusControl.FActive := True;
267
268{$IFDEF Enable_InternetFeatures}
269 if FDesignMode then
270 SetDefaultInternetFeatures;
271{$ENDIF}
272
273 { FMessageHandler := TMessageHandler.Create;
274 FMessageHandler.FDesignMode := FDesignMode;
275 FMessageHandler.FOnMessage := DoMessage;
276
277 FMessageHandler.FActive := True; }
278end;
279
280destructor TEwbControl.Destroy;
281begin
282 if not (csDesigning in ComponentState) then
283 begin
284 { if Assigned(FMessageHandler) then
285 begin
286 FMessageHandler.Active := False;
287 Application.OnMessage := nil;
288 FreeAndNil(FMessageHandler);
289 end; }
290 if Assigned(FMouseWheelFix) then
291 begin
292 FMouseWheelFix.Active := False;
293 FreeAndNil(FMouseWheelFix);
294 end;
295 if Assigned(FFocusControl) then
296 begin
297 FFocusControl.Active := False;
298 FreeAndNil(FFocusControl);
299 end;
300 end;
301 inherited Destroy;
302end;
303
304{$IFDEF Enable_InternetFeatures}
305
306procedure TEwbControl.UpdateInternetFeatures;
307var
308 dco: TInternetFeatureList;
309begin
310 if (FInternetFeatures <> []) then
311 for dco := Low(TInternetFeatureList) to High(TInternetFeatureList) do
312 CoInternetSetFeatureEnabled(TInternetFeature(dco), FEATURE_FROM_PROCESS, (dco in FInternetFeatures));
313end;
314
315procedure TEwbControl.SetInternetFeatures(const Value: TInternetFeatures);
316begin
317 FInternetFeatures := Value;
318 UpdateInternetFeatures;
319end;
320
321procedure TEwbControl.SetDefaultInternetFeatures;
322var
323 dco: TInternetFeatureList;
324begin
325 FInternetFeatures := [];
326 for dco := Low(TInternetFeatureList) to High(TInternetFeatureList) do
327 if CoInternetIsFeatureEnabled(TInternetFeature(dco), FEATURE_FROM_PROCESS) = S_OK then
328 FInternetFeatures := FInternetFeatures + [TInternetFeatureList(dco)];
329end;
330
331{$ENDIF}
332
333{
334procedure TEwbControl.ProcessWBEvents(var Msg: TMsg; var Handled: Boolean);
335begin
336end;
337
338procedure TEwbControl.DoMessage(var Msg: TMsg; var Handled: Boolean);
339begin
340 if Assigned(FOnMessage) then
341 begin
342 FOnMessage(Msg, Handled);
343 end;
344 ProcessWBEvents(Msg, Handled);
345end;
346}
347
348end.
Note: See TracBrowser for help on using the repository browser.