aqdockingvs2005.pas

AutomatedDocking Library 控件源代码修改 适合Delphi 2009 和C++ Builder 20009 使用。 修正汉字不能正确显示问题

{*******************************************************************}
{                                                                   }
{       AutomatedDocking Library (Cross-Platform Edition)           }
{                                                                   }
{       Copyright (c) 1999-2008 AutomatedQA Corp.                   }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{   The entire contents of this file is protected by U.S. and       }
{   International Copyright Laws. Unauthorized reproduction,        }
{   reverse-engineering, and distribution of all or any portion of  }
{   the code contained in this file is strictly prohibited and may  }
{   result in severe civil and criminal penalties and will be       }
{   prosecuted to the maximum extent possible under the law.        }
{                                                                   }
{   RESTRICTIONS                                                    }
{                                                                   }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES           }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE    }
{   SECRETS OF AUTOMATEDQA CORP. THE REGISTERED DEVELOPER IS        }
{   LICENSED TO DISTRIBUTE THE AUTOMATEDDOCKING LIBRARY AND ALL     }
{   ACCOMPANYING VCL AND CLX CONTROLS AS PART OF AN EXECUTABLE      }
{   PROGRAM ONLY.                                                   }
{                                                                   }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED      }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE        }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE       }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT WRITTEN CONSENT          }
{   AND PERMISSION FROM AUTOMATEDQA CORP.                           }
{                                                                   }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON       }
{   ADDITIONAL RESTRICTIONS.                                        }
{                                                                   }
{*******************************************************************}

unit aqDockingVS2005;

{$I aqDockingVer.inc}

interface

uses
  Types, Classes, Controls, Contnrs, ExtCtrls, Forms, Graphics, Messages, AppEvnts,
  aqDockingBase, aqDocking, aqMaskForms, aqDockingUtils, aqDockingUI;

const
  SVS2005DockingStyleName = 'VS2005';

  dziLeft         = 0;
  dziTop          = 1;
  dziRight        = 2;
  dziBottom       = 3;
  dziInside       = 4;
  dziDetachedLeft   = 5;
  dziDetachedTop    = 6;
  dziDetachedRight  = 7;
  dziDetachedBottom = 8;
  dziInsideBottom = 9;

