sxskingroupbox.pas

skin components for design of your applicastions

unit SXSkinGroupBox;

////////////////////////////////////////////////////////////////////////////////
// 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,
     Messages, Controls, GR32_Blend, SXSkinLibrary, Types, Graphics;

const

 VARGB_W   =  1;
 VARGB_H   =  2;
 VARGB_CL  =  3;
 VARGB_CT  =  4;
 VARGB_CR  =  5;
 VARGB_CB  =  6;
 VARGB_GlX =  7;
 VARGB_GlY =  8;
 VARGB_GlW =  9;
 VARGB_GlH = 10;
 VARGB_TL  = 11;
 VARGB_TT  = 12;
 VARGB_TR  = 13;
 VARGB_TB  = 14;

type

 TSXGroupBoxGlyphType=(gtNone,
                       gtSimple,
                       gtCheckBox,
                       gtRadioButton);

 TSXGroupBoxGlyphPosition=(gbgpLeft,gbgpRight);

 TSXSkinCustomGroupBox=class;

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

 TSXSkinGroupBoxResetParam=(gbrpText,
                            gbrpTextOnFontChange,
                            gbrpTextIfWordWrap,
                            gbrpGlyph,
                            gbrpGlyphOnStyleChange,
                            gbrpGlyphOnSizeChange,
                            gbrpInvalidateOnStyleChange,
                            gbrpTransparentRect);

 TSXSkinGroupBoxResetParams=set of TSXSkinGroupBoxResetParam;

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

 TSXSkinCustomGroupBox=class(TSXSkinCustomControl)
  private
   FGlyphType:TSXGroupBoxGlyphType;
   FWordWrap:Boolean;
   FCaptionAlignment:TAlignment;
   FAlignment:TAlignment;
   FOnMouseEnter:TNotifyEvent;
   FOnMouseLeave:TNotifyEvent;
   FGlyphStyle:String;
   FState:TCheckBoxState;
   FAllowGrayed:Boolean;
   FTextOffset:Integer;
   FGlyphPosition:TSXGroupBoxGlyphPosition;
   FUseLabelStyle:Boolean;
   FOnChange:TNotifyEvent;
   FOnUserModified:TNotifyEvent;
   //
   FMouseOver:Boolean;
   FDown:Boolean;
   FCaptionRect:TRect;
   FGlyphRect:TRect;
   FTextRect:TRect;
   FTransparentRect:TRect;
   FTextBitmap:TBitmap32;
   FLastFontData:TSXFontData;
   FLastGlyphStyle:String;
   FLastGBStyle:String;
   FLastGBOverStyle:String;
   FLastTextLeftOffset:Integer;
   FLastTextTopOffset:Integer;
   FLastTextRightOffset:Integer;
   FLastTextBottomOffset:Integer;
   //
   FLastGlyphTransform:TSXTransformEffectData;
   FThread:TSXSkinCustomGroupBoxThread;
   FLastGlyph:TBitmap32;
   FLastFocused:Boolean;
   FDoneSteps:Integer;
   //
   CEID_Back:Integer;
   CEID_Glyph:Integer;
   VComparer:TSXGroupBoxVariableComparer;
   procedure SetCaption(const Value:TCaption);
   procedure SetAlignment(Value:TAlignment);
   procedure SetCaptionAlignment(Value:TAlignment);
   procedure SetWordWrap(Value:Boolean);
   procedure SetGlyphType(Value:TSXGroupBoxGlyphType);
   procedure SetTextOffset(Value:Integer);
   procedure SetGlyphPosition(Value:TSXGroupBoxGlyphPosition);
   procedure SetUseLabelStyle(Value:Boolean);
   procedure SetAllowGrayed(Value:Boolean);
   procedure SetState(Value:TCheckBoxState);
   procedure SetChecked(Value:Boolean);
   procedure SetGlyphStyle(const Value:String);
   function HasUnusualSkinStyle:Boolean;
   function OnGetVariable(const VarName:String;var Error:Boolean):Single;
   procedure CMFontChanged(var Message:TMessage); message CM_FONTCHANGED;
   procedure WMSetFocus(var Msg:TWMSetFocus); message WM_SETFOCUS;
   procedure WMKillFocus(var Msg:TWMKillFocus); message WM_KILLFOCUS;
   procedure GetCurrentFontData(var FD:TSXFontData);
   procedure GetCurrentGlyphStyle(var GStyle:String;PGlyphWidth:PInteger=nil;
              PGlyphHeight:PInteger=nil);
   procedure CreateThreadIfNeeded;
   procedure DoThreadActions;
   function CreateCurrentGlyph:TBitmap32;
   function CreateCurrentBlendedGlyph:TBitmap32;
   procedure StartGlyphChanging(T:TSXGlyphChangeAction);
   procedure GetCurrentGlyphTransformEffect(Action:TSXGlyphChangeAction;var Effect:TSXTransformEffectData);
   procedure ResetGroupBoxParams(Params:TSXSkinGroupBoxResetParams=[]);
   procedure GetCurrentGBState(var GBState:TSXSkinGroupBoxStateParam);
  protected
   function CapturesMouseAt(X,Y:Integer):Boolean; override;
   procedure SetEnabled(Value:Boolean); override;
   procedure DoClick;
   procedure Loaded; override;
   function GetCaption:TCaption;
   function GetChecked:Boolean;
   procedure InternalMouseEnter;
   procedure InternalMouseLeave;
   procedure CMMouseLeave(var Msg:TMessage); message CM_MOUSELEAVE;
   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 DoKeyDown(var Msg:TMessage); message CN_KEYDOWN;
   procedure DoKeyUp(var Msg:TMessage); message CN_KEYUP;
   procedure AdjustClientRect(var Rect:TRect); override;
   property Caption:TCaption read GetCaption write SetCaption;
   property WordWrap:Boolean read FWordWrap write SetWordWrap default False;
   property Alignment:TAlignment read FAlignment write SetAlignment default taLeftJustify;
   property CaptionAlignment:TAlignment read FCaptionAlignment write SetCaptionAlignment default taLeftJustify;
   property TextOffset:Integer read FTextOffset write SetTextOffset default 2;
   property GlyphPosition:TSXGroupBoxGlyphPosition read FGlyphPosition write SetGlyphPosition default gbgpLeft;
   property UseLabelStyle:Boolean read FUseLabelStyle write SetUseLabelStyle default True;
   property AllowGrayed:Boolean read FAllowGrayed write SetAllowGrayed default False;
   property Checked:Boolean read GetChecked write SetChecked stored False;
   property GlyphStyle:String read FGlyphStyle write SetGlyphStyle;
   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 DoUncheck;
   procedure InvalidateGroupBoxArea;
   procedure InvalidateGlyph;
   procedure InvalidateText;
   procedure Click; reintroduce;
   procedure SetBounds(ALeft,ATop,AWidth,AHeight:Integer); override;
   procedure SkinChanged; override;
   constructor Create(AOwner:TComponent); override;
   destructor Destroy; override;
   property GlyphType:TSXGroupBoxGlyphType read FGlyphType write SetGlyphType default gtNone;
   property State:TCheckBoxState read FState write SetState default cbUnchecked; 
  published
   property OnChange:TNotifyEvent read FOnChange write FOnChange;
   property OnUserModified:TNotifyEvent read FOnUserModified write FOnUserModified;
   property OnMouseEnter:TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
   property OnMouseLeave:TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
 end;

 TSXSkinGroupBox=class(TSXSkinCustomGroupBox)
  published
   property Align;
   property Alignment;
   property AllowGrayed;
   property Anchors;
   property Caption;
   property CaptionAlignment;
   property Checked;
   property Color;
   property Constraints;
   property Cursor;
   property DragCursor;
   property Enabled;
   property Font;
   property GlyphPosition;
   property GlyphStyle;
   property GlyphType;
   //property HintData;
   property ParentColor;
   property ParentFont;
   property ParentShowHint;
   property PopupMenu;
   property ShowHint;
   property SkinLibrary;
   property SkinStyle;
   property State;
   property TabOrder;
   property TabStop default False;   
   property TextOffset;
   property UseLabelStyle;
   property Visible;
   property WordWrap;
   property OnCanResize;
   property OnChange;
   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;
   property OnUserModified;
 end;

