fcimageform.pas

一套及时通讯的原码

unit fcimageform;
{
//
// Components : TfcImageForm
//
// Copyright (c) 1999 by Woll2Woll Software
//
// History:
// 5/10/99  PYW  Checked for click or mousedown event assigned for a control on a caption bar.
// 4/14/00  PYW  Use Window system command for dragging instead.
// 10/4/00 - RSW New ifRenderWithTImage property
// 1/8/2002 - PYW - Don't use perform.  Use postMessage instead.  More reliable.
//                  When drag full windows was true, perform didn't work and window would not drag.
// 5/24/2002 - Allow clicking on Caption Control to bring form to front.
//
}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Buttons, fcCommon, fcimage;

type

  TfcImageFormOption = (ifUseWindowsDrag, ifNoPaletteDither);
  // 10/4/00 -
  // ifRenderWithTImage will use Delphi's TImage code to paint,
  // otherwise use TfcBitmap.  This property is only releveant in
  // 256 color for palette switching.
  TfcImageFormOptions = set of TfcImageFormOption;

  TfcCustomImageForm = class(TfcCustomImage)
  private
    FDragTolerance: Integer;
    FTransparentColor: TColor;
    FRegion: HRgn;
    FCaptionBarControl:TControl;
//    FCaptureMessageClass: TfcCaptureMessageClass;
    FOptions: TfcImageFormOptions;

    LastFocusRect: TRect;    procedure ReadRegions(Reader: TStream);
    procedure WriteRegions(Writer: TStream);
    function GetPicture: TPicture;
    procedure SetPicture(Value: TPicture);
    procedure SetOptions(Value: TFcImageFormOptions);
    procedure SetCaptionBarControl(Value: TControl);
  protected
    DraggingForm: Boolean;
    procedure DestroyWnd;

    procedure Paint; override;
    function GetTransparentColor: TColor;
    procedure DrawFocusRect(DC: HDC; FocusRect: TRect); virtual;
    procedure WndProc(var Message: TMessage); override;

    procedure FormMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
    procedure DefineProperties(Filer: TFiler);override;
    procedure SetParent(Value:TWinControl); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure AfterFormWndProc(var Message: TMessage); virtual;

    procedure MouseLoop(X, Y: Integer); virtual;
    procedure MouseLoop_MouseMove(X, Y: Integer; ACursorPos: TPoint;
      var FirstTime: Boolean; var FocusRect: TRect; OriginalRect:TRect); virtual;
    procedure MouseLoop_MouseUp(X, Y: Integer; ACursorPos: TPoint;
      OriginalRect, FocusRect: TRect); virtual;
    function GetDragFullWindows: Boolean; virtual;

  public
    Patch: Variant;
    constructor Create(Aowner:TComponent); override;
    destructor Destroy; override;


    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure ApplyBitmapRegion; virtual;
    procedure ScaleRegion(xFact, yFact:Single);virtual;

    property RegionData: HRgn read FRegion stored True;
    property CaptionBarControl: TControl read FCaptionBarControl write SetCaptionBarControl;
    property DragTolerance: Integer read FDragTolerance write FDragTolerance;
    property Picture: TPicture read GetPicture write SetPicture;
    property TransparentColor: TColor read FTransparentColor write FTransparentColor default clNone;
    property Options: TfcImageFormOptions read FOptions write SetOptions default [];
  end;

  TfcImageForm = class(TfcCustomImageForm)
  published
    property Options;

    property Align;
    property AutoSize;
    property Picture;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;

    property CaptionBarControl;
    property DragTolerance;
    property TransparentColor;
  end;

implementation

{$r fcFrmBtn.RES}

var MouseHook : HHOOK;
    HookCount: integer;
    InHook: boolean;

function wwMouseHookProc(nCode: Integer; wParam: Integer; lParam: Integer): LResult; stdcall;
var ac: TWinControl;
    form: TCustomForm;
    ptControl,mouseControl: TControl;

    i: integer;
    imageform: TfcCustomImageForm;
    ClickOrMouseDownAssigned,PtInDragControl:boolean;
    currentpt:TPoint;
