ksskingroupboxs.pas
来自「小区水费管理系统源代码水费收费管理系统 水费收费管理系统」· PAS 代码 · 共 568 行 · 第 1/2 页
PAS
568 行
{==============================================================================
SkinEngine's GroupBox
Copyright (C) 2000-2002 by Evgeny Kryukov
All rights reserved
All conTeThements of this file and all other files included in this archive
are Copyright (C) 2002 Evgeny Kryukov. Use and/or distribution of
them requires acceptance of the License Agreement.
See License.txt for licence information
$Id: KsSkinGroupBoxs.pas,v 1.4 2002/10/29 02:41:19 Evgeny Exp $
===============================================================================}
unit KsSkinGroupBoxs;
{$I se_define.inc}
{$T-,W-,X+,P+}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
se_controls, KsSkinVersion, KsSkinObjects, KsSkinSource, KsSkinEngine;
type
{ TSeSkinGroupBox class }
TSeSkinGroupBox = class(TSeCustomGroupBox)
private
FSkinEngine: TSeSkinEngine;
FSkinObject: string;
FSkinGroupBox: TseSkinObject;
function GetVersion: TSeSkinVersion;
procedure SetVersion(const Value: TSeSkinVersion);
procedure SetSkinEngine(const Value: TSeSkinEngine);
procedure SetSkinObject(const Value: string);
protected
procedure WMInvalidateSkinObject(var Msg: TMessage); message WM_INVALIDATESKINOBJECT;
procedure WMBeforeChange(var Msg: TMessage); message WM_BEFORECHANGE;
procedure WMSkinChange(var Msg: TMessage); message WM_SKINCHANGE;
function UseSkin: boolean;
{ Inherited }
function CreateCheckBox(AOwner: TComponent): TSeCustomCheckBox; override;
procedure PaintBuffer; override;
{ VCL protected }
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Loaded; override;
published
property Anchors;
property Align;
property Caption;
property CaptionMargin;
property Font;
property SkinEngine: TSeSkinEngine read FSkinEngine write SetSkinEngine;
property SkinObject: string read FSkinObject write SetSkinObject;
property Transparent;
property Version: TSeSkinVersion read GetVersion write SetVersion
stored False;
end;
{ TSeSkinRadioGroup }
TSeSkinRadioGroup = class(TSeSkinGroupBox)
private
FButtons: TList;
FItems: TStrings;
FItemIndex: Integer;
FColumns: Integer;
FReading: Boolean;
FUpdating: Boolean;
procedure ArrangeButtons;
procedure ButtonClick(Sender: TObject);
procedure ItemsChange(Sender: TObject);
procedure SetButtonCount(Value: Integer);
procedure SetColumns(Value: Integer);
procedure SetItemIndex(Value: Integer);
procedure SetItems(Value: TStrings);
procedure UpdateButtons;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
protected
procedure WMSkinChange(var Msg: TMessage); message WM_SKINCHANGE;
{ VCL }
procedure Loaded; override;
procedure ReadState(Reader: TReader); override;
function CanModify: Boolean; virtual;
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure FlipChildren(AllLevels: Boolean); override;
published
property Columns: Integer read FColumns write SetColumns default 1;
property ItemIndex: Integer read FItemIndex write SetItemIndex default -1;
property Items: TStrings read FItems write SetItems;
end;
implementation {===============================================================}
uses KsSkinCheckBoxs;
type
THackControl = class(TControl);
{ TSeSkinGroupBox }
constructor TSeSkinGroupBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Transparent := true;
FSkinObject := 'GroupBox';
end;
destructor TSeSkinGroupBox.Destroy;
begin
if FSkinGroupBox <> nil then FSkinGroupBox.Free;
inherited Destroy;
end;
procedure TSeSkinGroupBox.Loaded;
begin
inherited;
{ SkinEngine := FSkinEngine; }
end;
function TSeSkinGroupBox.UseSkin: boolean;
begin
if (csDestroying in ComponentState) or (csLoading in ComponentState) then
Result := false
else
if (FSkinEngine <> nil) and (FSkinEngine.SkinSource <> nil) and
(not FSkinEngine.SkinSource.IsChanging) and
(FSkinEngine.SkinSource.Count > 0) and
(FSkinEngine.SkinSource.GetObjectByName(FSkinObject) <> nil) and
(FSkinGroupBox <> nil)
then
Result := true
else
Result := false;
end;
function TSeSkinGroupBox.CreateCheckBox(AOwner: TComponent): TSeCustomCheckBox;
begin
Result := TSeSkinCheckBox.Create(AOwner);
TSeSkinCheckBox(Result).SkinEngine := SkinEngine;
end;
{ Drawing }
procedure TSeSkinGroupBox.PaintBuffer;
var
R, CaptionRect: TRect;
SkinObject: TSeSkinObject;
SaveIndex: integer;
begin
if not UseSkin then
inherited
else
begin
if not Transparent then
FillRect(Canvas, Rect(0, 0, FWidth, FHeight), THackControl(Parent).Color);
R := GetBoxRect;
if UseCheckBox then
CaptionRect := Rect(CaptionMargin, 0, CaptionMargin + CheckBox.Width, CheckBox.Height)
else
begin
CaptionRect := Rect(CaptionMargin, 0, CaptionMargin + TextWidth(Canvas, Caption), TextHeight(Canvas, Caption));
InflateRect(CaptionRect, 3, 0);
end;
{ Draw Frame }
SaveIndex := SaveDC(Canvas.Handle);
{ Exclude captionrect }
with CaptionRect do
ExcludeClipRect(Canvas.Handle, Left, Top, Right, Bottom);
SkinObject := FSkinGroupBox.FindObjectByName('Frame');
if SkinObject <> nil then
begin
SkinObject.BoundsRect := R;
SkinObject.Draw(Canvas);
end;
{ Restore DC }
RestoreDC(Canvas.Handle, SaveIndex);
{ Draw Caption }
SkinObject := FSkinGroupBox.FindObjectByName('Caption');
if SkinObject <> nil then
begin
Canvas.Font := SkinObject.Font;
SkinObject.BoundsRect := CaptionRect;
SkinObject.Draw(Canvas);
end;
{ Draw Text }
if not UseCheckBox then
DrawText(Canvas, Caption, CaptionRect, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
end;
end;
procedure TSeSkinGroupBox.WMInvalidateSkinObject(var Msg: TMessage);
begin
Invalidate;
end;
procedure TSeSkinGroupBox.WMBeforeChange(var Msg: TMessage);
begin
if Pointer(Msg.LParam) = nil then Exit;
if TSeSkinEngine(Msg.LParam) <> FSkinEngine then Exit;
if FSkinGroupBox <> nil then FSkinGroupBox.Free;
FSkinGroupBox := nil;
end;
procedure TSeSkinGroupBox.WMSkinChange(var Msg: TMessage);
begin
if Pointer(Msg.LParam) = nil then Exit;
if TSeSkinEngine(Msg.LParam) <> FSkinEngine then Exit;
SkinEngine := FSkinEngine;
end;
{ Properties }
function TSeSkinGroupBox.GetVersion: TSeSkinVersion;
begin
Result := sSeSkinVersion;
end;
procedure TSeSkinGroupBox.SetVersion(const Value: TSeSkinVersion);
begin
end;
procedure TSeSkinGroupBox.SetSkinEngine(const Value: TSeSkinEngine);
begin
FSkinEngine := Value;
if (FSkinEngine <> nil) and (FSkinEngine.SkinSource <> nil) and
(not FSkinEngine.SkinSource.IsChanging) and
(FSkinEngine.SkinSource.Count > 0) then
begin
if FSkinGroupBox <> nil then FSkinGroupBox.Free;
FSkinGroupBox := nil;
if FSkinEngine.SkinSource.GetObjectByName(FSkinObject) <> nil then
FSkinGroupBox := FSkinEngine.SkinSource.GetObjectByName(FSkinObject).CreateCopy(nil);
if FSkinGroupBox <> nil then
begin
FSkinGroupBox.ParentControl := Self;
{ Change transparent }
if FSkinGroupBox.FindObjectByName('Frame') <> nil then
if FSkinGroupBox.FindObjectByName('Frame') is TSeBitmapObject then
with TSeBitmapObject(FSkinGroupBox.FindObjectByName('Frame')) do
Transparent := Masked or MaskedBorder or MaskedAngles;
end;
end
else
begin
if FSkinGroupBox <> nil then FSkinGroupBox.Free;
FSkinGroupBox := nil;
end;
if CheckBox <> nil then
with (CheckBox as TSeSkinCheckBox) do
begin
SkinEngine := Self.SkinEngine;
AdjustCheckBounds;
end;
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?