sxskinbutton.pas

skin components for design of your applicastions

unit SXSkinButton;

////////////////////////////////////////////////////////////////////////////////
// SXSkinComponents: Skinnable Visual Controls for Delphi and C++Builder      //
//----------------------------------------------------------------------------//
// Version: 1.2.1                                                             //
// Author: Alexey Sadovnikov                                                  //
// Web Site: http://www.saarixx.info/sxskincomponents/                        //
// E-Mail: [e-mail]                                      //
//----------------------------------------------------------------------------//
// LICENSE:                                                                   //
// 1. You may freely distribute this file.                                    //
// 2. You may not make any changes to this file.                              //
// 3. The only person who may change this file is Alexey Sadovnikov.          //
// 4. You may use this file in your freeware projects.                        //
// 5. If you want to use this file in your shareware or commercial project,   //
//    you should purchase a project license or a personal license of          //
//    SXSkinComponents: http://saarixx.info/sxskincomponents/en/purchase.htm  //
// 6. You may freely use, distribute and modify skins for SXSkinComponents.   //
// 7. You may create skins for SXSkinComponents.                              //
//----------------------------------------------------------------------------//
// Copyright (C) 2006-2007, Alexey Sadovnikov. All Rights Reserved.           //
////////////////////////////////////////////////////////////////////////////////

interface

{$I Compilers.inc}

uses Windows, Classes, SXSkinControl, GR32, StdCtrls, Dialogs, SysUtils, Forms,
     Messages, Controls, GR32_Blend, SXSkinLibrary, Types, Graphics, Menus,
     GR32_Polygons;

const

 VARB_W   = 1;
 VARB_H   = 2;
 VARB_GlX = 3;
 VARB_GlY = 4;
 VARB_GlW = 5;
 VARB_GlH = 6;

