cdibpanel.pas

Delphi控件

unit cDIBPanel;

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: cDIBPanl.PAS, released August 28, 2000.

The Initial Developer of the Original Code is Peter Morris ([e-mail]),
Portions created by Peter Morris are Copyright (C) 2000 Peter Morris.
All Rights Reserved.

Purpose of file:
The base class for DIBContainers.  All DIB components must be parented by a DIBContainer
of some sort.

Contributor(s):
[e-mail] - www.azzasoft.com
RiceBall <[e-mail]>
Dave Parkinson 

Last Modified: April 9, 2003

You may retrieve the latest version of this file at http://www.droopyeyes.com


Known Issues:
To be updated !
-----------------------------------------------------------------------------}
//Modifications
(*
Date:   December 22, 2000
By:     Azza
Change: WMPaint didn't set up the PaintRect area for a foreign device context
        (ie. anything other than itself).

Date:   May 2, 2001
By:     Peter Morris
Change: Added DIBBorder property

Date:   May 2, 2001
By:     Peter Morris
Change: Added BeforePaint and AfterPaint;

Date:   June 24, 2001
By:     RiceBall
Change: Overrode AlignControls to take into account DIBBorder

Date:   June 24, 2001
By:     Peter Morris
Change: Added a property to determine if the border is draw over or under its controls

Date:   August 24, 2001
By:     Peter Morris
Change: Changed BeforePaint and AfterPaint to DoBeforePaint and DoAfterPaint,
        added BeforePaint and AfterPaint events

Date:   April 9, 2003
By:     Dave Parkinson
Change: Fixed an AV which occurred when in 256 colours and no palette was provided.

Date:   September 19, 2003
By:     Paul Stohr
Change: Fixed issues with multi-monitor support

Date:   February 29, 2004
By:     Peter Morris
Change: Removed legacy code which repainted the whole container if the parent form
        was not the windows active form.  This causes a whole repaint when the
        form was used as part of a Cubase SX plugin, subsequently it used a lot
        of CPU.

Date:   August 28, 2004
By:     Peter Morris
Change: Removed unnecessary call to DefaultHandler in WM_PAINT which was causing
        artifacts on the canvas when another window was dragged over the parent form.

*)


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, cDIB, JPeg, cDIBImageList, cDIBPalette, cDIBBorder;

type
  TBorderDrawPosition = (bdOverControls, bdUnderControls);
  TDIBPaintEvent = procedure(Sender: TObject; const DIB: TAbstractSuperDIB) of object;

  TCustomDIBContainer = class(TCustomPanel)
  private
    { Private declarations }
    FOnActiveControlChange: TNotifyEvent;
    FBeforePaint: TDIBPaintEvent;
    FAfterPaint: TDIBPaintEvent;
    FTabbing: Boolean;
    FChangingFocus: Boolean;
    FAlteredRect: Boolean;
    FActiveControl: TControl;
    FTabList: TList;
    FChildDIB: TWinDIB;
    FDIB: TWinDIB;
    FDIBBorder: TDIBBorder;
    FUpdateRect: TRect;
    FPalette: TDIBPalette;
    FBorderDrawPosition: TBorderDrawPosition;

    procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FocusChanged;
    procedure CNChar(var Message: TWMKey); message CN_Char;
    procedure CNKeyDown(var Message: TWMKeyDown); message CN_KeyDown;
    procedure CNKeyUp(var Message: TWMKeyUp); message CN_KeyUp;
    procedure WMEraseBkGnd(var Message: TMessage); message WM_EraseBkGnd;
    procedure WMGetDlgCode(var Message: TMessage); message WM_GetDlgCode;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMSetCursor(var Message: TMessage); message WM_SETCURSOR;
    procedure SetBorderDrawPosition(const Value: TBorderDrawPosition);
  protected
    { Protected declarations }
    //    procedure AlignControls(AControl: TControl; var Rect: TRect);override;
    procedure AdjustClientRect(var Rect: TRect); override;
    function ChildWantsKey(var Message: TWMKey): Boolean;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DoAfterPaint; virtual;
    procedure DoBeforePaint; virtual;
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure DoTabFixups; virtual;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure PaintControls(DC: HDC; First: TControl);
    procedure PaintHandler(var Message: TWMPaint);
    procedure SetDIBBorder(const Value: TDIBBorder); virtual;
    procedure WndProc(var Message: TMessage); override;

    //Focus routines
    function DIBGetFirst: TControl;
    function DIBGetPrior: TControl;
    function DIBGetNext: TControl;
    function DIBGetLast: TControl;
    function DIBGetIndex(aControl: TControl): Integer;

    function DIBSelectNext: Boolean;
    function DIBSelectPrior: Boolean;

    property AfterPaint: TDIBPaintEvent read FAfterPaint write FAfterPaint;
    property BeforePaint: TDIBPaintEvent read FBeforePaint write FBeforePaint;
    property BorderDrawPosition: TBorderDrawPosition 
      read FBorderDrawPosition write SetBorderDrawPosition;
    property ChildDIB: TWinDIB read FChildDIB;
    property DIBBorder: TDIBBorder read FDIBBorder write SetDIBBorder;
    property OnActiveControlChange: TNotifyEvent 
      read FOnActiveControlChange write FOnActiveControlChange;

  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    //Focus routines
    function DIBGetTabOrder(aControl: TControl): TTabOrder;
    procedure DIBSetTabOrder(aControl: TControl; NewIndex: TTabOrder);

    function DIBFindNext(aControl: TControl; aForward: Boolean): TControl;
    procedure DIBFocusControl(aControl: TControl); virtual;

    //Std
    procedure Paint; override;
    procedure SetBounds(aLeft, aTop, aWidth, aHeight: Integer); override;

    property ActiveControl: TControl read FActiveControl write DIBFocusControl;
    property DIB: TWinDIB read FDIB;
    property UpdateRect: TRect read FUpdateRect;
  published
    { Published declarations }
  end;

  TDIBContainer = class(TCustomDIBContainer)
  private
  protected
  public
  published
    property AfterPaint;
    property Align;
    property Anchors;
    property AutoSize;
    property BeforePaint;
    property BiDiMode;
    property BorderDrawPosition;
    property Color;
    property Constraints;
    property Cursor;
    property DockSite;
    property DIBBorder;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property Height;
    property HelpContext;
    property Hint;
    property Left;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property Tag;
    property Top;
    property UseDockManager;
    property Visible;
    property Width;

    property OnActiveControlChange;
    property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnDblClick;
    property OnDockDrop;
    property OnDockOver;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;

  TTileMethod = (tmCenter, tmTile);
  TCustomDIBImageContainer = class(TCustomDIBContainer)
  private
    FIndexImage: TDIBImageLink;
    FTileMethod: TTileMethod;

    procedure DoImageChanged(Sender: TObject; ID: Integer; Operation: TDIBOperation);
    function GetDIBImageList: TCustomDIBImageList;
    procedure SetDIBImageList(const Value: TCustomDIBImageList);
    procedure SetTileMethod(const Value: TTileMethod);
  protected
    procedure ImageChanged(ID: Integer; Operation: TDIBOperation); virtual;
    procedure WndProc(var Message: TMessage); override;

    property DIBImageList: TCustomDIBImageList read GetDIBImageList write SetDIBImageList;
    property IndexImage: TDIBImageLink read FIndexImage write FIndexImage;
    property TileMethod: TTileMethod read FTileMethod write SetTileMethod;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Paint; override;
  published
  end;

  TDIBImageContainer = class(TCustomDIBImageContainer)
  published
    //New events / properties
    property DIBImageList;
    property IndexImage;
    property TileMethod;

    property OnActiveControlChange;

    //inherited
    property AfterPaint;
    property Align;
    property Anchors;
    property AutoSize;
    property BeforePaint;
    property BiDiMode;
    property BorderDrawPosition;
    property Color;
    property Constraints;
    property Cursor;
    property DockSite;
    property DIBBorder;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property Height;
    property HelpContext;
    property Hint;
    property Left;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property Tag;
    property Top;
    property UseDockManager;
    property Visible;
    property Width;

    property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnDblClick;
    property OnDockDrop;
    property OnDockOver;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;

  end;