begin
  result := CallNextHookEx(MouseHook, nCode, wParam, lParam);
  if InHook then exit;

  with PMouseHookStruct(lParam)^ do
  begin
    if (wParam = WM_LBUTTONDOWN) or (wParam = WM_NCLBUTTONDOWN) then
    begin
       ac:= Screen.ActiveControl;
       if ac=nil then exit;           // 5/24/2002 - Apparently necessary when trayicons are used.
       ac:= GetParentForm(ac);
       if ac=nil then exit;
       form := TCustomForm(ac);

//       mousecontrol:= ac.ControlAtPos(  Point(pt.x, pt.y), True);
       mousecontrol:= FindControl(PMouseHookStruct(lparam)^.hwnd);
       ptinDragControl := (mousecontrol <> nil);  //Initialize to True and set to False when control should not drag form.

       with form do begin
         for i:= 0 to controlcount-1 do
         begin
            if fcIsClass(controls[i].ClassType, 'TfcCustomImageForm') then
            begin
              imageForm:= TfcCustomImageForm(Controls[i]);

              ClickOrMouseDownAssigned := False;
              if Mousecontrol <> nil then begin
                 if (imageform.captionbarcontrol = nil) or (imageform.captionbarcontrol.parent = form) then begin
                    currentpt:= Form.ScreenToClient(pt);
                    ptControl := Form.ControlAtPos(currentpt,True);
                 end
                 else begin
                    currentpt:= imageform.captionbarcontrol.parent.ScreenToClient(pt);
                    ptControl := imageform.captionbarcontrol.parent.controlatpos(currentpt,True);
                 end;

                 if ptControl <> nil then  //Control that was clicked on.  Check if Click or mousedown assigned.
                    ClickOrMouseDownAssigned := Assigned(TButton(ptControl).OnClick) or
                                                Assigned(TButton(ptControl).OnMouseDown);

                 if (imageform.CaptionBarControl = nil) then begin
                    currentpt:= form.ScreenToClient(pt);
                    ptinDragControl := PtInRect(form.boundsrect,currentpt);
                 end
                 else begin
                    currentpt:= TButton(imageform.CaptionBarControl).ScreenToClient(pt);
                    ptinDragControl := PtInRect(imageform.CaptionBarControl.boundsrect,currentpt);
                 end;

                 if ptinDragControl then
                    ptinDragControl := ((imageform.captionbarcontrol<>nil) and (mousecontrol = imageform.captionbarcontrol.parent));
              end;

              currentpt:= form.ScreenToClient(pt);

              InHook:= True;
              //Check if the caption control is defined.  If so, then check if the caption control was clicked on or if
              //a different control was clicked on in the caption that has an onclick event.  Use cheating cast.
               if ((imageform.CaptionBarControl <> nil) and (not ClickOrMouseDownAssigned) and ptInDragControl) or
                  ((imageform.CaptionBarControl <> nil) and (mouseControl = imageform.CaptionBarControl)) or
                  ((imageform.CaptionBarControl = nil) and (not ClickOrMouseDownAssigned) and (mousecontrol = form)) then begin
                  BringToFront;  //5/24/2002 - Allow clicking on Caption Control to bring form to front.
                  ImageForm.FormMouseDown(mbLeft, [ssleft], currentpt.x, currentpt.y);
                  result := 1;
               end;
//              ImageForm.CaptionBarControl.ControlState:=
//                 ImageForm.CaptionBarControl.ControlState - [cslButtonDown];
              InHook:= False;
            end
         end
       end
    end;
  end;
end;

constructor TfcCustomImageForm.Create(Aowner:TComponent);
begin
  inherited;
  FDragTolerance := 5;
  FRegion := 0;
  Align := alClient;
  FTransparentColor := clNone;
//  FCaptureMessageClass := nil;
  FOptions:= [];
  if not (csDesigning in ComponentState) then
  begin
    if (MouseHook=0) and (HookCount=0) then
       MouseHook := SetWindowsHookEx(WH_MOUSE, @wwMouseHookProc, HINSTANCE, GetCurrentThreadID);
    inc(HookCount);
  end;
end;

destructor TfcCustomImageForm.Destroy;
begin
  if FRegion <> 0 then DeleteObject(FRegion);
  if not (csDesigning in ComponentState) then
  begin
     Dec(HookCount);
     if (HookCount<=0) and (MouseHook<>0) then
     begin
        UnhookWindowsHookEx(MouseHook);
        MouseHook:= 0;
     end;
  end;

