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

//***********************************************************
//                       EwbControl component               *
//                                                          *
//                       For Delphi 5 to 2009               *
//                     Freeware Component                   *
//                            by                            *
//                          (smot)                          *
//                                                          *
//  Documentation and updated versions:                     *
//                                                          *
//               http://www.bsalsa.com                      *
//***********************************************************
{*******************************************************************************}
{LICENSE:
THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND,
EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED
WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE
AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE
AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE
OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED
OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS,
INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR
OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS,
AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY
DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE.

You may use, change or modify the component under 4 conditions:
1. In your website, add a link to "http://www.bsalsa.com"
2. In your application, add credits to "Embedded Web Browser"
3. Mail me  (bsalsa@gmail.com) any code change in the unit
   for the benefit of the other users.
4. Please, consider donation in our web site!
{*******************************************************************************}

unit EwbControlComponent;

interface

{$I EWB.inc}

uses
  Windows, Messages, SysUtils, Classes, Forms, EWBMouseHook;

{============================================================================}
// Mouse WheelFix
{============================================================================}
type
  TMouseWheelFix = class(TPersistent)
  private
    FActive: Boolean;
    FActiveFormOnly: Boolean;
    FEWBMouseHook: TEWBMouseHook;
    FDesignMode: Boolean;
    procedure SetActive(const Value: Boolean);
    procedure SetActiveFormOnly(const Value: Boolean);
  public
    OnMouseWheel: TMouseWheelEvent;
  published
    property Active: Boolean read FActive write SetActive default True;
    property ActiveFormOnly: Boolean read FActiveFormOnly write SetActiveFormOnly
      default False;
  end;

  {============================================================================}
  // FocusControl
  {============================================================================}
type
  TFocusControl = class(TPersistent)
  private
    FActive: Boolean;
    FDesignMode: Boolean;
    procedure SetActive(const Value: Boolean);
  published
    property Active: Boolean read FActive write SetActive default True;
  end;

  {============================================================================}
  // OnMessage Handler
  {============================================================================}
{
type
  TMessageHandler = class(TPersistent)
  private
    FActive: Boolean;
    FDesignMode: Boolean;
    FOnMessage: TMessageEvent;
    procedure SetActive(const Value: Boolean);
  published
    property Active: Boolean read FActive write SetActive default True;
  end;
}

{$IFDEF Enable_InternetFeatures}
  {============================================================================}
  { Feature Controls }
  { http://msdn.microsoft.com/en-us/library/ms537169(VS.85).aspx }
  { TInternetFeatures = (
    FEATURE_OBJECT_CACHING
    FEATURE_ZONE_ELEVATION
    FEATURE_MIME_HANDLING
    FEATURE_MIME_SNIFFING
    FEATURE_WINDOW_RESTRICTIONS
    FEATURE_WEBOC_POPUPMANAGEMENT
    FEATURE_BEHAVIORS
    FEATURE_DISABLE_MK_PROTOCOL
    FEATURE_LOCALMACHINE_LOCKDOWN
    FEATURE_SECURITYBAND
    FEATURE_RESTRICT_ACTIVEXINSTALL
    FEATURE_VALIDATE_NAVIGATE_URL
    FEATURE_RESTRICT_FILEDOWNLOAD
    FEATURE_ADDON_MANAGEMENT
    FEATURE_PROTOCOL_LOCKDOWN
    FEATURE_HTTP_USERNAME_PASSWORD_DISABLE
    FEATURE_SAFE_BINDTOOBJECT
    FEATURE_UNC_SAVEDFILECHECK
    FEATURE_GET_URL_DOM_FILEPATH_UNENCODED
    FEATURE_TABBED_BROWSING
    FEATURE_SSLUX
    FEATURE_DISABLE_NAVIGATION_SOUNDS
    FEATURE_DISABLE_LEGACY_COMPRESSION
    FEATURE_FORCE_ADDR_AND_STATUS
    FEATURE_XMLHTTP
    FEATURE_DISABLE_TELNET_PROTOCOL
    FEATURE_FEEDS
    FEATURE_BLOCK_INPUT_PROMPTS
    FEATURE_ENTRY_COUNT);
  }

  TInternetFeatureList = (
    ObjectCaching, ZoneElevation, MimeHandling, MimeSniffing, WindowRestrictions,
    WebocPopupManagement, Behaviors, DisableMkProtocol, LocalMachineLockDown,
    Securityband, RestrictActivexInstall, ValidateNavigateUrl, RestrictFileDownload,
    AddonManagement, ProtocolLockdown, HttpUsernamePasswordDisable, SafeBindToObject,
    UncSavedFileCheck, GetUrlDomFilePathUnencoded, TabbedBrowsing, Sslux,
    DisableNavigationSounds, DisableLegacyCompression, ForceAddrAndStatus,
    XmlHttp, DisableTelnetProtocol, Feeds, BlockInputPrompts, EntryCount
    );
  TInternetFeatures = set of TInternetFeatureList;
{$ENDIF Enable_InternetFeatures}

{============================================================================}
// TEwbControl
{============================================================================}

type
  TEwbControl = class(TComponent)
  private
    { Private declarations }
    FMouseWheelFix: TMouseWheelFix;
    FFocusControl: TFocusControl;
    //  FMessageHandler: TMessageHandler;
    //  FOnMessage: TMessageEvent;
    FOnMouseWheel: TMouseWheelEvent;
    FDesignMode: Boolean;
{$IFDEF Enable_InternetFeatures}
    FInternetFeatures: TInternetFeatures;
    procedure SetInternetFeatures(const Value: TInternetFeatures);
{$ENDIF}
    //  procedure DoMessage(var Msg: TMsg; var Handled: Boolean);
  protected
    { Protected declarations }
    //  procedure ProcessWBEvents(var Msg: TMsg; var Handled: Boolean);
{$IFDEF Enable_InternetFeatures}
    procedure UpdateInternetFeatures;
    procedure SetDefaultInternetFeatures;
{$ENDIF}

  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
  published
    { Published declarations }
    property MouseWheelFix: TMouseWheelFix read FMouseWheelFix write
      FMouseWheelFix;
    property FocusControl: TFocusControl read FFocusControl write FFocusControl;
    // property MessageHandler: TMessageHandler read FMessageHandler write FMessageHandler;
    // property OnMessage: TMessageEvent read FOnMessage write FOnMessage;
    property OnMouseWheel: TMouseWheelEvent read FOnMouseWheel write
      FOnMouseWheel;
{$IFDEF Enable_InternetFeatures}
    property InternetFeatures: TInternetFeatures read FInternetFeatures
      write SetInternetFeatures default [];
{$ENDIF}
  end;

implementation

uses
  EwbFocusControl, EwbAcc, IEConst;

procedure TFocusControl.SetActive(const Value: Boolean);
begin
  FActive := Value;
  if not FDesignMode then
    TEWBFocusControl.Activate(Value);
end;

{procedure TMessageHandler.SetActive(const Value: Boolean);
begin
  FActive := Value;
  if not FDesignMode then
  begin
    if FActive then
      Application.OnMessage := FOnMessage;
  end;
end; }

procedure TMouseWheelFix.SetActiveFormOnly(const Value: Boolean);
begin
  FActiveFormOnly := Value;
  if Assigned(FEWBMouseHook) then
    FEWBMouseHook.FActiveFormOnly := FActiveFormOnly;
end;

procedure TMouseWheelFix.SetActive(const Value: Boolean);
begin
  FActive := Value;
  if not FDesignMode then
    if Value then
    begin
      if FEWBMouseHook = nil then
      begin
        FEWBMouseHook := TEWBMouseHook.Create;
        FEWBMouseHook.OnMouseWheel := OnMouseWheel;
        FEWBMouseHook.FActiveFormOnly := FActiveFormOnly;
        FEWBMouseHook.Activate;
      end;
    end
    else
    begin
      if Assigned(FEWBMouseHook) then
      begin
        try
          FEWBMouseHook.Deactivate;
        finally
          FreeAndNil(FEWBMouseHook);
        end;
      end;
    end;
end;

procedure TEwbControl.Loaded;
begin
  inherited Loaded;
  if Assigned(FMouseWheelFix) then
    FMouseWheelFix.OnMouseWheel := OnMouseWheel;
  {  if Assigned(FMessageHandler) then
      FMessageHandler.FOnMessage := DoMessage; }
end;

constructor TEwbControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FDesignMode := (csDesigning in ComponentState);

  FMouseWheelFix := TMouseWheelFix.Create;
  FMouseWheelFix.FDesignMode := FDesignMode;
  FMouseWheelFix.FActive := True;

  FFocusControl := TFocusControl.Create;
  FFocusControl.FDesignMode := FDesignMode;
  FFocusControl.FActive := True;

{$IFDEF Enable_InternetFeatures}
  if FDesignMode then
    SetDefaultInternetFeatures;
{$ENDIF}

  {  FMessageHandler := TMessageHandler.Create;
    FMessageHandler.FDesignMode := FDesignMode;
    FMessageHandler.FOnMessage := DoMessage;

    FMessageHandler.FActive := True; }
end;

destructor TEwbControl.Destroy;
begin
  if not (csDesigning in ComponentState) then
  begin
  {  if Assigned(FMessageHandler) then
    begin
      FMessageHandler.Active := False;
      Application.OnMessage := nil;
      FreeAndNil(FMessageHandler);
    end;  }
    if Assigned(FMouseWheelFix) then
    begin
      FMouseWheelFix.Active := False;
      FreeAndNil(FMouseWheelFix);
    end;
    if Assigned(FFocusControl) then
    begin
      FFocusControl.Active := False;
      FreeAndNil(FFocusControl);
    end;
  end;
  inherited Destroy;
end;

{$IFDEF Enable_InternetFeatures}

procedure TEwbControl.UpdateInternetFeatures;
var
  dco: TInternetFeatureList;
begin
  if (FInternetFeatures <> []) then
    for dco := Low(TInternetFeatureList) to High(TInternetFeatureList) do
      CoInternetSetFeatureEnabled(TInternetFeature(dco), FEATURE_FROM_PROCESS, (dco in FInternetFeatures));
end;

procedure TEwbControl.SetInternetFeatures(const Value: TInternetFeatures);
begin
  FInternetFeatures := Value;
  UpdateInternetFeatures;
end;

procedure TEwbControl.SetDefaultInternetFeatures;
var
  dco: TInternetFeatureList;
begin
  FInternetFeatures := [];
  for dco := Low(TInternetFeatureList) to High(TInternetFeatureList) do
    if CoInternetIsFeatureEnabled(TInternetFeature(dco), FEATURE_FROM_PROCESS) = S_OK then
      FInternetFeatures := FInternetFeatures + [TInternetFeatureList(dco)];
end;

{$ENDIF}

{
procedure TEwbControl.ProcessWBEvents(var Msg: TMsg; var Handled: Boolean);
begin
end;

procedure TEwbControl.DoMessage(var Msg: TMsg; var Handled: Boolean);
begin
  if Assigned(FOnMessage) then
  begin
    FOnMessage(Msg, Handled);
  end;
  ProcessWBEvents(Msg, Handled);
end;
}

end.