teimage.pas

delphi2007界面效果控件源码

unit teImage;

interface

{$INCLUDE teDefs.inc}

uses
  SysUtils, Classes, teBkgrnd, Windows, Messages, Graphics, Controls, TransEff,
  teVclCtl;

type
  TTEImage = class(TCustomControl)
  private
    FBackgroundOptions: TFCBackgroundOptions;
    FOnMouseLeave: TNotifyEvent;
    FOnMouseEnter: TNotifyEvent;
    FPicture: TPicture;
    FPictureMode: TFCPictureMode;
    FPictureTranspColor: TColor;
    FDrawing: Boolean;
    FPictureVisible: Boolean;
    FTransitionDevice: TTEVCLControlTrDevice;
    FPictureMargin: Word;

    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMTEThreadTerminated(var Message: TWMNoParams); message CM_TETHREADTERMINATED;
    procedure WMDestroy(var Msg: TMessage); message WM_DESTROY;
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
    procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
    procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
    procedure SetBackgroundOptions(Value: TFCBackgroundOptions);
    function  GetVersion: String;
    procedure SetPicture(const Value: TPicture);
    procedure SetPictureMargin(const Value: Word);
    procedure SetPictureMode(Value: TFCPictureMode);
    procedure SetPictureTranspColor(Value: TColor);
    procedure SetVersion(const Value: String);
    procedure PictureChanged(Sender: TObject);
    procedure BkgrndChanged(Sender: TObject);
    procedure DoPaint(Bmp: TBitmap; R: TRect; DrawPic: Boolean);
    procedure InternalPrepareTransition(Transition: TTransitionEffect;
      R: TRect; SrcBmp: TBitmap);
    procedure InternalUnPrepareTransition(FullUnprepare: Boolean);
    procedure SetPictureVisible(const Value: Boolean);
  protected
    FullAreaTransition,
    FDestroyTransition: Boolean;
    PreparedPicRect: TRect;
    BkgrndHasChanged: Boolean;

    function  DoPaletteChange: Boolean;
    function  GetPalette: HPalette; override;
    procedure Paint; override;
    procedure SetParent(AParent: TWinControl); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    function  PrepareTransition(Transition: TTransitionEffect;
      const FullArea: Boolean = True;
      const DestroyTransition: Boolean = False): Boolean;
    procedure ExecuteTransition(WaitForCompletion: Boolean = True);
    procedure AbortTransition;
    {$ifndef TE_NOHLP}
    procedure UnPrepareTransition;
    {$endif TE_NOHLP}
    function  Transition: TTransitionEffect;
    function  TransitionExecuting: Boolean;
    function  TransitionPrepared: Boolean;

    property TransitionDevice: TTEVCLControlTrDevice read FTransitionDevice;
  published
    property  Anchors;
    property  Align;
    property  BackgroundOptions: TFCBackgroundOptions read FBackgroundOptions write SetBackgroundOptions;
    property  BevelEdges;
    property  BevelInner;
    property  BevelOuter;
    property  BevelKind;
    property  BevelWidth;
    property  BiDiMode;
    property  BorderWidth;
    property  Color nodefault;
    property  Constraints;
    property  Ctl3D;
    property  DragCursor;
    property  DragKind;
    property  DragMode;
    property  Enabled;
    property  Font;
    property  OnClick;
    property  OnDblClick;
    property  OnDragDrop;
    property  OnDragOver;
    property  OnEndDrag;
    property  OnEndDock;
    property  OnEnter;
    property  OnExit;
    property  OnMouseDown;
    property  OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property  OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    property  OnMouseMove;
    property  OnMouseUp;
    property  OnStartDock;
    property  OnStartDrag;
    {$ifdef D7UP}
    property  ParentBackground;
    {$endif D7UP}
    property  ParentColor;
    property  ParentCtl3D;
    property  ParentFont;
    property  ParentShowHint;
    property  ParentBiDiMode;
    property  Picture: TPicture read FPicture write SetPicture;
    property  PictureMargin: Word read FPictureMargin write SetPictureMargin default 0;
    property  PictureMode: TFCPictureMode read FPictureMode write SetPictureMode default fcpmTile;
    property  PictureTranspColor: TColor read FPictureTranspColor write SetPictureTranspColor default clNone;
    property  PictureVisible: Boolean read FPictureVisible write SetPictureVisible default True;
    property  PopupMenu;
    property  ShowHint;
    property  TabOrder;
    property  TabStop;
    property  Version: String read GetVersion write SetVersion stored False;
    property  Visible;
  end;

implementation

uses
  {$ifdef D7UP}Themes, {$endif D7UP}
  Forms,
  teRender;

type
  TTransitionDeviceHack = class(TTEVCLControlTrDevice);
  TTransitionEffectHack = class(TTransitionEffect);

{ TTEImage }

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

  Width               := 185;
  Height              :=  41;
  FBackgroundOptions  := TFCBackgroundOptions.Create;
  FBackgroundOptions.OnChange := BkgrndChanged;
  FPicture            := TPicture.Create;
  FPicture.OnChange   := PictureChanged;
  FPictureMargin      := 0;
  FPictureMode        := fcpmCenter;
  FPictureTranspColor := clNone;
  FPictureVisible     := True;
  FDrawing            := False;
  FullAreaTransition  := False;
  FDestroyTransition  := False;
  PreparedPicRect     := Rect(0, 0, 0, 0);
  BkgrndHasChanged    := False;
  FTransitionDevice    := nil;