type

 TSXSkinCustomButton=class;

 TSXSkinCustomButtonThread=class(TThread)
  public
   Control:TSXSkinCustomButton;
   constructor Create;
   procedure Execute; override;
   procedure DoEvent;
 end;

 TSXSkinButtonResetParam=(brpText,
                          brpTextOnFontChange,
                          brpTextIfWordWrap,
                          brpGlyph,
                          brpGlyphOnStyleChange,
                          brpGlyphOnSizeChange,
                          brpDDGlyph,
                          brpDDGlyphOnStyleChange,
                          brpInvalidateOnStyleChange);

 TSXSkinButtonResetParams=set of TSXSkinButtonResetParam;

 TSXSkinButtonTransform=(btButton,btGlyph,btDDGlyph);

 TSXButtonVariableComparer=class(TSXVariableComparer)
  private
   Control:TSXSkinCustomButton;
   function GetValue(VarID:Integer):Integer;
  protected
   function VarListOnGetVariable(const VarName:String;var Error:Boolean):Single; override;
  public
   function GetVarValsForVarList(VarList:TList):TList; override;
   function Changed(VarList:TList;OldVarVals:TList):Boolean; override;
   procedure Update(VarList:TList;VarVals:TList); override;
   procedure DestroyVarList(VarList:TList); override;
   procedure DestroyVarVals(VarList:TList;VarVals:TList); override;
 end;

 TSXSkinCustomButton=class(TSXSkinCustomControl)
  private
   FGlyphPosition:TSXGlyphPosition;
   FWordWrap:Boolean;
   FCaptionLeftOffset:Integer;
   FCaptionTopOffset:Integer;
   FCaptionRightOffset:Integer;
   FCaptionBottomOffset:Integer;
   FCanBeChecked:Boolean;
   FChecked:Boolean;
   FDropDown:Boolean;
   FDropDownMenu:TPopupMenu;
   FGlyphStyle:String;
   FDropDownGlyphStyle:String;
   FTextOffset:Integer;
   FAlignment:TAlignment;
   FGlyphWidth:Integer;
   FGlyphHeight:Integer;
   FOnClick:TNotifyEvent;
   FMouseOver:Boolean;
   FDown:Boolean;
   FThread:TSXSkinCustomButtonThread;
   //
   FLastButtonTransform:TSXTransformEffectData;
   FLastGlyphTransform:TSXTransformEffectData;
   FLastDDGlyphTransform:TSXTransformEffectData;
   FDoneSteps:Integer;
   FLastGlyph:TBitmap32;
   FLastDropDownGlyph:TBitmap32;
   FLastButton:TBitmap32;
   //
   FGlyphRect:TRect;
   FTextRect:TRect;
   FDropDownGlyphRect:TRect;
   FTextBitmap:TBitmap32;
   FLastFontData:TSXFontData;
   FLastStyle:String;
   FLastOverStyle:String;
   FLastGlyphStyle:String;
   FLastGlyphFilterData:TSXFilterData;
   FLastDropDownGlyphStyle:String;
   FLastFocused:Boolean;
   CEID_Back:Integer;
   CEID_Glyph:Integer;
   CEID_DDGlyph:Integer;
   VComparer:TSXButtonVariableComparer;
   procedure SetCaption(const Value:TCaption);
   procedure SetAlignment(Value:TAlignment);
   procedure SetGlyphPosition(Value:TSXGlyphPosition);
   procedure SetWordWrap(Value:Boolean);
   procedure SetCaptionLeftOffset(Value:Integer);
   procedure SetCaptionTopOffset(Value:Integer);
   procedure SetCaptionRightOffset(Value:Integer);
   procedure SetCaptionBottomOffset(Value:Integer);
   procedure SetTextOffset(Value:Integer);
   procedure SetCanBeChecked(Value:Boolean);
   procedure SetChecked(Value:Boolean);
   procedure SetDropDown(Value:Boolean);
   procedure SetGlyphStyle(const Value:String);
   procedure SetDropDownGlyphStyle(const Value:String);
   procedure SetGlyphWidth(Value:Integer);
   procedure SetGlyphHeight(Value:Integer);
   procedure SetDropDownMenu(Value:TPopupMenu);
   function HasUnusualSkinStyle:Boolean;
   function HasUnusualDropDownGlyphStyle:Boolean;
   function OnGetVariable(const VarName:String;var Error:Boolean):Single;
   function CreateCurrentGlyph:TBitmap32;
   function CreateCurrentBlendedGlyph:TBitmap32;
   function CreateCurrentDropDownGlyph:TBitmap32;
   function CreateCurrentBlendedDropDownGlyph:TBitmap32;
   procedure DoThreadActions;
   procedure StartGlyphChanging(T:TSXGlyphChangeAction);
   procedure GetCurrentTransformEffect(T:TSXSkinButtonTransform;
              Action:TSXGlyphChangeAction;var Effect:TSXTransformEffectData);
   procedure CreateThreadIfNeeded;
   procedure ResetButtonParams(Params:TSXSkinButtonResetParams=[]);
   procedure CMFontChanged(var Message:TMessage); message CM_FONTCHANGED;
   procedure InvalidateGlyph;
   procedure GetCurrentBState(var BState:TSXSkinButtonStateParam);
   procedure GetCurrentGlyphStyle(var GStyle:String;PGlyphWidth:PInteger=nil;
              PGlyphHeight:PInteger=nil;PUseFilter:PBoolean=nil);
   procedure GetCurrentDropDownGlyphStyle(var GStyle:String;PGlyphWidth:PInteger=nil;
              PGlyphHeight:PInteger=nil);
   procedure InternalMouseEnter;
   procedure InternalMouseLeave;
  protected
   function CapturesMouseAt(X,Y:Integer):Boolean; override;
   procedure SetEnabled(Value:Boolean); override;
   procedure Loaded; override;
   function GetCaption:TCaption;
   procedure DoClick;
   procedure Notification(AComponent:TComponent;Operation:TOperation); override;
   procedure MouseMove(Shift:TShiftState;X,Y:Integer); override;
   procedure MouseDown(Button:TMouseButton;Shift:TShiftState;X,Y:Integer); override;
   procedure MouseUp(Button:TMouseButton;Shift:TShiftState;X,Y:Integer); override;
   procedure MouseLeave; override;
   procedure DoKeyDown(var Msg:TMessage); message CN_KEYDOWN;
   procedure DoKeyUp(var Msg:TMessage); message CN_KEYUP;
   procedure WMSetFocus(var Msg:TWMSetFocus); message WM_SETFOCUS;
   procedure WMKillFocus(var Msg:TWMKillFocus); message WM_KILLFOCUS;
   procedure PaintCurrentBStyle(Bitmap:TBitmap32;X,Y:Integer;Rect:TRect;Rgn:HRGN);
   procedure PaintCurrentBlendedBStyle(Bitmap:TBitmap32;X,Y:Integer;Rect:TRect;Rgn:HRGN);
   procedure PaintCurrentOverStyleCaptionToBitmap(DestCanvasHandle:HDC;
              DestCanvasRect:TRect;Rect:TRect;Rgn:HRGN;Bitmap:TBitmap32;X,Y:Integer);
   property Caption:TCaption read GetCaption write SetCaption;
   property GlyphPosition:TSXGlyphPosition read FGlyphPosition write SetGlyphPosition default gpLeft;
   property CaptionLeftOffset:Integer read FCaptionLeftOffset write SetCaptionLeftOffset default 0;
   property CaptionTopOffset:Integer read FCaptionTopOffset write SetCaptionTopOffset default 0;
   property CaptionRightOffset:Integer read FCaptionRightOffset write SetCaptionRightOffset default 0;
   property CaptionBottomOffset:Integer read FCaptionBottomOffset write SetCaptionBottomOffset default 0;
   property WordWrap:Boolean read FWordWrap write SetWordWrap default False;
   property Alignment:TAlignment read FAlignment write SetAlignment default taLeftJustify;
   property SkinStyle stored HasUnusualSkinStyle;
   property TextOffset:Integer read FTextOffset write SetTextOffset default 5;
   property CanBeChecked:Boolean read FCanBeChecked write SetCanBeChecked default False;
   property Checked:Boolean read FChecked write SetChecked default False;
   property DropDown:Boolean read FDropDown write SetDropDown default False;
   property DropDownMenu:TPopupMenu read FDropDownMenu write SetDropDownMenu;
   property GlyphStyle:String read FGlyphStyle write SetGlyphStyle;
   property DropDownGlyphStyle:String read FDropDownGlyphStyle write SetDropDownGlyphStyle stored HasUnusualDropDownGlyphStyle;
   property GlyphWidth:Integer read FGlyphWidth write SetGlyphWidth default 0;
   property GlyphHeight:Integer read FGlyphHeight write SetGlyphHeight default 0;
  public
   function IsTransparent(X,Y:Integer;Limit:Integer=10):Boolean; override;
   procedure PaintRectToBitmap(DestCanvasHandle:HDC;DestCanvasRect:TRect;
              Rect:TRect;Rgn:HRGN;Bitmap:TBitmap32;X,Y:Integer;
              WithSubItems:Boolean); override;
   procedure SetBounds(ALeft,ATop,AWidth,AHeight:Integer); override;
   procedure SkinChanged; override;
   procedure Click; reintroduce;
   constructor Create(AOwner:TComponent); override;
   destructor Destroy; override;
  published
   property TabStop default True;
   property OnClick:TNotifyEvent read FOnClick write FOnClick;
 end;

 TSXSkinButton=class(TSXSkinCustomButton)
  published
   property Align;
   property Alignment;
   property Anchors;
   property CanBeChecked;
   property Caption;
   property CaptionLeftOffset;
   property CaptionTopOffset;
   property CaptionRightOffset;
   property CaptionBottomOffset;
   property Checked;
   property Color;
   property Constraints;
   property Cursor;
   property DragCursor;
   property DropDown;
   property DropDownGlyphStyle;
   property DropDownMenu;
   property Enabled;
   property Font;
   property GlyphHeight;
   property GlyphPosition;
   property GlyphStyle;
   property GlyphWidth;
   //property HintData;
   property ParentColor;
   property ParentFont;
   property ParentShowHint;
   property PopupMenu;
   property ShowHint;
   property SkinLibrary;
   property SkinStyle;
   property TabOrder;
   property TabStop default True;
   property TextOffset;
   property Visible;
   property WordWrap;
   property OnCanResize;
   property OnClick;
   property OnDblClick;
   property OnDragDrop;
   property OnDragOver;
   property OnEndDrag;
   property OnKeyDown;
   property OnKeyPress;
   property OnKeyUp;
   property OnMouseDown;
   property OnMouseEnter;
   property OnMouseLeave;
   property OnMouseMove;
   property OnMouseUp;
   property OnMouseWheel;
   property OnMouseWheelDown;
   property OnMouseWheelUp;
   property OnResize;
   property OnStartDrag;
 end;