implementation

uses
  cDIBControl;

type
  EDIBContainerError = class(Exception);
  THackControl = class(TControl);
  THackWinControl = class(TWinControl);
  THackDIBControl = class(TCustomDIBControl);
  TBlitType = (btNormal, btNeedPalette, btLookup);

  { TCustomDIBContainer }

procedure TCustomDIBContainer.DoAfterPaint;
begin
  if BorderDrawPosition = bdOverControls then
    if DIBBorder <> nil then DIBBorder.DrawTo(DIB, ClientRect);
  if Assigned(FAfterPaint) then FAfterPaint(Self, FDIB);
end;

(*
procedure TCustomDIBContainer.AlignControls(AControl: TControl;
  var Rect: TRect);
begin
  if DIBBorder <> nil then with DIBBorder do
  begin
    Rect.Top := Rect.Top + BorderTop.Size;
    Rect.Bottom := Rect.Bottom - BorderBottom.Size;
    Rect.Left := Rect.Left + BorderLeft.Size;
    Rect.Right := Rect.Right - BorderRight.Size;
  end;
  inherited;
end;
*)

procedure TCustomDIBContainer.DoBeforePaint;
begin
  if Assigned(FBeforePaint) then FBeforePaint(Self, FDIB);
end;

function TCustomDIBContainer.ChildWantsKey(var Message: TWMKey): Boolean;
var
  DlgResult: Integer;
  Mask: Integer;
begin
  Result := False;
  if FActiveControl <> nil then with THackDIBControl(FActiveControl) do
    begin
      Message.Result := 1;
      if IsMenuKey(Message) then Exit;
      if not (csDesigning in ComponentState) then with Message do
        begin
          if Perform(CM_CHILDKEY, CharCode, Integer(Self)) <> 0 then exit;
          Mask := 0;
          case CharCode of
            VK_TAB:
              Mask := DLGC_WANTTAB;
            VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN:
              Mask := DLGC_WANTARROWS;
            VK_RETURN, VK_EXECUTE, VK_ESCAPE, VK_CANCEL:
              Mask := DLGC_WANTALLKEYS;
          end;
          if Mask <> 0 then 
          begin
            DlgResult := Perform(WM_GETDLGCODE, 0, 0);
            if DlgResult <> DLGC_WantAllKeys then 
            begin
              if Mask and DlgResult = 0 then exit
            end;
          end;
        end;
      Result := True;
    end;
end;

procedure TCustomDIBContainer.CMFocusChanged(var Message: TCMFocusChanged);
var
  KS: TKeyboardState;
begin
  if Message.Sender <> nil then
    if TWinControl(Message.Sender).Parent = Self then 
    begin
      DIBFocusControl(Message.Sender);
      exit;