implementation

uses Math, SXBitmap32Utils, SXSkinRadioButton;

{ TSXSkinCustomGroupBoxThread }

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

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

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

{ TSXGroupBoxVariableComparer }

function TSXGroupBoxVariableComparer.VarListOnGetVariable(const VarName:String;var Error:Boolean):Single;
var CurVarVal:Integer;
begin
 Result:=1234;
 CurVarVal:=-1;
 if VarName='W' then
  CurVarVal:=VARGB_W else
 if VarName='H' then
  CurVarVal:=VARGB_H else
 if VarName='CL' then
  CurVarVal:=VARGB_CL else
 if VarName='CT' then
  CurVarVal:=VARGB_CT else
 if VarName='CR' then
  CurVarVal:=VARGB_CR else
 if VarName='CB' then
  CurVarVal:=VARGB_CB else
 if VarName='GlX' then
  CurVarVal:=VARGB_GlX else
 if VarName='GlY' then
  CurVarVal:=VARGB_GlY else
 if VarName='GlW' then
  CurVarVal:=VARGB_GlW else
 if VarName='GlH' then
  CurVarVal:=VARGB_GlH else
 if VarName='TL' then
  CurVarVal:=VARGB_TL else
 if VarName='TT' then
  CurVarVal:=VARGB_TT else
 if VarName='TR' then
  CurVarVal:=VARGB_TR else
 if VarName='TB' then
  CurVarVal:=VARGB_TB;
 if CurVarVal>=0 then
  begin
   if CurValList=nil then
    CurValList:=TList.Create;
   CurValList.Add(Pointer(CurVarVal));
  end;