end;

destructor TTEImage.Destroy;
begin
  UnPrepareTransition;

  FPicture          .Free;
  FBackgroundOptions.Free;

  inherited;
end;

procedure TTEImage.WMDestroy(var Msg: TMessage);
begin
  UnPrepareTransition;

  inherited;
end;

procedure TTEImage.AbortTransition;
begin
  if TransitionPrepared then
  begin
    FTransitionDevice.Abort;
    UnPrepareTransition;
  end;
end;

function TTEImage.DoPaletteChange: Boolean;
var
  ParentForm: TCustomForm;
  Tmp: TGraphic;
begin
  Result := False;
  Tmp := FPicture.Graphic;
  if Visible and FPictureVisible and (not (csLoading in ComponentState)) and
    (Tmp <> nil) and (Tmp.PaletteModified) then
  begin
    if (Tmp.Palette = 0) then
      Tmp.PaletteModified := False
    else
    begin
      ParentForm := GetParentForm(Self);
      if Assigned(ParentForm) and ParentForm.Active and Parentform.HandleAllocated then
      begin
        if FDrawing then
          ParentForm.Perform(wm_QueryNewPalette, 0, 0)
        else
          PostMessage(ParentForm.Handle, wm_QueryNewPalette, 0, 0);
        Result := True;
        Tmp.PaletteModified := False;
      end;
    end;
  end;
end;

function TTEImage.GetPalette: HPalette;
begin
  if(FPicture.Graphic <> nil)      and
     FPictureVisible               and  
    (FPicture.Graphic.Palette <> 0)
  then Result := FPicture.Graphic.Palette
  else Result := BackgroundOptions.GetPalette;
end;

procedure TTEImage.SetParent(AParent: TWinControl);
begin
  inherited;
  if Assigned(BackgroundOptions) and (not(csDestroying in ComponentState)) then
    BackgroundOptions.Control := Self;
end;

function TTEImage.GetVersion: String;
begin
  Result := BilleniumEffectsVersion;
end;

procedure TTEImage.SetVersion(const Value: String);
begin
end;

procedure TTEImage.SetBackgroundOptions(Value: TFCBackgroundOptions);
begin
  BackgroundOptions.Assign(Value);
end;

procedure TTEImage.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if Assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);
end;

procedure TTEImage.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if Assigned(FOnMouseLeave) then
    FOnMouseLeave(Self);
end;

procedure TTEImage.SetPicture(const Value: TPicture);
begin
  if Assigned(Value)
  then FPicture.Assign(Value)
  else FPicture.Graphic := nil;
end;

procedure TTEImage.SetPictureMargin(const Value: Word);
begin
  if FPictureMargin <> Value then
  begin
    FPictureMargin := Value;
    PictureChanged(Self);
  end;
end;

procedure TTEImage.SetPictureMode(Value: TFCPictureMode);
begin
  if FPictureMode <> Value then
  begin
    FPictureMode := Value;
    PictureChanged(Self);
  end;
end;

procedure TTEImage.SetPictureTranspColor(Value: TColor);
begin
  if FPictureTranspColor <> Value then
  begin
    FPictureTranspColor := Value;
    PictureChanged(Self);
  end;
end;

procedure TTEImage.SetPictureVisible(const Value: Boolean);
begin
  if FPictureVisible <> Value then
  begin
    FPictureVisible := Value;
    PictureChanged(Self);
    Invalidate;
  end;
end;

procedure TTEImage.WMWindowPosChanged(var Message: TWMWindowPosChanged);
begin
  inherited;

  if(not(csDestroying in ComponentState)) and
    BackgroundOptions.IsActive then
    BackgroundOptions.ControlChanged(Self);
end;

procedure TTEImage.WMWindowPosChanging(var Message: TWMWindowPosChanging);
var
  Sizing,
  Hiding: Boolean;
begin
  inherited;

  Sizing :=
    ((Message.WindowPos^.flags and SWP_NOSIZE    ) =  0) and
    IsWindowVisible(Handle);
  Hiding :=
    ((Message.WindowPos^.flags and SWP_HIDEWINDOW) <> 0) and
    IsWindowVisible(Handle);

  if(Sizing or Hiding) then
    UnPrepareTransition;
end;

procedure TTEImage.PictureChanged(Sender: TObject);
var
  G: TGraphic;
begin
  G := FPicture.Graphic;
  if G <> nil then
  begin
    if not ((G is TMetaFile) or (G is TIcon)) then
      G.Transparent := PictureTranspColor <> clNone;
    if DoPaletteChange and FDrawing and FPictureVisible then
      Update;
  end;
  if(not FDrawing) and FPictureVisible then
    Invalidate;
end;

procedure TTEImage.BkgrndChanged(Sender: TObject);
begin
  if TransitionPrepared then
    BkgrndHasChanged := True;
end;

procedure TTEImage.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
  {$ifdef D7UP}
  if BEParentBackgroundPainted(Handle) then
    BackgroundOptions.DrawBackGround(Message.DC, nil, Rect(0, 0, 0, 0));
  {$endif D7UP}
  Message.Result := 1;
end;

procedure TTEImage.DoPaint(Bmp: TBitmap; R: TRect; DrawPic: Boolean);
var
  P: TPoint;
begin
  OffsetWindowOrgEx(Bmp.Canvas.Handle, R.Left, R.Top, P);