⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 sxskinradiobutton.pas

📁 skin components for design of your applicastions
💻 PAS
📖 第 1 页 / 共 4 页
字号:
unit SXSkinRadioButton;

////////////////////////////////////////////////////////////////////////////////
// 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: sxskincomponents@saarixx.info                                      //
//----------------------------------------------------------------------------//
// 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

 VARRB_W   =  1;
 VARRB_H   =  2;
 VARRB_GlX =  3;
 VARRB_GlY =  4;
 VARRB_GlW =  5;
 VARRB_GlH =  6;
 VARRB_TL  =  7;
 VARRB_TT  =  8;
 VARRB_TR  =  9;
 VARRB_TB  = 10;

type

 TSXSkinCustomRadioButton=class;

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

 TSXSkinRadioButtonResetParam=(rbrpText,
                               rbrpTextOnFontChange,
                               rbrpTextIfWordWrap,
                               rbrpGlyph,
                               rbrpGlyphOnStyleChange,
                               rbrpGlyphOnSizeChange,
                               rbrpInvalidateOnStyleChange);

 TSXSkinRadioButtonResetParams=set of TSXSkinRadioButtonResetParam;

 TSXSkinRadioButtonTransform=(cbtRadioButton,cbtGlyph);

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

 TSXSkinCustomRadioButton=class(TSXSkinCustomControl)
  private
   FGlyphPosition:TSXGlyphPosition;
   FAutoSizeWidth:Boolean;
   FAutoSizeHeight:Boolean;
   FAutoAlignFirstLine:Boolean;
   FChecked:Boolean;
   FWordWrap:Boolean;
   FTextOffset:Integer;
   FAlignment:TAlignment;
   FVerticalAlignment:TVerticalAlignment;
   FOnChange:TNotifyEvent;
   FOnUserModified:TNotifyEvent;
   FOnMouseEnter:TNotifyEvent;
   FOnMouseLeave:TNotifyEvent;
   FMouseOver:Boolean;
   FDown:Boolean;
   FThread:TSXSkinCustomRadioButtonThread;
   //
   FLastRadioButtonTransform:TSXTransformEffectData;
   FLastGlyphTransform:TSXTransformEffectData;
   FDoneSteps:Integer;
   FLastGlyph:TBitmap32;
   FLastRadioButton:TBitmap32;
   //
   FGlyphRect:TRect;
   FGlyphWidth:Integer;
   FGlyphHeight:Integer;
   FTextRect:TRect;
   FLastFocused:Boolean;
   FTextBitmap:TBitmap32;
   FLastFontData:TSXFontData;
   FLastStyle:String;
   FLastOverStyle:String;
   FLastGlyphStyle:String;
   FLastTextLeftOffset:Integer;
   FLastTextTopOffset:Integer;
   FLastTextRightOffset:Integer;
   FLastTextBottomOffset:Integer;
   //
   CEID_Back:Integer;
   CEID_Glyph:Integer;
   VComparer:TSXRadioButtonVariableComparer;
   procedure SetCaption(const Value:TCaption);
   procedure SetAutoAlignFirstLine(Value:Boolean);
   procedure SetAlignment(Value:TAlignment);
   procedure SetVerticalAlignment(Value:TVerticalAlignment);
   procedure SetGlyphPosition(Value:TSXGlyphPosition);
   procedure SetAutoSizeWidth(Value:Boolean);
   procedure SetAutoSizeHeight(Value:Boolean);
   procedure SetChecked(Value:Boolean);
   procedure SetWordWrap(Value:Boolean);
   procedure SetTextOffset(Value:Integer);
   function HasUnusualSkinStyle:Boolean;
   function OnGetVariable(const VarName:String;var Error:Boolean):Single;
   procedure GetCurrentRBState(var RBState:TSXSkinRadioButtonStateParam);
   function CreateCurrentGlyph:TBitmap32;
   function CreateCurrentBlendedGlyph:TBitmap32;
   procedure DoThreadActions;
   procedure StartGlyphChanging(T:TSXGlyphChangeAction);
   procedure CreateThreadIfNeeded;
   procedure ResetRadioButtonParams(Params:TSXSkinRadioButtonResetParams=[]);
   procedure CMFontChanged(var Message:TMessage); message CM_FONTCHANGED;
   procedure InvalidateGlyph;
   procedure GetCurrentTransformEffect(T:TSXSkinRadioButtonTransform;
              Action:TSXGlyphChangeAction;var Effect:TSXTransformEffectData);
   procedure InternalMouseEnter;
   procedure InternalMouseLeave;
  protected
   function CapturesMouseAt(X,Y:Integer):Boolean; override;
   procedure SetEnabled(Value:Boolean); override;
   procedure Loaded; override;
   procedure InternalSetBounds(ALeft,ATop,AWidth,AHeight:Integer);
   function GetCaption:TCaption;
   procedure DoClick;
   procedure MouseLeave; 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 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 PaintCurrentCBStyle(Bitmap:TBitmap32;X,Y:Integer;Rect:TRect;Rgn:HRGN);
   procedure PaintCurrentBlendedCBStyle(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 gpLeftTop;
   property TextOffset:Integer read FTextOffset write SetTextOffset default 2;
   property WordWrap:Boolean read FWordWrap write SetWordWrap default False;
   property AutoSizeWidth:Boolean read FAutoSizeWidth write SetAutoSizeWidth default True;
   property AutoSizeHeight:Boolean read FAutoSizeHeight write SetAutoSizeHeight default True;
   property AutoAlignFirstLine:Boolean read FAutoAlignFirstLine write SetAutoAlignFirstLine default True;
   property Alignment:TAlignment read FAlignment write SetAlignment default taLeftJustify;
   property VerticalAlignment:TVerticalAlignment read FVerticalAlignment write SetVerticalAlignment default taAlignTop;
   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 SetBounds(ALeft,ATop,AWidth,AHeight:Integer); override;
   procedure SkinChanged; override;
   procedure Click; reintroduce;
   constructor Create(AOwner:TComponent); override;
   destructor Destroy; override;
  published
   property Checked:Boolean read FChecked write SetChecked default False;
   property TabStop default True;
   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;

 TSXSkinRadioButton=class(TSXSkinCustomRadioButton)
  published
   property Align;
   property Alignment;
   property Anchors;
   property AutoAlignFirstLine;
   property AutoSizeWidth;
   property AutoSizeHeight;
   property Caption;
   property Checked;
   property Color;
   property Constraints;
   property Cursor;
   property DragCursor;
   property Enabled;
   property Font;
   property GlyphPosition;
   //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 VerticalAlignment;
   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, SXSkinGroupBox;

{ TSXSkinCustomRadioButtonThread }

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

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

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

{ TSXRadioButtonVariableComparer }

function TSXRadioButtonVariableComparer.VarListOnGetVariable(const VarName:String;var Error:Boolean):Single;
var CurVarVal:Integer;
begin
 Result:=1234;
 CurVarVal:=-1;
 if VarName='W' then
  CurVarVal:=VARRB_W else
 if VarName='H' then
  CurVarVal:=VARRB_H else
 if VarName='GlX' then
  CurVarVal:=VARRB_GlX else
 if VarName='GlY' then
  CurVarVal:=VARRB_GlY else
 if VarName='GlW' then
  CurVarVal:=VARRB_GlW else
 if VarName='GlH' then
  CurVarVal:=VARRB_GlH else
 if VarName='TL' then
  CurVarVal:=VARRB_TL else
 if VarName='TT' then
  CurVarVal:=VARRB_TT else
 if VarName='TR' then
  CurVarVal:=VARRB_TR else
 if VarName='TB' then
  CurVarVal:=VARRB_TB;
 if CurVarVal>=0 then
  begin
   if CurValList=nil then
    CurValList:=TList.Create;
   CurValList.Add(Pointer(CurVarVal));
  end;
end;

function TSXRadioButtonVariableComparer.GetValue(VarID:Integer):Integer;
begin
 Result:=0;
 if Control<>nil then
  begin
   case VarID of
    VARRB_W:   Result:=Control.Width;
    VARRB_H:   Result:=Control.Height;
    VARRB_GlX: Result:=Control.FGlyphRect.Left;
    VARRB_GlY: Result:=Control.FGlyphRect.Top;
    VARRB_GlW: Result:=Control.FGlyphWidth;
    VARRB_GlH: Result:=Control.FGlyphHeight;
    VARRB_TL:  Result:=Control.FTextRect.Left;
    VARRB_TT:  Result:=Control.FTextRect.Top;
    VARRB_TR:  Result:=Control.FTextRect.Right;
    VARRB_TB:  Result:=Control.FTextRect.Bottom;
   end;
  end;
end;

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

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

{ TSXSkinCustomRadioButton }

function TSXSkinCustomRadioButton.HasUnusualSkinStyle:Boolean;
begin
 Result:=SkinStyle<>'_RadioButton';
end;

procedure TSXSkinCustomRadioButton.SetEnabled(Value:Boolean);
begin
 if Enabled<>Value then
  begin
   if not (csLoading in ComponentState) then
    begin
     if Enabled then
      StartGlyphChanging(gcaDisable) else
       StartGlyphChanging(gcaEnable);
    end;
   inherited;
   if not Enabled then
    begin
     FMouseOver:=False;
     FDown:=False;
    end;   

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -