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 + -
显示快捷键?