type
  TaqVS2005DockingStyle = class;

  TaqDockerFadeDelay = 25..5000;
  TaqDockingZoneRegion = drtLeft..drtDetachedBottom;
  TaqDockingZoneImage = dziLeft..dziInsideBottom;

  TaqVS2005Docker = class(TaqDocker)
  private
    function GetStyle: TaqVS2005DockingStyle;
  protected
    function GetDockingZoneOffset(ARegion: TaqDockingRegionType): TPoint;
    property Style: TaqVS2005DockingStyle read GetStyle;
  public
    { TaqDocker }
    function GetDockingRegionType(APoint: TPoint): TaqDockingRegionType; override;
    function GetDockingZoneRgn(ARegion: TaqDockingRegionType): TaqHandle; override;
    function HasDockingZone(ARegion: TaqDockingRegionType): Boolean; override;
    function GetDockingRect(ARegion: TaqDockingRegionType; ADragControl: TaqCustomDockingControl): TRect; override;
    function GetDockingFrameRgn(ARegion: TaqDockingRegionType; ADragControl: TaqCustomDockingControl): TaqHandle; override;
  end;

  TaqVS2005MainItemDocker = class(TaqVS2005Docker)
  public
    function GetDockingRegionType(APoint: TPoint): TaqDockingRegionType; override;
    function GetDockingZoneRgn(ARegion: TaqDockingRegionType): TaqHandle; override;
    function HasDockingZone(ARegion: TaqDockingRegionType): Boolean; override;
  end;

  TaqDockingZone = class(TCustomForm)
  private
    FImages: TImageList;
    FActiveImages: TImageList;
    FActive: Boolean;
    FImageIndex: Integer;
    FFadeTimer: TTimer;
    FAlphaBlendDelta: Double;
    FEndAlphaBlendValue: Byte;
    FFadeCounter: Integer;
    FRegion: TaqHandle;
    procedure FadeDelayTimer(Sender: TObject);
  protected
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure InternalShow(Show: Boolean);
    procedure Paint; override;
    procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
  public
    constructor CreateEx(AImages: TImageList; AActiveImages: TImageList; AImageIndex: Integer);
    destructor Destroy; override;
    procedure Fade(Transparency: Byte; FadeDelay: TaqDockerFadeDelay);
    procedure MakeVisible(Transparency: Byte);
    procedure SetRegion(ARegion: TaqHandle);
  end;

  TaqDockingZoneController = class(TObject)
  private
    FStyle: TaqVS2005DockingStyle;
    FDocker: TaqDocker;
    FControl: TaqCustomDockingControl;
    FDockZones: array [TaqDockingZoneRegion] of TaqDockingZone;
    FActiveRegion: TaqDockingRegionType;
    function GetDockZones(Region: TaqDockingZoneRegion): TaqDockingZone;
    procedure SetActiveRegion(ARegionType: TaqDockingRegionType);
  protected
    property Control: TaqCustomDockingControl read FControl;
  public
    constructor Create(AStyle: TaqVS2005DockingStyle; AControl: TaqCustomDockingControl);
    destructor Destroy; override;

    procedure Show(Transparency: Byte);
    procedure Hide;
    procedure Fade(Transparency: Byte; FadeDelay: TaqDockerFadeDelay);
    function FindDockingRegion(APoint: TPoint): TaqDockingRegionType;

    property ActiveRegion: TaqDockingRegionType read FActiveRegion write SetActiveRegion;
    property DockZones[Region: TaqDockingZoneRegion]: TaqDockingZone read GetDockZones;
  end;

  TaqVS2005Mover = class(TaqMover)
  private
    FControllers: TaqBucketList;
    FActiveControllers: TList;
    FHotController: TaqDockingZoneController;
    FDragJustStarted: Boolean;
    FShowAllDockZones: Boolean;
    FOriginDragPosition: TPoint;
    FDragDockControlSite: TaqCustomDockingSite;
    procedure ClearDockingZones;
    procedure EnumDockingZones;
    procedure ShowDockingZones;
    function GetStyle: TaqVS2005DockingStyle;
    function IsDockingSiteVisible(DockSite: TaqCustomDockingSite): Boolean;
    function IsDockingControlVisible(DockControl: TaqCustomDockingControl): Boolean;
  protected
    { TaqMover }
    procedure DoDragDock(Target: TaqCustomDockingControl; Coord: TPoint;
      FrameRgn: TaqHandle; var Info: string; var CanDock, CanFloat: Boolean); override;
    function FindDockingControlInternal(const Coord: TPoint): TaqCustomDockingControl;
    function FindDockingControl(const Coord: TPoint): TaqCustomDockingControl; override;
    procedure EnterInsideContainer(AContainer: TaqInsideContainer; ARegion: TaqDockingRegionType); override;
    procedure LeaveInsideContainer(AContainer: TaqInsideContainer); override;
    function CanDockTo(DockTarget: TaqCustomDockingControl): Boolean; override;

    function ControllerByControl(AControl: TaqCustomDockingControl): TaqDockingZoneController;
    function ControllersByControl(AControl: TaqCustomDockingControl): TList;
    function ControllerIterator: TaqCustomBucketListIterator;
    procedure SetActiveControllers(Value: TList);
    procedure SetHotControllerActiveRegion(Point: TPoint);
    procedure UpdateActiveControllers(Control: TaqCustomDockingControl; Point: TPoint;
      CanDock: Boolean);
    property Style: TaqVS2005DockingStyle read GetStyle;
  public
    { TaqCustomMover }
    procedure StartDragging; override;
    procedure EndDragging(const Coord: TPoint; const Bounds: TRect); override;
    procedure CancelDragging(const Coord: TPoint); override;

    constructor Create(ADockingManager: TaqCustomDockingManager); override;
    destructor Destroy; override;
  end;

  TaqCustomPaintStage = (cpsBefore, cpsAfter);
  TaqCustomFramePaintEvent = procedure (Sender: TObject; Canvas: TCanvas;
    Region: TaqHandle; Rect: TRect; Stage: TaqCustomPaintStage; var DefaultDrawing: Boolean) of object;

  TaqVS2005MaskForm = class(TaqTranslucentMaskForm)
  private
    FTransparency: Byte;
    FOnCustomPaint: TaqCustomFramePaintEvent;
    FBrush: TBrush;
    FBorder: TBrush;
    procedure UpdateTransparency;
    procedure SetTransparency(const Value: Byte);
    procedure SetBrush(const Value: TBrush);
    procedure SetBorder(const Value: TBrush);
    procedure DoColorChanged(Sender: TObject);
  protected
    { TaqCustomMaskForm }
    procedure DoCreateMask; override;
    procedure SetBoundsRect(const Value: TRect); override;
    { TaqTranslucentMaskForm }
    procedure FormPaint(Sender: TObject); override;
    function GetFormClass: TCustomFormClass; override;
  public
    constructor Create; override;
    destructor Destroy; override;

    property Border: TBrush read FBorder write SetBorder;
    property Brush: TBrush read FBrush write SetBrush;
    property Transparency: Byte read FTransparency write SetTransparency;
    property OnCustomPaint: TaqCustomFramePaintEvent read FOnCustomPaint write FOnCustomPaint;
  end;

  TaqVS2005DockingFrame = class(TaqDockingFrame)
  private
    function GetStyle: TaqVS2005DockingStyle;
  protected
    { TaqCustomDockingFrame }
    function GetMaskFormClass: TaqCustomMaskFormClass; override;

    property Style: TaqVS2005DockingStyle read GetStyle;
  public
    constructor Create(ADockingManager: TaqCustomDockingManager); override;
    destructor Destroy; override;
  end;

  TaqVS2005DockingFrameOptions = class(TPersistent)
  private
    FOwner: TaqVS2005DockingStyle;
    FTransparency: Byte;
    FBorder: TBrush;
    FBrush: TBrush;
    FForm: TaqVS2005MaskForm;
    FOnCustomPaint: TaqCustomFramePaintEvent;
    FBorderSize: TaqFrameSize;
    procedure DoColorChanged(Sender: TObject);
    procedure SetBrush(const Value: TBrush);
    procedure SetBorder(const Value: TBrush);
    procedure SetBorderSize(const Value: TaqFrameSize);
  protected
    procedure RegisterForm(AForm: TaqVS2005MaskForm);
    procedure UnregisterForm;
    procedure DoCustomFramePaint(Sender: TObject; Canvas: TCanvas;
      Region: TaqHandle; Rect: TRect; Stage: TaqCustomPaintStage;
      var DefaultDrawing: Boolean);

    function GetOwner: TPersistent; override;
  public
    constructor Create(AOwner: TaqVS2005DockingStyle);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property Border: TBrush read FBorder write SetBorder;
    property BorderSize: TaqFrameSize read FBorderSize write SetBorderSize default 2;
    property Brush: TBrush read FBrush write SetBrush;
    property Transparency: Byte read FTransparency write FTransparency default 128;

    property OnCustomPaint: TaqCustomFramePaintEvent read FOnCustomPaint write FOnCustomPaint;
  end;

  TaqVS2005DockingZoneOptions = class(TPersistent)
  private
    FOwner: TaqVS2005DockingStyle;
    FFadeInDelay: TaqDockerFadeDelay;
    FFadeOutDelay: TaqDockerFadeDelay;
    FActiveTransparency: Byte;
    FTransparency: Byte;
  protected
    function GetOwner: TPersistent; override;
    procedure DoColorChanged(Sender: TObject);
  public
    constructor Create(AOwner: TaqVS2005DockingStyle);
    procedure Assign(Source: TPersistent); override;
  published
    property ActiveTransparency: Byte read FActiveTransparency write FActiveTransparency;
    property FadeInDelay: TaqDockerFadeDelay read FFadeInDelay write FFadeInDelay;
    property FadeOutDelay: TaqDockerFadeDelay read FFadeOutDelay write FFadeOutDelay;
    property Transparency: Byte read FTransparency write FTransparency;
  end;


  TaqDockingZoneImageMetrics = array [TaqDockingZoneImage] of record
    Size: TPoint;
    Offset: TPoint;
    Region: TaqHandle;
  end;

  TaqVS2005DockingStyle = class(TaqDockingStyle)
  private
    FAppEvents: TApplicationEvents;
    FImages: TImageListDIB;
    FActiveImages: TImageListDIB;
    FImageMetrics: TaqDockingZoneImageMetrics;
    FDockingFrame: TaqVS2005DockingFrameOptions;
    FActiveDockZone: TaqVS2005DockingZoneOptions;
    FDockZone: TaqVS2005DockingZoneOptions;
    FFlashZonesOnStart: Boolean;
    function GetImages: TImageList;
    function GetActiveImages: TImageList;
    function GetImageIndex(Control: TaqCustomDockingControl;
      Region: TaqDockingZoneRegion): TaqDockingZoneImage;
    procedure SetDockingFrame(const Value: TaqVS2005DockingFrameOptions);
    procedure SetActiveDockZone(const Value: TaqVS2005DockingZoneOptions);
    procedure SetDockZone(const Value: TaqVS2005DockingZoneOptions);
    procedure AppSettingChange(Sender: TObject; Flag: Integer;
      const Section: string; var Result: Longint);
  protected
    function  CreateImageList: TImageList; virtual;
    function  GetDockImageMetrics: TaqDockingZoneImageMetrics; virtual;
    function  HasActiveImages: Boolean; virtual;
    procedure UpdateImages; virtual;
    procedure UpdateActiveImages; virtual;
    property Images: TImageList read GetImages;
    property ActiveImages: TImageList read GetActiveImages;
    { TaqDockingStyle }
    function GetDockingFrameClass: TaqDockingFrameClass; override;
    function GetMoverClass: TaqMoverClass; override;
    function GetDockerClass(DockClass: TaqCustomDockingControlClass): TaqDockerClass; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property ActiveDockZone: TaqVS2005DockingZoneOptions read FActiveDockZone write SetActiveDockZone;
    property DockingFrame: TaqVS2005DockingFrameOptions read FDockingFrame write SetDockingFrame;
    property DockZone: TaqVS2005DockingZoneOptions read FDockZone write SetDockZone;
    property FlashZonesOnStart: Boolean read FFlashZonesOnStart write FFlashZonesOnStart default True;
  end;


