gdskincontrols.pas

DELPHI皮肤,让你的界面更精典. 可以自己画皮肤,运行速度更快.

unit GDSkinControls;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Dialogs,
  ExtCtrls,GdClasses,StdCtrls,GDRegionList;

type
  TSkinLabel=Class(TCustomLabel)
  private
    FRegionLink: TGDRegionLink;
    procedure SetSkinRegion(Value: TGdSkinRegion);
    function GetSkinRegion: TGDSkinRegion;
  protected
    procedure Paint; override;
    procedure RegionChanged(Sender:TObject);
  public
    constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;
  published
    property SkinRegion:TGDSkinRegion read GetSkinRegion write SetSkinRegion;
    property AutoSize;
    property Caption;

  end;

  TGDSkinButton = class(TCustomLabel)
  private
    FRegionLink: TGDRegionLink;
    FEnterRegionLink: TGDRegionLink;
    FDownRegionLink: TGDRegionLink;
    //重画时参照的区域连接
    FActiveRegionLink:TGDRegionLink;
    FAutoSize: Boolean;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    function GetSkinRegion(Index:Integer): TGDSkinRegion;
    procedure SetSkinRegion(Index:Integer;Value: TGdSkinRegion);
    procedure SetActiveRegionLink(RegionLink:TGDRegionLink);
  protected
    procedure AdjustBounds;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure Paint; override;
    procedure RegionChanged(Sender:TObject);dynamic;
    procedure SetAutoSize(Value: Boolean);
    procedure Loaded; override;
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
  published
    property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
//    property AutoSize;
    property SkinRegion:TGDSkinRegion index 0 read GetSkinRegion write SetSkinRegion;
    property SkinEnterRegion:TGDSkinRegion index 1 read GetSkinRegion write SetSkinRegion;
    property SkinDownRegion:TGDSkinRegion index 2 read GetSkinRegion write SetSkinRegion;
    property Action;
    property Align;
    property Anchors;
    property BiDiMode;
    property Caption;
    property Color nodefault;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
//    property Transparent;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
    property Alignment;
    property Layout;
  end;

  TGDSkinPanel = class(TPanel)
  private
    FRegion:TGdSkinRegion;
    procedure SetRegion(const Value: TGdSkinRegion);
  protected
    procedure Paint;override;
  public
    constructor Create(AOwner:TComponent);override;
  published
    property Region:TGdSkinRegion read FRegion write SetRegion;
  end;

  procedure DrawWallpaper(DC: HDC; Bitmap: TBitmap; Recty: TRect; IsStretch: Boolean; Mode: Integer);

implementation

uses Math;

procedure DrawWallpaper(DC: HDC; Bitmap: TBitmap; Recty: TRect; IsStretch: Boolean;
                        Mode: Integer);
var
  X, Y: Integer;
begin
  with Recty, Bitmap do
//    if IsStretch then
//      StretchDrawWallpaper(DC, Bitmap, Recty, Rect(0, 0, Width, Height), Mode)
//    else
      begin
        X := Left;
        Y := Top;
        while Y < Bottom do
        begin
          while X < Right do
          begin
            BitBlt(DC, X, Y, Right-X, Bottom-Y, Canvas.Handle, 0, 0, Mode);
            Inc(X, Width);
          end;
          X := Left;
          Inc(Y, Height);
        end;
      end;
end;

{ TGDSkinRegion }

constructor TSkinLabel.Create(AOwner: TComponent);
begin
  inherited;
  FRegionLink:=TGDRegionLink.Create;
  FRegionLink.OnChange:=RegionChanged;
end;

destructor TSkinLabel.Destroy;
begin
  FRegionLink.Free;
  inherited;
end;

function TSkinLabel.GetSkinRegion: TGDSkinRegion;
begin
  Result:=TGdSkinRegion(FRegionLink.Region);
end;

procedure TSkinLabel.Paint;
begin
  with Canvas,FRegionLink do
  begin
    if Assigned(Region) and not Region.IsEmpty then
    begin
      Canvas.Draw(0,0,TGdSkinRegion(Region).Bitmap)
    end else if not Transparent or (csDesigning in ComponentState) then
    begin
      Canvas.Pen.Color:=Self.Color;
      Canvas.Rectangle(ClientRect);
    end;
  end;
end;

procedure TSkinLabel.RegionChanged(Sender:TObject);
begin
  Invalidate;
end;

procedure TSkinLabel.SetSkinRegion(Value: TGdSkinRegion);
begin
  if FRegionLink.Region <> Value then
  begin
    FRegionLink.Region := Value;
    Invalidate;
  end;
end;

{ TSkinButton }

procedure TGDSkinButton.AdjustBounds;
begin
  if not (csReading in ComponentState) and FAutoSize then
    if (SkinRegion<>Nil) and not SkinRegion.IsEmpty then
    begin
      Width:=SkinRegion.Bitmap.Width;
      Height:=SkinRegion.Bitmap.Height;
    end else
      inherited AdjustBounds;
end;

procedure TGDSkinButton.CMFontChanged(var Message: TMessage);
begin
  AdjustBounds;
end;

