aqmaskforms.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 aqMaskForms;

{$I aqDockingVer.inc}

interface

uses
{$IFDEF VCL}
  Windows, Graphics, Controls, Forms, Messages,
{$ELSE}
  Qt, QControls, QForms, QGraphics, QTypes,
{$ENDIF}
 SysUtils, Types, Classes, aqDockingUI, aqDockingUtils;

type
  TEndDragEvent = procedure (Sender: TObject; Successful: Boolean) of object;

  TaqCustomMaskForm = class(TObject)
  private
    FCursorOffset: TPoint;
    FFrameSize: TaqFrameSize;
    FCaptured: Boolean;
    FDragFinished: Boolean;
    FDestroyed: Boolean;
    FOnMouseDown: TMouseEvent;
    FOnMouseMove: TMouseMoveEvent;
    FOnMouseUp: TMouseEvent;
    FOnFinalize: TNotifyEvent;
    FOnEndDrag: TEndDragEvent;
    procedure SetFrameSize(const Value: TaqFrameSize);
  protected
    function GetHeight: Integer; virtual; abstract;
    function GetRegion: TaqHandle; virtual; abstract;
    function GetWidth: Integer; virtual; abstract;
    procedure SetBoundsRect(const Value: TRect); virtual; abstract;
    procedure SetRegion(const Value: TaqHandle); virtual; abstract;
    procedure DoCreateMask; virtual; abstract;
    procedure DoDestroyMask; virtual; abstract;
    function GetBoundsRect: TRect; virtual; abstract;
    procedure SetVisible(const Value: Boolean); virtual; abstract;
    function GetVisible: Boolean; virtual; abstract;
    function ClientToScreen(P: TPoint): TPoint; virtual; abstract;
    procedure DoCaptureFocus; virtual;
    procedure DoReleaseFocus; virtual;
    procedure DoMouseMove(Shift: TShiftState; X, Y: Integer); virtual;
    procedure DoMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
    procedure DoMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
    procedure DoEndDrag(Successful: Boolean); virtual;
    procedure DoResize; virtual;
    procedure DoFrameSizeChanged; virtual;
    procedure DoPaint; virtual; abstract;

    property Captured: Boolean read FCaptured;
    property DragFinished: Boolean read FDragFinished;
    property Destroyed: Boolean read FDestroyed;
  public
    constructor Create; virtual;
    destructor Destroy; override;

    procedure EndDrag(Successful: Boolean);
    procedure Release; virtual;
    procedure Finalize; virtual;
    function SupportsRegions: Boolean; virtual;

    property CursorOffset: TPoint read FCursorOffset write FCursorOffset;
    property BoundsRect: TRect read GetBoundsRect write SetBoundsRect;
    property Width: Integer read GetWidth;
    property Height: Integer read GetHeight;
    property Visible: Boolean read GetVisible write SetVisible;
    property FrameSize: TaqFrameSize read FFrameSize write SetFrameSize;
    property Region: TaqHandle read GetRegion write SetRegion;

    property OnEndDrag: TEndDragEvent read FOnEndDrag write FOnEndDrag;
    property OnFinalize: TNotifyEvent read FOnFinalize write FOnFinalize;
    property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
    property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
    property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
  end;

  TaqCustomMaskFormClass = class of TaqCustomMaskForm;

  TaqTranslucentMaskForm = class(TaqCustomMaskForm)
  private
    FForm: TCustomForm;
    FRegion: TaqHandle;
    FLastMouseState: TShiftState;
  protected
    { TaqCustomMaskForm }
    function GetHeight: Integer; override;
    function GetWidth: Integer; override;
    procedure DoCreateMask; override;
    procedure DoDestroyMask; override;
    procedure DoCaptureFocus; override;
    procedure DoReleaseFocus; override;
    procedure SetBoundsRect(const Value: TRect); override;
    function GetBoundsRect: TRect; override;
    function GetRegion: TaqHandle; override;
    procedure SetRegion(const Value: TaqHandle); override;
    procedure SetVisible(const Value: Boolean); override;
    function GetVisible: Boolean; override;
    function ClientToScreen(P: TPoint): TPoint; override;
    procedure DoFrameSizeChanged; override;

    procedure FormDeactivate(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormPaint(Sender: TObject); virtual;
    procedure FormShow(Sender: TObject);

    function GetFormClass: TCustomFormClass; virtual; abstract;
    property Form: TCustomForm read FForm;
  public
    constructor Create; override;

    function SupportsRegions: Boolean; override;
  end;
{$IFDEF VCL}
  TaqVCLMaskForm = class(TaqCustomMaskForm)
  private
    FHandle: THandle;
    FBrush: TBrush;
    FVisible: Boolean;
    FDrawRect: TRect;
    FBoundsRect: TRect;
    FLastMouseState: TShiftState;
    procedure MainWndProc(var Message: TMessage);
    procedure WndProc(var Msg: TMessage);
  protected
    procedure DrawFrame; virtual;
    { TaqCustomMaskForm }
    function GetHeight: Integer; override;
    function GetWidth: Integer; override;
    function GetRegion: TaqHandle; override;
    procedure SetRegion(const Value: TaqHandle); override;
    procedure DoCaptureFocus; override;
    procedure DoReleaseFocus; override;
    procedure DoCreateMask; override;
    procedure DoDestroyMask; override;
    procedure SetBoundsRect(const Value: TRect); override;
    function GetBoundsRect: TRect; override;
    procedure DoPaint; override;
    procedure SetVisible(const Value: Boolean); override;
    function GetVisible: Boolean; override;
    function ClientToScreen(P: TPoint): TPoint; override;
    procedure DoFrameSizeChanged; override;
  public
    constructor Create; override;
  end;
{$ELSE}
  TaqCLXMaskForm = class(TaqTranslucentMaskForm)
  private
    procedure FormDrawMask(Sender: TCustomForm; ACanvas: TCanvas);
  protected
    { TaqCustomMaskForm }
    procedure DoCaptureFocus; override;
    procedure DoReleaseFocus; override;
    procedure DoCreateMask; override;
    procedure SetVisible(const Value: Boolean); override;
    procedure DoFrameSizeChanged; override;
    { TaqTranslucentMaskForm }
    function GetFormClass: TCustomFormClass; override;
  end;
{$ENDIF}

{$IFDEF VCL}
  TaqMaskForm = TaqVCLMaskForm;
{$ELSE}
  TaqMaskForm = TaqCLXMaskForm;
{$ENDIF}

  TSplitterDropEvent = procedure (DropCoord: Integer) of object;
  TaqSplitterForm = class(TaqMaskForm)
  private
    FOrientation: TaqSplitterOrientation;
    FMinCoord: Integer;
    FMaxCoord: Integer;
    FCurrentCoord: Integer;
    FInitialized: Boolean;
    FOnSplitterDrop: TSplitterDropEvent;
    FCursor: TCursor;
    FSplitterParent: TWinControl;

    function FitInBounds(ALeft, ARight, AValue: Integer): Integer;
    procedure SetCursor(const Value: TCursor);
  protected
    procedure DrawFrame; override;

    procedure SetBoundsRect(const Value: TRect); override;

    procedure DoMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure DoMouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure DoEndDrag(Successful: Boolean); override;
  public
    constructor Create; override;

    property Cursor: TCursor read FCursor write SetCursor;
    property Orientation: TaqSplitterOrientation read FOrientation write FOrientation;
    property MinCoord: Integer read FMinCoord write FMinCoord;
    property MaxCoord: Integer read FMaxCoord write FMaxCoord;
    property SplitterParent: TWinControl read FSplitterParent write FSplitterParent;

    property OnSplitterDrop: TSplitterDropEvent read FOnSplitterDrop write FOnSplitterDrop;
  end;

implementation

const
{$IFDEF VCL}
  keyCtrl = VK_CONTROL;
  keyShift = VK_SHIFT;
  keyEsc = VK_ESCAPE;
{$ELSE}
  keyCtrl = Key_Control;
  keyShift = Key_Shift;
  keyEsc = key_Escape;
{$ENDIF}

type
  TCustomFormFriend = class(TCustomForm);

{$IFNDEF VCL}
  TaqDrawMaskEvent = procedure (Sender: TCustomForm; ACanvas: TCanvas) of object;

  TaqMaskedForm = class(TCustomForm)
  private
    FOnDrawMask: TaqDrawMaskEvent;
  protected
    procedure InitWidget; override;
    function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; override;
    procedure Resize; override;
    procedure DoDrawMask(ACanvas: TCanvas);
    procedure MaskChanged; override;
  public
    procedure Invalidate; override;
    procedure UpdateMask;

    property OnDrawMask: TaqDrawMaskEvent read FOnDrawMask write FOnDrawMask;
  end;
{$ENDIF}

{ TaqCustomMaskForm }

procedure TaqCustomMaskForm.DoCaptureFocus;
begin
  FCaptured := True;
end;

constructor TaqCustomMaskForm.Create;
begin
  inherited Create;
  DoCreateMask;
  DoCaptureFocus;
end;

destructor TaqCustomMaskForm.Destroy;
begin
  Finalize;
  inherited;
  FDestroyed := True;
end;

procedure TaqCustomMaskForm.DoEndDrag(Successful: Boolean);
begin
  Visible := False;
  FDragFinished := True;
  if Assigned(FOnEndDrag) then
    FOnEndDrag(Self, Successful);
end;

procedure TaqCustomMaskForm.EndDrag(Successful: Boolean);
begin
  if Captured then
  begin
    Visible := False;
    DoEndDrag(Successful);
  end;
end;

procedure TaqCustomMaskForm.Finalize;
begin
  FDragFinished := True;
  if Assigned(OnFinalize) then
    FOnFinalize(Self);
  DoDestroyMask;
  DoReleaseFocus;
end;

procedure TaqCustomMaskForm.DoFrameSizeChanged;
begin
end;

procedure TaqCustomMaskForm.DoMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOnMouseUp) then
    FOnMouseUp(Self, Button, Shift, X, Y);