implementation

{$R *.res}

uses
  SysUtils, Math, Windows, ImgList, aqDockingConst;

{$EXTERNALSYM GetRandomRgn}
function GetRandomRgn(DC: hDC; RGN: hRGN; iNum: Longint): Longint; stdcall; external gdi32 name 'GetRandomRgn';

const
  HideInterval: TaqDockerFadeDelay = 25;
  DefaultTabOrientation: TaqTabOrientation = dtoBottom;
  DefaultTabSize = 50;
  SActiveImagePrefix = 'ACTIVE';
  SDockImageResNames: array [TaqDockingZoneImage] of string = (
    'VSDOCKLEFT',
    'VSDOCKTOP',
    'VSDOCKRIGHT',
    'VSDOCKBOTTOM',
    'VSDOCKINSIDE',
    'VSDOCKPARENTLEFT',
    'VSDOCKPARENTTOP',
    'VSDOCKPARENTRIGHT',
    'VSDOCKPARENTBOTTOM',
    'VSDOCKINSIDE'
  );

function TransparencyAvailable: Boolean;
begin
  Result := Win32Platform = VER_PLATFORM_WIN32_NT;
end;

type
  TaqCustomDockingSiteFriend = class(TaqCustomDockingSite);
  TaqCustomDockingControlFriend = class(TaqCustomDockingControl);
  TaqDockingManagerFriend = class(TaqDockingManager);
  TaqInsideContainerFriend = class(TaqInsideContainer);

  TaqTranslucentForm = class(TCustomForm)
  protected
    procedure WMEraseBackground(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMCaptureChanged(var Message: TMessage); message WM_CAPTURECHANGED;
    procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
    procedure CNSysKeyDown(var Message: TWMKeyDown); message CN_SYSKEYDOWN;
  public
    constructor CreateNew(AOwner: TComponent; Dummy: Integer); override;
  end;

{ TaqVS2005DockingStyle }

procedure TaqVS2005DockingStyle.AppSettingChange(Sender: TObject;
  Flag: Integer; const Section: string; var Result: Integer);
begin
  if Flag = 0 then
  begin
    UpdateImages;
    Result := 1;
  end;
end;

procedure TaqVS2005DockingStyle.Assign(Source: TPersistent);