sxskinupdown.pas

skin components for design of your applicastions

unit SXSkinUpDown;

////////////////////////////////////////////////////////////////////////////////
// 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;

const

 VARUD_W  =  1;
 VARUD_H  =  2;
 VARUD_UL =  3;
 VARUD_UT =  4;
 VARUD_UR =  5;
 VARUD_UB =  6;
 VARUD_DL =  7;
 VARUD_DT =  8;
 VARUD_DR =  9;
 VARUD_DB = 10;

type

 TSXSkinCustomUpDown=class;

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

 TSXSkinUpDownResetParam=(udrpButtonRects,
                          udrpInvalidateOnStyleChange,
                          udrpInvalidateUpButtonOnStyleChange,
                          udrpInvalidateDownButtonOnStyleChange);

 TSXSkinUpDownResetParams=set of TSXSkinUpDownResetParam;

 TSXUpDownNotifyEvent=procedure(Sender:TObject;UpButton:Boolean) of object;

 TSXUpDownVariableComparer=class(TSXVariableComparer)
  private
   Control:TSXSkinCustomUpDown;
   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;

 TSXSkinCustomUpDown=class(TSXSkinCustomControl)
  private
   FOnClick:TSXUpDownNotifyEvent;
   FHorizontal:Boolean;
   FMouseOver:Boolean;
   FMouseOverUp:Boolean;
   FMouseOverDown:Boolean;
   FDownUp:Boolean;
   FDownDown:Boolean;
   FThread:TSXSkinCustomUpDownThread;
   FEnabledUp:Boolean;
   FEnabledDown:Boolean;
   //
   FLastUpDownTransform:TSXTransformEffectData;
   FUpDownDoneSteps:Integer;
   FLastUpDown:TBitmap32;
   //
   FLastUpButtonTransform:TSXTransformEffectData;
   FUpButtonDoneSteps:Integer;
   FLastUpButton:TBitmap32;
   //
   FLastDownButtonTransform:TSXTransformEffectData;
   FDownButtonDoneSteps:Integer;
   FLastDownButton:TBitmap32;
   //
   FUpButtonRect:TRect;
   FDownButtonRect:TRect;
   FLastStyle:String;
   FLastOverStyle:String;
   FLastUpButtonStyle:String;
   FLastUpButtonOverStyle:String;
   FLastDownButtonStyle:String;
   FLastDownButtonOverStyle:String;
   FLastFocused:Boolean;
   SeqClickNum:Integer;
   CEID_Back:Integer;
   CEID_Up:Integer;
   CEID_Down:Integer;
   VComparer:TSXUpDownVariableComparer;
   function HasUnusualSkinStyle:Boolean;
   function OnGetVariable(const VarName:String;var Error:Boolean):Single;
   procedure SetEnabledUp(Value:Boolean);
   procedure SetEnabledDown(Value:Boolean);
   procedure SetHorizontal(Value:Boolean);
   procedure DoThreadActions;
   procedure CreateThreadIfNeeded;
   procedure ResetUpDownParams(Params:TSXSkinUpDownResetParams=[]);
   procedure InternalMouseEnter;
   procedure InternalMouseLeave;
   procedure InternalMouseEnterUpButton;
   procedure InternalMouseLeaveUpButton;
   procedure InternalMouseEnterDownButton;
   procedure InternalMouseLeaveDownButton;
   procedure StartChangingEffect(T:TSXGlyphChangeAction);
   procedure StartUpButtonChangingEffect(T:TSXGlyphChangeAction);
   procedure StartDownButtonChangingEffect(T:TSXGlyphChangeAction);
   procedure GetUpDownTransformEffect(Action:TSXGlyphChangeAction;
              var Effect:TSXTransformEffectData);
   procedure GetUpButtonTransformEffect(Action:TSXGlyphChangeAction;
              var Effect:TSXTransformEffectData);
   procedure GetDownButtonTransformEffect(Action:TSXGlyphChangeAction;
              var Effect:TSXTransformEffectData);
   procedure GetCurrentUDState(var UDState:TSXSkinUpDownStateParam);
   procedure GetCurrentUpButtonState(var BState:TSXSkinButtonStateParam);
   procedure GetCurrentDownButtonState(var BState:TSXSkinButtonStateParam);
   procedure WndProc(var Msg:TMessage); override;
  protected
   function UpButtonCapturesMouseAt(X,Y:Integer):Boolean;
   function DownButtonCapturesMouseAt(X,Y:Integer):Boolean;   
   function CapturesMouseAt(X,Y:Integer):Boolean; override;
   procedure SetEnabled(Value:Boolean); override;
   procedure Loaded; override;
   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 InvalidateUpButton;
   procedure InvalidateDownButton;
   procedure DoClick(UpButton:Boolean);
   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 PaintUpButtonStyle(Bitmap:TBitmap32;X,Y:Integer;Rect:TRect;Rgn:HRGN);
   procedure PaintDownButtonStyle(Bitmap:TBitmap32;X,Y:Integer;Rect:TRect;Rgn:HRGN);
   procedure PaintBlendedUpButtonStyle(Bitmap:TBitmap32;X,Y:Integer;Rect:TRect;Rgn:HRGN);
   procedure PaintBlendedDownButtonStyle(Bitmap:TBitmap32;X,Y:Integer;Rect:TRect;Rgn:HRGN);
   procedure PaintOverStyleButtonsToBitmap(Bitmap:TBitmap32;X,Y:Integer;Rect:TRect;Rgn:HRGN);
   procedure PaintCurrentUDStyle(Bitmap:TBitmap32;X,Y:Integer;Rect:TRect;Rgn:HRGN);
   procedure PaintCurrentBlendedUDStyle(Bitmap:TBitmap32;X,Y:Integer;Rect:TRect;Rgn:HRGN);
   property SkinStyle stored HasUnusualSkinStyle;
  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;
   constructor Create(AOwner:TComponent); override;
   destructor Destroy; override;
  published
   property EnabledDown:Boolean read FEnabledDown write SetEnabledDown default True;
   property EnabledUp:Boolean read FEnabledUp write SetEnabledUp default True;
   property Horizontal:Boolean read FHorizontal write SetHorizontal default False;
   property TabStop default True;
   property OnClick:TSXUpDownNotifyEvent read FOnClick write FOnClick;
   property OnContextPopup;
   property OnDragDrop;
   property OnDragOver;
   property OnEndDock;
   property OnEndDrag;
   property OnMouseDown;
   property OnMouseMove;
   property OnMouseUp;
   property OnMouseWheel;
   property OnMouseWheelDown;
   property OnMouseWheelUp;
   property OnResize;
   property OnStartDock;
   property OnStartDrag;
 end;

 TSXSkinUpDown=class(TSXSkinCustomUpDown)
  published
   property Align;
   property Anchors;
   property Constraints;
   property Cursor;
   property DragCursor;
   property Enabled;
   property EnabledDown;
   property EnabledUp;
   //property HintData;
   property Horizontal;
   property ParentShowHint;
   property PopupMenu;
   property ShowHint;
   property SkinLibrary;
   property SkinStyle;
   property TabOrder;
   property TabStop default True;
   property Visible;
   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;