end;

procedure TaqCustomMaskForm.DoMouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOnMouseMove) then
    FOnMouseMove(Self, Shift, X, Y);
end;

procedure TaqCustomMaskForm.DoMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOnMouseUp) then
    FOnMouseUp(Self, Button, Shift, X, Y);
end;

procedure TaqCustomMaskForm.Release;
begin
{$IFDEF VCL}
  Free;
{$ELSE}
  QApplication_postEvent(Application.Handle, QCustomEvent_create(QEventType_CMRelease, Self));
{$ENDIF}
end;

procedure TaqCustomMaskForm.DoReleaseFocus;
begin
  FCaptured := False;
end;

procedure TaqCustomMaskForm.DoResize;
begin
  DoPaint;
end;

procedure TaqCustomMaskForm.SetFrameSize(const Value: TaqFrameSize);
begin
  if FFrameSize <> Value then
  begin
    FFrameSize := Value;
    DoFrameSizeChanged;
  end;
end;

{$IFDEF VCL}

{ TaqVCLMaksForm }

procedure TaqVCLMaskForm.DoCaptureFocus;
begin
  if not Captured then
  begin
    FHandle := Classes.AllocateHWnd(MainWndProc);
    SetCapture(FHandle);
    inherited DoCaptureFocus;
  end;