implementation

uses Math, SXBitmap32Utils;

{ TSXSkinCustomButtonThread }

constructor TSXSkinCustomButtonThread.Create;
begin
 inherited Create(True);
 FreeOnTerminate:=False;
end;

procedure TSXSkinCustomButtonThread.Execute;
begin
 while not Terminated do
  begin
   SleepEx(30,True);
   if not Suspended then
    Synchronize(DoEvent);
  end;
end;

procedure TSXSkinCustomButtonThread.DoEvent;
begin
 if Assigned(Control) then
  Control.DoThreadActions;
end;

{ TSXButtonVariableComparer }

function TSXButtonVariableComparer.VarListOnGetVariable(const VarName:String;var Error:Boolean):Single;
var CurVarVal:Integer;
begin
 Result:=1234;
 CurVarVal:=-1;
 if VarName='W' then
  CurVarVal:=VARB_W else
 if VarName='H' then
  CurVarVal:=VARB_H else
 if VarName='GlX' then
  CurVarVal:=VARB_GlX else
 if VarName='GlY' then
  CurVarVal:=VARB_GlY else
 if VarName='GlW' then
  CurVarVal:=VARB_GlW else
 if VarName='GlH' then
  CurVarVal:=VARB_GlH;
 if CurVarVal>=0 then
  begin
   if CurValList=nil then
    CurValList:=TList.Create;
   CurValList.Add(Pointer(CurVarVal));
  end;
