gdipluscommon.pas

一个朋友写的delphi的漂亮时钟

{*******************************************************}
{                                                       }
{       GDI+ Clock                                      }
{                                                       }
{       版权所有 (C) 2009 Ding Li Fleet                 }
{                                                       }
{       作者：樊升                                      }
{*******************************************************}

unit GDIPlusCommon;

interface

uses
  Windows, Graphics, Messages, SysUtils, Classes, Controls, Buttons,
  ExtCtrls, Forms, GDIPOBJ, GDIPAPI;

const
  WM_PNGPaint = WM_USER + 9000;  //PNG重画消息,窗体在收到这个消息后应该重画区域
type
  TPNGButtonState = (pbsNormal, pbsDown, pbsDisabled);

  TPNGButton = class(TGraphicControl)
  private
    {Holds the property values}
    FMouseOverControl: Boolean;
    FCaption: string;
    FButtonState: TPNGButtonState;
    FImageNormal: string;
    FImageDisabled: string;
    FImageOver: string;
    FDrawImage: Boolean;
    FRotate: Double;
    FFontOver: TFont;
    FNotifyHandle: THandle;
    FStringAlignment: TStringAlignment;
    {Procedures for setting the property values}
    procedure SetCaption(const Value: String);
    procedure SetButtonState(const Value: TPNGButtonState);
    procedure SetImageNormal(const Value: string);
    procedure SetImageOver(const Value: string);
    procedure SetDrawImage(const AValue: Boolean);
    procedure SetRotate(const AValue: Double);
    function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
    function GetNotifyHandle: THandle;
    procedure SetFontOver(const AValue: TFont);
    procedure SetParent(AParent: TWinControl); override;
  public
    {Public properties}
    property ButtonState: TPNGButtonState read FButtonState write SetButtonState;
  protected
    {Being painted}
    procedure Paint; override;
    {Clicked}
    procedure Click; override;
    {Mouse pressed}
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    {Mouse entering or leaving}
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    {Being enabled or disabled}
    procedure CMEnabledChanged(var Message: TMessage);
      message CM_ENABLEDCHANGED;
  public
    function GetImage: string;
    function GetFont: TFont;
    {Returns if the mouse is over the control}
    property IsMouseOver: Boolean read FMouseOverControl;
    {Constructor and destructor}
    property NotifyHandle: THandle read FNotifyHandle;
    property Image: string read GetImage;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    {Published properties}
    property Font;
    property FontOver: TFont read FFontOver write SetFontOver;
    property Visible;
    property Caption: String read FCaption write SetCaption;
    property ImageNormal: string read FImageNormal write SetImageNormal;
    property ImageOver: string read FImageOver write SetImageOver;
    property Enabled;
    {Default events}
    property OnMouseDown;
    property OnClick;
    property OnMouseUp;
    property OnMouseMove;
    property OnDblClick;
    {Default property}
    property Align;
    property Anchors;
    property AutoSize;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property ParentShowHint;
    property ShowHint;
    property DrawIamge: Boolean read FDrawImage write SetDrawImage default False;
    property Rotate: Double read FRotate write SetRotate;
    property StringAlignment: TStringAlignment read FStringAlignment write FStringAlignment default StringAlignmentNear;
  end;

procedure Register;

implementation

uses
  GDITools;

procedure Register;
begin
  RegisterComponents('Fan', [TPNGButton]);
end;

{TPNGButton implementation}

{Being created}
constructor TPNGButton.Create(AOwner: TComponent);
begin
  {Calls ancestor}
  inherited Create(AOwner);
  FFontOver := TFont.Create;
  {Initial properties}
  ControlStyle := ControlStyle + [csCaptureMouse];
  SetBounds(Left, Top, 23, 23);
  FMouseOverControl := False;
  FButtonState := pbsNormal;
  FDrawImage := False;
  FNotifyHandle := GetNotifyHandle;
  FStringAlignment := StringAlignmentNear;
end;