end;

function TaqVCLMaskForm.ClientToScreen(P: TPoint): TPoint;
begin
  Result := P;
  Windows.ClientToScreen(FHandle, Result);
end;

constructor TaqVCLMaskForm.Create;
begin
  inherited Create;
  FLastMouseState := [];
end;

procedure TaqVCLMaskForm.DoCreateMask;
begin
  FBrush := TBrush.Create;
  FBrush.Bitmap := AllocPatternBitmap(clBlack, clWhite);
  FDrawRect := Rect(0, 0, 0, 0);

  FrameSize := 4;
end;

procedure TaqVCLMaskForm.DoDestroyMask;
begin
  FreeAndNil(FBrush);
end;

procedure TaqVCLMaskForm.DrawFrame;
var
  DesktopWindow: HWND;
  DC: HDC;
  OldBrush: HBrush;
begin
  if not Captured then Exit;

  DesktopWindow := GetDesktopWindow;
  DC := GetDCEx(DesktopWindow, 0, DCX_CACHE or DCX_LOCKWINDOWUPDATE);
  try
    OldBrush := SelectObject(DC, FBrush.Handle);
    with FDrawRect do
    begin
      PatBlt(DC, Left + FrameSize, Top, Right - Left - FrameSize, FrameSize, PATINVERT);
      PatBlt(DC, Right - FrameSize, Top + FrameSize, FrameSize, Bottom - Top - FrameSize, PATINVERT);
      PatBlt(DC, Left, Bottom - FrameSize, Right - Left - FrameSize, FrameSize, PATINVERT);
      PatBlt(DC, Left, Top, FrameSize, Bottom - Top - FrameSize, PATINVERT);
    end;
    SelectObject(DC, OldBrush);
  finally
    ReleaseDC(DesktopWindow, DC);
  end;