end;

function TSXButtonVariableComparer.GetValue(VarID:Integer):Integer;
begin
 Result:=0;
 if Control<>nil then
  begin
   case VarID of
    VARB_W:   Result:=Control.Width;
    VARB_H:   Result:=Control.Height;
    VARB_GlX: Result:=Control.FGlyphRect.Left;
    VARB_GlY: Result:=Control.FGlyphRect.Top;
    VARB_GlW: Result:=Control.FGlyphRect.Right-Control.FGlyphRect.Left;
    VARB_GlH: Result:=Control.FGlyphRect.Bottom-Control.FGlyphRect.Top;
   end;
  end;
end;

function TSXButtonVariableComparer.GetVarValsForVarList(VarList:TList):TList;
var A:Integer;
begin
 if VarList=nil then
  begin
   Result:=nil;
   exit;
  end;
 Result:=TList.Create;
 for A:=0 to VarList.Count-1 do
  Result.Add(Pointer(GetValue(Integer(VarList[A]))));
end;

function TSXButtonVariableComparer.Changed(VarList:TList;OldVarVals:TList):Boolean;
var A:Integer;
begin
 Result:=False;
 if VarList=nil then exit;
 for A:=0 to VarList.Count-1 do
  if Integer(OldVarVals[A])<>GetValue(Integer(VarList[A])) then
   begin
    Result:=True;
    exit;
   end;
end;

procedure TSXButtonVariableComparer.Update(VarList:TList;VarVals:TList);
var A:Integer;
begin
 if VarList=nil then exit;
 for A:=0 to VarList.Count-1 do
  VarVals[A]:=Pointer(GetValue(Integer(VarList[A])));
end;

procedure TSXButtonVariableComparer.DestroyVarList(VarList:TList);
begin