procedure TGDSkinButton.CMMouseEnter(var Message: TMessage);
begin
  SetActiveRegionLink(FEnterRegionLink);
  inherited;
end;

procedure TGDSkinButton.CMMouseLeave(var Message: TMessage);
begin
  SetActiveRegionLink(FRegionLink);
  inherited;
end;

procedure TGDSkinButton.CMTextChanged(var Message: TMessage);
begin
  Invalidate;
//  AdjustBounds;
end;

constructor TGDSkinButton.Create(AOwner: TComponent);
begin
  inherited;
  Transparent:=True;
  FAutoSize:=True;
  Alignment:=taCenter;
  Layout:=tlCenter;
  FRegionLink:=TGDRegionLink.Create;
  FRegionLink.OnChange:=RegionChanged;
  FEnterRegionLink:= TGDRegionLink.Create;
  FDownRegionLink:= TGDRegionLink.Create;

  FActiveRegionLink:=FRegionLink;
end;

destructor TGDSkinButton.Destroy;
begin
  FRegionLink.Free;
  FEnterRegionLink.Free;
  FDownRegionLink.Free;
  inherited;
end;

function TGDSkinButton.GetSkinRegion(Index:Integer): TGDSkinRegion;
begin
  case Index of
    0: Result:=TGdSkinRegion(FRegionLink.Region);
    1: Result:=TGdSkinRegion(FEnterRegionLink.Region);
    2: Result:=TGdSkinRegion(FDownRegionLink.Region);
  end;
end;

procedure TGDSkinButton.Loaded;
begin
  AdjustBounds;
end;

procedure TGDSkinButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited;
  SetActiveRegionLink(FDownRegionLink);
end;

procedure TGDSkinButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  SetActiveRegionLink(FRegionLink);
end;

procedure TGDSkinButton.Paint;
const
  Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
var
  Rect, CalcRect: TRect;
  DrawStyle: Longint;
  ARegion:TGdSkinRegion;
begin
  with Canvas do
  begin
    ARegion:=TGdSkinRegion(FActiveRegionLink.Region);
    if Assigned(ARegion) and not ARegion.IsEmpty then
      Draw(0,0,ARegion.Bitmap)
    else if not Transparent then
    begin
      Brush.Color:=Self.Color;
      Brush.Style:=bsSolid;
      FillRect(ClientRect);
    end
    else if (csDesigning in ComponentState) then
    begin
      Pen.Color:=Self.Color;
      Rectangle(ClientRect);
    end;
    Brush.Style := bsClear;
    Rect := ClientRect;
    { DoDrawText takes care of BiDi alignments }
    DrawStyle := DT_EXPANDTABS or WordWraps[WordWrap] or Alignments[Alignment];
    { Calculate vertical layout }
    if Layout <> tlTop then
    begin
      CalcRect := Rect;
      DoDrawText(CalcRect, DrawStyle or DT_CALCRECT);
      if Layout = tlBottom then OffsetRect(Rect, 0, Height - CalcRect.Bottom)
      else OffsetRect(Rect, 0, (Height - CalcRect.Bottom) div 2);
    end;
    DoDrawText(Rect, DrawStyle);
  end;
end;

procedure TGDSkinButton.RegionChanged(Sender:TObject);
begin
  AdjustBounds;
  Invalidate;
end;

procedure TGDSkinButton.SetActiveRegionLink(RegionLink: TGDRegionLink);
begin
  if csDesigning in ComponentState then Exit;
  FActiveRegionLink:=RegionLink;
  Invalidate;
end;

procedure TGDSkinButton.SetAutoSize(Value: Boolean);
begin
  if FAutoSize <> Value then
  begin
    FAutoSize:=Value;
    AdjustBounds;
  end;
end;

procedure TGDSkinButton.SetSkinRegion(Index:Integer;Value: TGdSkinRegion);
var
  ARegion:TGDRegionLink;
begin
  case Index of
    0: ARegion:=FRegionLink;
    1: ARegion:=FEnterRegionLink;
    2: ARegion:=FDownRegionLink;
  end;
  if ARegion.Region <> Value then
  begin
    ARegion.Region := Value;
    RegionChanged(Self);
  end;
end;
{
procedure TSkinButton.SetTransparent(const Value: Boolean);
begin
  if FTransparent <> Value then
  begin
    FTransparent := Value;
    Invalidate;
  end;
end;
}
{ TGDSkinPanel }

constructor TGDSkinPanel.Create(AOwner: TComponent);
begin
  inherited;
  BevelOuter:=bvNone;
end;

procedure TGDSkinPanel.Paint;
begin
  inherited;
  if (Region<>Nil) and (Region.Bitmap<>Nil) then
  begin
    Canvas.Brush.Bitmap:=Region.Bitmap;
    Canvas.FillRect(ClientRect);
  end else
  begin
    Canvas.Pen.Style:=psDot;
    Canvas.Rectangle(ClientRect);
  end;
end;

procedure TGDSkinPanel.SetRegion(const Value: TGdSkinRegion);
begin
  if FRegion <> Value then
  begin
    FRegion := Value;
    Invalidate;
  end;
end;

end.