end;

procedure TaqVCLMaskForm.DoFrameSizeChanged;
begin
  DoPaint;
end;

function TaqVCLMaskForm.GetBoundsRect: TRect;
begin
  Assert(not IsRectEmpty(FBoundsRect));
  Result := FBoundsRect;
end;

function TaqVCLMaskForm.GetHeight: Integer;
begin
  Result := FBoundsRect.Bottom - FBoundsRect.Top;
end;

function TaqVCLMaskForm.GetVisible: Boolean;
begin
  Result := FVisible;
end;

function TaqVCLMaskForm.GetWidth: Integer;
begin
  Result := FBoundsRect.Right - FBoundsRect.Left;
end;

function TaqVCLMaskForm.GetRegion: TaqHandle;
begin
  Result := aqNullHandle;
end;

procedure TaqVCLMaskForm.SetRegion(const Value: TaqHandle);
begin
end;

procedure TaqVCLMaskForm.MainWndProc(var Message: TMessage);
begin
  try
    WndProc(Message);
  except
    Application.HandleException(Self);
  end;
end;

procedure TaqVCLMaskForm.DoPaint;
begin
  if Visible then
  begin
    if not IsRectEmpty(FDrawRect) then
      DrawFrame;
    FDrawRect := BoundsRect;
    DrawFrame;
  end;
end;

procedure TaqVCLMaskForm.DoReleaseFocus;
begin
  if Captured then
  begin
    inherited DoReleaseFocus;
    Windows.ReleaseCapture;
    Classes.DeallocateHWND(FHandle);
    FHandle := 0;
  end;
end;

procedure TaqVCLMaskForm.SetBoundsRect(const Value: TRect);
begin
  if (Value.Left <> FBoundsRect.Left) or (Value.Top <> FBoundsRect.Top) or
    (Value.Right <> FBoundsRect.Right) or (Value.Bottom <> FBoundsRect.Bottom) then
  begin
    Assert(not IsRectEmpty(Value));
    FBoundsRect := Value;
    DoPaint;
  end;
end;

procedure TaqVCLMaskForm.SetVisible(const Value: Boolean);
begin
  if FVisible <> Value then
  begin
    FDrawRect := BoundsRect;
    DrawFrame;
    FVisible := Value;
  end;
end;

procedure TaqVCLMaskForm.WndProc(var Msg: TMessage);
var
  P: TPoint;
  State: TShiftState;
begin
  if FDestroyed then
    Exit;
  try
    if (Msg.Msg >= WM_MOUSEFIRST) and (Msg.Msg <= WM_MOUSELAST) then
    begin
      P := ClientToScreen(SmallPointToPoint(TWMMouse(Msg).Pos));
      State := KeysToShiftState(Msg.WParam);
      FLastMouseState := State;
    end
    else if (Msg.Msg = CN_KEYDOWN) or (Msg.Msg = CN_KEYUP) then
    begin
      P := ClientToScreen(Mouse.CursorPos);
      State := KeyboardStateToShiftState + FLastMouseState;
    end
    else