//  if FCaptureMessageClass <> nil then FCaptureMessageClass.Free;
//  FCaptureMessageClass:= nil;
  inherited Destroy;
end;

procedure TfcCustomImageForm.DestroyWnd;
begin
  if FRegion <> 0 then
  begin
    SetWindowRgn(GetParentForm(self).Handle, 0, False);
    DeleteObject(FRegion);
    FRegion := 0;
  end;
end;

// 10/26/98 - Added check to use windows setting for dragging of form when UseWindowsDrag is set.
function TfcCustomImageForm.GetDragFullWindows: Boolean;
var s: integer;
begin
  s:= 0;
  if ifUseWindowsDrag in Options then
    SystemParametersInfo(SPI_GETDRAGFULLWINDOWS, 0, Pointer(@s), 0);
  result:= (s<>0);
end;

procedure TfcCustomImageForm.ScaleRegion(xFact, yFact:Single);
var
   size:integer;
   rgndata: pRGNData;
//   stat: integer;
   newregion,existingrgn:HRgn;
   xform:TXForm;
begin
    existingrgn := CreateRectRgn(0,0,1,1);
    GetWindowRgn(GetParentForm(self).handle,existingrgn);
    Size := GetRegionData(existingrgn, 0, nil);
    if Size > 0 then
    begin
      Getmem(RgnData,size);
      try
        GetRegionData(existingrgn, Size, RgnData);
        FillChar(Xform,sizeof(xform),0);
        xform.eM11 := xfact;
        xform.em22 := yfact;
        newRegion := ExtCreateRegion(@xform,size,rgndata^);

        SetWindowRgn(GetParentForm(self).Handle, 0, False);
        if FRegion <> 0 then DeleteObject(FRegion);

        SetWindowRgn(GetParentForm(self).Handle,newRegion,true)
      finally
        FreeMem(RgnData);
        DeleteObject(existingrgn);
      end;
    end;
end;

procedure TfcCustomImageForm.AfterFormWndProc(var Message: TMessage);
var AControl: TControl;
    ClickOrMouseDownAssigned:Boolean;
begin
  if not (csDesigning in componentstate) then
  case Message.Msg of
    WM_DESTROY: DestroyWnd;

    WM_LBUTTONDOWN:  //Needed to capture mouse messages from caption control
      with TWMMouse(Message) do begin
        AControl := Parent.ControlAtPos(Point(XPos, YPos), True);

        //Check if the caption control is defined.  If so, then check if the caption control was clicked on or if
        //a different control was clicked on in the caption that has an onclick event.  Use cheating cast.
        //3/11/99-PYW-Don't Drag if a different control has an OnMouseDown event as well.
        //5/15/2001-PYW-Handle when acontrol =nil.
        if AControl <> nil then
           ClickOrMouseDownAssigned := Assigned(TButton(AControl).OnClick) or
                                       Assigned(TButton(AControl).OnMouseDown)
        else ClickOrMouseDownAssigned:= false;
        //5/10/99-PYW-Checked for click or mousedown event assigned for a control on a caption bar.
        //5/15/2001-PYW-Handle when acontrol is nil.  Allow dragging in this case.
        if ((FCaptionBarControl <> nil) and not ClickOrMouseDownAssigned) or
           ((FCaptionBarControl <> nil) and (AControl = CaptionBarControl)) or
           ((FCaptionBarControl = nil) and (AControl = self))or
           (AControl = nil) then
          FormMouseDown(mbLeft, KeysToShiftState(Keys), XPos, YPos);
      end;
  end;
end;

procedure TfcCustomImageForm.FormMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
const SC_DragMove = $F012;
var p: TPoint;
    ParentForm: TCustomForm;
begin
{  if (FCaptionBarControl <> nil) then
    with FCaptionBarControl do
      if not (PtinRect(Rect(Left, Top, Width + Left, Height + Top), Point(x, y))) then
        Exit;}

  if ssLeft in Shift then begin
     ParentForm:= GetParentForm(self);
     if GetDragFullWindows then begin  //4/14/00 - PYW - Use Window system command for dragging instead.
        ReleaseCapture;
//        ParentForm.perform(WM_SysCommand, SC_DragMove, 0);
        //1/8/2002 - Don't use perform.  Use postMessage instead.  More reliable.
        Postmessage(ParentForm.Handle,WM_SysCommand, SC_DragMove, 0);
        exit;
     end;