end;

function TSXGroupBoxVariableComparer.GetValue(VarID:Integer):Integer;
begin
 Result:=0;
 if Control<>nil then
  begin
   case VarID of
    VARGB_W:   Result:=Control.Width;
    VARGB_H:   Result:=Control.Height;
    VARGB_CL:  Result:=Control.FCaptionRect.Left;
    VARGB_CT:  Result:=Control.FCaptionRect.Top;
    VARGB_CR:  Result:=Control.FCaptionRect.Right;
    VARGB_CB:  Result:=Control.FCaptionRect.Bottom;
    VARGB_GlX: Result:=Control.FGlyphRect.Left;
    VARGB_GlY: Result:=Control.FGlyphRect.Top;
    VARGB_GlW: Result:=Control.FGlyphRect.Right-Control.FGlyphRect.Left;
    VARGB_GlH: Result:=Control.FGlyphRect.Bottom-Control.FGlyphRect.Top;
    VARGB_TL:  Result:=Control.FTextRect.Left;
    VARGB_TT:  Result:=Control.FTextRect.Top;
    VARGB_TR:  Result:=Control.FTextRect.Right;
    VARGB_TB:  Result:=Control.FTextRect.Bottom;
   end;
  end;
end;

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

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

{ TSXSkinCustomGroupBox }

function TSXSkinCustomGroupBox.HasUnusualSkinStyle:Boolean;
begin
 Result:=SkinStyle<>'_GroupBox';
end;

procedure TSXSkinCustomGroupBox.SetAlignment(Value:TAlignment);
begin
 if Value<>FAlignment then
  begin
   FAlignment:=Value;
   if not (csLoading in ComponentState) then
    ResetGroupBoxParams([gbrpText]);
  end;
end;

procedure TSXSkinCustomGroupBox.SetCaptionAlignment(Value:TAlignment);
begin
 if Value<>FCaptionAlignment then
  begin