destructor TPNGButton.Destroy;
begin
  FFontOver.Free;
  inherited Destroy;
end;

function TPNGButton.GetFont: TFont;
var
  pushed: Boolean;
begin
  {Determines if the button is pushed}
  Pushed := (ButtonState = pbsDown) and IsMouseOver;

  {Determines the image to use}
  if (Pushed) then
    Result := FFontOver
  else if IsMouseOver and Enabled then
    Result := FFontOver
  else if (ButtonState = pbsDisabled) then
    Result := Font
  else
    Result := Font;
end;

function TPNGButton.GetImage: string;
var
  pushed: Boolean;
begin
  {Determines if the button is pushed}
  Pushed := (ButtonState = pbsDown) and IsMouseOver;

  {Determines the image to use}
  if (Pushed) and (Trim(FImageOver)<>'') then
    Result := FImageOver
  else if IsMouseOver and (Trim(FImageOver)<>'') and Enabled then
    Result := FImageOver
  else if (ButtonState = pbsDisabled) and (Trim(FImageDisabled)<>'') then
    Result := FImageDisabled
  else
    Result := FImageNormal;
end;

function TPNGButton.GetNotifyHandle: THandle;
var
  AParent: TWinControl;
begin
  AParent := Parent;
  Result := 0;
  while AParent <> nil do
  begin
    if (AParent is TCustomForm) then
    begin
      Result := AParent.Handle;
      Break;
    end;
    AParent := AParent.Parent;
  end;
end;

{Being enabled or disabled}
procedure TPNGButton.CMEnabledChanged(var Message: TMessage);
begin
  //if not Enabled then MakeImageHalfTransparent(fImageNormal, fImageDisabled);
  if Enabled then
  begin
    FButtonState := pbsNormal;
    if Trim(FImageDisabled) <> '' then
      Paint; 
  end
  else
  begin
    FButtonState := pbsDisabled;
    if Trim(FImageDisabled) <> '' then
      Paint;                        
  end;
end;

{Button being painted}
procedure TPNGButton.Paint;
var
  sImageFile: string;
  Pushed: Boolean;
  GPGraph: TGPGraphics;
  GPImage: TGPImage;
  GPRect: TGPRect;
  GPRectF: TGPRectF;
  GPFontFamily: TGPFontFamily;
  GPFont: TGPFont;
  GPSolidBrush: TGPSolidBrush;
  r, g, b: Word;
  AFont: TFont;
  GPStringFormat: TGPStringFormat;
begin
  if csLoading in ComponentState then Exit;
  SendMessage(NotifyHandle, WM_PNGPaint, 0, 0);
  if (csDesigning in ComponentState) or FDrawImage then
  begin
    GPGraph := TGPGraphics.Create(Canvas.Handle);
    try
      sImageFile := GetImage;
      if Trim(sImageFile) <> '' then
      begin
        GPImage := TGPImage.Create(sImageFile);
        try
          GPRect.X := ClientRect.Left;
          GPRect.Y := ClientRect.Top;
          GPRect.Width := ClientRect.Right - ClientRect.Left;
          GPRect.Height := ClientRect.Bottom - ClientRect.Top;
          GPGraph.DrawImage(GPImage, GPRect);
        finally
          GPImage.Free;
        end;
      end;
      if Caption <> '' then
      begin
        AFont := GetFont;
        r := GetRValue(AFont.Color);
        g := GetGValue(AFont.Color);
        b := GetBValue(AFont.Color);
        GPFontFamily := TGPFontFamily.Create(AFont.Name);
        GPFont := TGPFont.Create(GPFontFamily, AFont.Size, GetGPFontStyle(AFont.Style));
        GPSolidBrush := TGPSolidBrush.Create(MakeColor(255, r, g, b));
        GPStringFormat := TGPStringFormat.Create;
        try
          GPRectF.X := 0;
          GPRectF.Y := 0;
          GPRectF.Width := Width;
          GPRectF.Height := Height;
          // Center-justify each line of text.
          GPStringFormat.SetAlignment(StringAlignment);
          // Center the block of text (top to bottom) in the rectangle.
          GPStringFormat.SetLineAlignment(StringAlignment);
          GPGraph.SetTextRenderingHint(TextRenderingHintAntiAlias);
          GPGraph.DrawString(Caption, -1, GPFont, GPRectF, GPStringFormat, GPSolidBrush);
        finally
          GPFontFamily.Free;
          GPFont.Free;
          GPSolidBrush.Free;
          GPStringFormat.Free;
        end;
      end;
    finally
      GPGraph.Free;
    end;
  end;