{ TSXSkinCustomUpDownThread }

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

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

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

{ TSXUpDownVariableComparer }

function TSXUpDownVariableComparer.VarListOnGetVariable(const VarName:String;var Error:Boolean):Single;
var CurVarVal:Integer;
begin
 Result:=1234;
 CurVarVal:=-1;
 if VarName='W' then
  CurVarVal:=VARUD_W else
 if VarName='H' then
  CurVarVal:=VARUD_H else
 if VarName='UL' then
  CurVarVal:=VARUD_UL else
 if VarName='UT' then
  CurVarVal:=VARUD_UT else
 if VarName='UR' then
  CurVarVal:=VARUD_UR else
 if VarName='UB' then
  CurVarVal:=VARUD_UB else
 if VarName='DL' then
  CurVarVal:=VARUD_DL else
 if VarName='DT' then
  CurVarVal:=VARUD_DT else
 if VarName='DR' then
  CurVarVal:=VARUD_DR else
 if VarName='DB' then
  CurVarVal:=VARUD_DB;
 if CurVarVal>=0 then
  begin
   if CurValList=nil then
    CurValList:=TList.Create;
   CurValList.Add(Pointer(CurVarVal));
  end;
end;

function TSXUpDownVariableComparer.GetValue(VarID:Integer):Integer;
begin
 Result:=0;
 if Control<>nil then
  begin
   case VarID of
    VARUD_W:  Result:=Control.Width;
    VARUD_H:  Result:=Control.Height;
    VARUD_UL: Result:=Control.FUpButtonRect.Left;
    VARUD_UT: Result:=Control.FUpButtonRect.Top;
    VARUD_UR: Result:=Control.FUpButtonRect.Right;
    VARUD_UB: Result:=Control.FUpButtonRect.Bottom;
    VARUD_DL: Result:=Control.FDownButtonRect.Left;
    VARUD_DT: Result:=Control.FDownButtonRect.Top;
    VARUD_DR: Result:=Control.FDownButtonRect.Right;
    VARUD_DB: Result:=Control.FDownButtonRect.Bottom;
   end;
  end;
end;

function TSXUpDownVariableComparer.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 TSXUpDownVariableComparer.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 TSXUpDownVariableComparer.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 TSXUpDownVariableComparer.DestroyVarList(VarList:TList);
begin
 VarList.Free;
end;

procedure TSXUpDownVariableComparer.DestroyVarVals(VarList:TList;VarVals:TList);
begin
 VarVals.Free;
end;

{ TSXSkinCustomUpDown }

function TSXSkinCustomUpDown.HasUnusualSkinStyle:Boolean;
begin
 Result:=SkinStyle<>'_UpDown';
end;

procedure TSXSkinCustomUpDown.SetEnabled(Value:Boolean);
begin
 if Enabled<>Value then
  begin
   if not (csLoading in ComponentState) then
    begin
     if Enabled then
      begin
       StartChangingEffect(gcaDisable);
       if FEnabledUp then
        StartUpButtonChangingEffect(gcaDisable);
       if FEnabledDown then
        StartDownButtonChangingEffect(gcaDisable);
      end else
       begin
        StartChangingEffect(gcaEnable);
        if FEnabledUp then
         StartUpButtonChangingEffect(gcaEnable);
        if FEnabledDown then
         StartDownButtonChangingEffect(gcaEnable);
       end;
    end;
   inherited;
   if not Enabled then
    begin