end;

{Changing the button state property}

procedure TPNGButton.SetButtonState(const Value: TPNGButtonState);
begin
  FButtonState := Value;
end;

{Changing the caption property}
procedure TPNGButton.SetCaption(const Value: string);
begin
  FCaption := Value;
  Paint;
end;

procedure TPNGButton.SetDrawImage(const AValue: Boolean);
begin
  if FDrawImage <> AValue then
  begin
    FDrawImage := AValue;
    Paint;
  end;
end;

procedure TPNGButton.SetFontOver(const AValue: TFont);
begin
  if FFontOver <> AValue then
    FFontOver.Assign(AValue);
end;

{Changing the image property}
procedure TPNGButton.SetImageNormal(const Value: string);
begin
  if not SameText(FImageNormal, Value) then
  begin
    FImageNormal := Value;
    Paint;
  end;
end;

{Setting the down image}

{Setting the over image}
procedure TPNGButton.SetImageOver(const Value: string);
begin
  if not SameText(FImageOver, Value) then
  begin
    FImageOver := Value;
    Paint;
  end;
end;

procedure TPNGButton.SetParent(AParent: TWinControl);
begin
  inherited;
  FNotifyHandle := GetNotifyHandle;
end;

procedure TPNGButton.SetRotate(const AValue: Double);
begin
  if FRotate <> AValue then
  begin
    FRotate := AValue;
    Paint;
  end;
end;

{Mouse pressed}
procedure TPNGButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  {Changes the state and repaints}
  if (ButtonState = pbsNormal) and (Button = mbLeft) then
  begin
    FButtonState := pbsDown;
  end;
  {Calls ancestor}
  inherited
end;

{Being clicked}
function TPNGButton.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
var
  GPImage: TGPImage;
  sImage: string;
begin
  Result := True;
  sImage := GetImage;;
  if Trim(sImage) <> '' then
  begin
    GPImage := TGPImage.Create(sImage);
    try
      if Align in [alNone, alLeft, alRight] then
        NewWidth := GPImage.GetWidth;
      if Align in [alNone, alTop, alBottom] then
        NewHeight := GPImage.GetHeight;
    finally
      GPImage.Free;
    end;
  end;
end;

procedure TPNGButton.Click;
begin
  if ButtonState = pbsDown then
  begin
    FButtonState := pbsNormal;
  end;
  inherited Click;
end;

{Mouse released}
procedure TPNGButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  {Changes the state and repaints}
  if ButtonState = pbsDown then
  begin
    FButtonState := pbsNormal;
  end;
  {Calls ancestor}
  inherited
end;

{Mouse moving over the control}
procedure TPNGButton.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  {In case cursor is over the button}
  if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) and
    (FMouseOverControl = False) and (ButtonState <> pbsDown)  then
  begin
    FMouseOverControl := True;
  end;
  {Calls ancestor}
  inherited;
end;

{Mouse is now over the control}
procedure TPNGButton.CMMouseEnter(var Message: TMessage);
begin
  FMouseOverControl := True;
  if Trim(FImageOver) <> '' then
    Paint;
end;

{Mouse has left the control}
procedure TPNGButton.CMMouseLeave(var Message: TMessage);
begin
  FMouseOverControl := False;
  if (Trim(FImageNormal) <> '') and (Trim(FImageOver) <> '') then
    Paint;
end;  

end.