ksskinobjects2.pas

来自「小区水费管理系统源代码水费收费管理系统 水费收费管理系统」· PAS 代码 · 共 1,638 行 · 第 1/3 页

{==============================================================================

  SkinEngine's Objects
  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: KsSkinObjects2.pas,v 1.3 2002/10/28 21:04:21 Evgeny Exp $

===============================================================================}

unit KsSkinObjects2;

{$I se_define.inc}
{$T-,W-,X+,P+}

interface

uses Windows, Classes, Sysutils, Messages, Controls, Graphics, Forms,
  se_controls, KsSkinObjects;

type

{ TSeLinkSkinObject class }

  TSeLinkSkinObject = class(TSeSkinObject)
  private
    FLinkControl: string;
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Assign, Copy }
    procedure Assign(Source: TPersistent); override;
    { Drawing }
    procedure Draw(Canvas: TCanvas); override;
    { Events }
    procedure MouseHover; override;
    procedure MouseLeave; override;
  published
    { Specifies the linked VCL control by name }
    property LinkControl: string read FLinkControl write FLinkControl;
  end;

{ TSeActiveSkinObject class }

  TSeActiveSkinObject = class(TSeSkinObject)
  private
    FActiveColor: TColor;
    FActiveFont: TFont;
    procedure SetActiveFont(const Value: TFont);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Assign, Copy }
    procedure Assign(Source: TPersistent); override;
    { Drawing }
    procedure Draw(Canvas: TCanvas); override;
    { Colors }
    procedure ChangeHue(DeltaHue: integer); override;
    { Events }
    procedure MouseHover; override;
    procedure MouseLeave; override;
  published
    { Specifies the color in ssActive state }
    property ActiveColor: TColor read FActiveColor write FActiveColor;
    { Specifies the font in ssActive state }
    property ActiveFont: TFont read FActiveFont write SetActiveFont;
  end;

{ TSeBitmapSkinObject class }

  { The following table lists the possible values:
    <TABLE>
    Value                       Meaning
    -----                       -------
    tsTile                      Bitmap tile on the object
    tsStretch                   Bitmap stretch by object size
    tsCenter                    Bitmap centered
    </TABLE>
  }
  TscTileStyle = (tsTile, tsStretch, tsCenter);

  TSeBitmapSkinObject = class(TSeSkinObject)
  private
    FBitmap: TSeBitmapLink;
    FTileStyle: TscTileStyle;
    procedure SetBitmap(const Value: TSeBitmapLink);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AfterLoad; override;
    { Assign, Copy }
    procedure Assign(Source: TPersistent); override;
    { Drawing }
    procedure Draw(Canvas: TCanvas); override;
    { Region }
    function CreateRegion: HRgn; override;
    { Events }
    procedure MouseHover; override;
    procedure MouseLeave; override;
  published
    { Specifies the object's bitmap }
    property Bitmap: TSeBitmapLink read FBitmap write SetBitmap;
    { Specifies the dysplay tile style }
    property TileStyle: TscTileStyle read FTileStyle write FTileStyle;
  end;

{ TSeFormBitmapSkinObject class }

  TSeFormBitmapSkinObject = class(TSeBitmapSkinObject)
  private
    FInactiveBitmap: TSeBitmapLink;
    procedure SetInactiveBitmap(const Value: TSeBitmapLink);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AfterLoad; override;
    { Assign, Copy }
    procedure Assign(Source: TPersistent); override;
    { Drawing }
    procedure Draw(Canvas: TCanvas); override;
    { Events }
    procedure MouseHover; override;
    procedure MouseLeave; override;
  published
    { Specifies the bitmap in ssInactive state }
    property InactiveBitmap: TSeBitmapLink read FInactiveBitmap write SetInactiveBitmap;
  end;

{ TSeSysButtonSkinObject class }

  TSeSysButtonSkinObject = class(TSeBitmapSkinObject)
  private
    FAction: TSeAction;
    FBitmapDown: TSeBitmapLink;
    FBitmapHover: TSeBitmapLink;
    FButtonState: TSeButtonState;
    FShift: TShiftState;
    FRollPanel: string;
    procedure DoAction;
    
    procedure SetAction(const Value: TSeAction);
    procedure SetBitmapDown(const Value: TSeBitmapLink);
    procedure SetBitmapHover(const Value: TSeBitmapLink);
  protected
    procedure SetState(const Value: TSeState); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AfterLoad; override;
    { Assign, Copy }
    procedure Assign(Source: TPersistent); override;
    { Drawing }
    procedure Draw(Canvas: TCanvas); override;
    { Events }
    procedure MouseHover; override;
    procedure MouseLeave; override;
    procedure MouseDown(Button: TMouseButton; X, Y: integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
    procedure MouseUp(Button: TMouseButton; X, Y: integer); override;
    procedure MouseDouble(Button: TMouseButton; X, Y: integer); override;
  published
    { Specifies the click action }
    property Action: TSeAction read FAction write SetAction;
    { Specifies bitmap in ssHot state }
    property BitmapHover: TSeBitmapLink read FBitmapHover write SetBitmapHover;
    { Specifies bitmap in ssPressed state }
    property BitmapDown: TSeBitmapLink read FBitmapDown write SetBitmapDown;
    { Specifies the name og RollPanel, use id Action = ssRollPanel }
    property RollPanel: string read FRollPanel write FRollPanel;
  end;

{ TSeColorButtonObject class }

  TSeColorButtonObject = class(TSeSkinObject)
  private
    FHotColor: TColor;
    FHotFont: TFont;
    FPressedColor: TColor;
    FFocusedColor: TColor;
    FDisabledColor: TColor;
    FPressedFont: TFont;
    FDisabledFont: TFont;
    FFocusedFont: TFont;
    procedure SetDisabledColor(const Value: TColor);
    procedure SetDisabledFont(const Value: TFont);
    procedure SetFocusedColor(const Value: TColor);
    procedure SetFocusedFont(const Value: TFont);
    procedure SetHotColor(const Value: TColor);
    procedure SetHotFont(const Value: TFont);
    procedure SetPressedColor(const Value: TColor);
    procedure SetPressedFont(const Value: TFont);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Assign, Copy }
    procedure Assign(Source: TPersistent); override;
    { Drawing }
    procedure Draw(Canvas: TCanvas); override;
    { Events }
    procedure MouseHover; override;
    procedure MouseLeave; override;
  published
    { Specifies the color is ssHot state }
    property HotColor: TColor read FHotColor write SetHotColor;
    { Specifies the font is ssHot state }
    property HotFont: TFont read FHotFont write SetHotFont;
    { Specifies the color is ssPressed state }
    property PressedColor: TColor read FPressedColor write SetPressedColor;
    { Specifies the font is ssPressed state }
    property PressedFont: TFont read FPressedFont write SetPressedFont;
    { Specifies the color is ssFocused state }
    property FocusedColor: TColor read FFocusedColor write SetFocusedColor;
    { Specifies the font is ssFocused state }
    property FocusedFont: TFont read FFocusedFont write SetFocusedFont;
    { Specifies the color is ssDisabled state }
    property DisabledColor: TColor read FDisabledColor write SetDisabledColor;
    { Specifies the font is ssDisabled state }
    property DisabledFont: TFont read FDisabledFont write SetDisabledFont;
  end;

{ TSeBitmapBoxObject class }

  TSeBitmapBoxObject = class(TSeBitmapSkinObject)
  private
    FBorderTileStyle: TscTileStyle;
    procedure SetBorderTileStyle(const Value: TscTileStyle);
  protected
    procedure DrawRect(Canvas: TCanvas; MarginRect, MarginDstRect: TRect;
      ATileStyle: TscTileStyle);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Assign, Copy }
    procedure Assign(Source: TPersistent); override;
    { Drawing }
    procedure Draw(Canvas: TCanvas); override;
    { Events }
    procedure MouseHover; override;
    procedure MouseLeave; override;
  published
    { Specifies the border tile style }
    property BorderTileStyle: TscTileStyle read FBorderTileStyle write SetBorderTileStyle;
  end;

{ TSeActiveBitmapBoxObject class }

  TSeActiveBitmapBoxObject = class(TSeBitmapBoxObject)
  private
    FFocusedBitmap: TSeBitmapLink;
    procedure SetFocusedBitmap(const Value: TSeBitmapLink);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AfterLoad; override;
    { Assign, Copy }
    procedure Assign(Source: TPersistent); override;
    { Drawing }
    procedure Draw(Canvas: TCanvas); override;
  published
    { Specifies the bitmap in ssFocused state }
    property FocusedBitmap: TSeBitmapLink read FFocusedBitmap write SetFocusedBitmap;
  end;

{ TSeButtonBitmapBoxObject class }

  TSeButtonBitmapBoxObject = class(TSeBitmapBoxObject)
  private
    FFocusedBitmap: TSeBitmapLink;
    FHotBitmap: TSeBitmapLink;
    FPressedBitmap: TSeBitmapLink;
    FDisabledBitmap: TSeBitmapLink;
    procedure SetFocusedBitmap(const Value: TSeBitmapLink);
    procedure SetDisabledBitmap(const Value: TSeBitmapLink);
    procedure SetHotBitmap(const Value: TSeBitmapLink);
    procedure SetPressedBitmap(const Value: TSeBitmapLink);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AfterLoad; override;
    { Assign, Copy }
    procedure Assign(Source: TPersistent); override;
    { Drawing }
    procedure Draw(Canvas: TCanvas); override;
  published
    { Specifies the bitmap in ssHot state }
    property HotBitmap: TSeBitmapLink read FHotBitmap write SetHotBitmap;
    { Specifies the bitmap in ssFocused state }
    property FocusedBitmap: TSeBitmapLink read FFocusedBitmap write SetFocusedBitmap;
    { Specifies the bitmap in ssPressed state }
    property PressedBitmap: TSeBitmapLink read FPressedBitmap write SetPressedBitmap;
    { Specifies the bitmap in ssDisabled state }
    property DisabledBitmap: TSeBitmapLink read FDisabledBitmap write SetDisabledBitmap;
  end;

{ TSeRollPanelObject class }

  TSeRollPanelObject = class(TSeSkinObject)
  private
    FRollValue: integer;
    FRollKind: TSeRollKind;
    FOldValue: integer;
    procedure OwnerUpdate;
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Assign, Copy }
    procedure Assign(Source: TPersistent); override;
    { Roll }
    procedure Roll;
  published
    { Specifies the roll direction }
    property RollKind: TSeRollKind read FRollKind write FRollKind;
    { Specifies the value of width (or height) in rolled state }
    property RollValue: integer read FRollValue write FRollValue;
  end;

{ Registration }

implementation {===============================================================}

uses KsSkinForms;

{ TSeLinkSkinObject ===========================================================}

constructor TSeLinkSkinObject.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

destructor TSeLinkSkinObject.Destroy;
begin
  inherited Destroy;
end;

procedure TSeLinkSkinObject.Assign(Source: TPersistent);
begin
  if Source is TSeLinkSkinObject then
  begin
    inherited Assign(Source);
    FLinkControl := (Source as TSeLinkSkinObject).FLinkControl;
  end
  else
    inherited;
end;

procedure TSeLinkSkinObject.Draw(Canvas: TCanvas);
var
  R: TRect;
begin
  if State <> ssDesign then Exit;
  
  if Width <= 0 then Exit;
  if Height <= 0 then Exit;
  
  FillRect(Canvas, BoundsRect, clWhite);
  DrawRect(Canvas, BoundsRect, clBlack);

  Canvas.Font.Name := 'Arial';
  Canvas.Font.Style := [fsItalic];
  Canvas.Font.Color := clBlack;
  R := BoundsRect;
  DrawText(Canvas, FLinkControl, R, DT_CENTER or DT_SINGLELINE or DT_VCENTER);
end;

procedure TSeLinkSkinObject.MouseHover;
begin
  inherited;

end;

procedure TSeLinkSkinObject.MouseLeave;
begin
  inherited;

end;

{ TSeBitmapSkinObject =========================================================}

constructor TSeBitmapSkinObject.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FBitmap := TSeBitmapLink.Create;
end;

destructor TSeBitmapSkinObject.Destroy;
begin
  FBitmap.Free;
  inherited Destroy;
end;

procedure TSeBitmapSkinObject.AfterLoad;
var
  NewLink: TSeBitmapLink;
begin
  inherited AfterLoad;
  if Bitmaps <> nil then
  begin
    NewLink := Bitmaps.GetBitmapLink(FBitmap.Name, FBitmap.Rect);
    if NewLink <> nil then
    begin
      FBitmap.Free;
      FBitmap := NewLink;
    end;
  end;
end;

procedure TSeBitmapSkinObject.Assign(Source: TPersistent);
begin
  if Source is TSeBitmapSkinObject then
  begin
    inherited Assign(Source);
    Bitmap := (Source as TSeBitmapSkinObject).Bitmap;
    FTileStyle := (Source as TSeBitmapSkinObject).FTileStyle;
  end
  else
    inherited;
end;

procedure TSeBitmapSkinObject.Draw(Canvas: TCanvas);
var
  DstRect, R: TRect;
  i, j: integer;
  W, H: integer;
  DW, DH: integer;
begin
  if not FBitmap.Assigned then Exit;
  if Width <= 0 then Exit;
  if Height <= 0 then Exit;

  case FTileStyle of
    tsTile: begin
      FBitmap.Bitmap.DrawTile(Canvas, BoundsRect, FBitmap.Rect, Masked);
    end;
    tsStretch: begin
      FBitmap.Bitmap.Draw(Canvas, BoundsRect, FBitmap.Rect, Masked);
    end;
    tsCenter: begin
      R := BoundsRect;
      FBitmap.Bitmap.Draw(Canvas, Left + (Width - RectWidth(R)) div 2,
        Top + (Height - RectHeight(R)) div 2, FBitmap.Rect, Masked);
    end;
  end;

  DrawObjectText(Canvas);
end;

function TSeBitmapSkinObject.CreateRegion: HRgn;
var
  TempImage: TSeBitmap;
  TempCanvas: TCanvas;
  SaveRect: TRect;
begin
  if not FBitmap.Assigned then Exit;
  if Width <= 0 then Exit;
  if Height <= 0 then Exit;
  if Kind = skClient then
  begin
    Result := CreateRectRgn(Left, Top, Left + Width, Top + Height);
    Exit;
  end;

  { Make mask from bitmap }
  SaveRect := BoundsRect;
  try
    { Set new rect }
    BoundsRect := Rect(0, 0, Width, Height);
    { Draw to TempImage }
    TempImage := TSeBitmap.Create;
    try
      TempImage.SetSize(Width, Height);
      TempImage.Clear(ckTransparent);
      { Draw to Temp }
      TempCanvas := TCanvas.Create;
      TempCanvas.Handle := TempImage.DC;
      Draw(TempCanvas);
      TempCanvas.Handle := 0;
      TempCanvas.Free;
      { Create region }
      Result := CreateRegionFromBitmap(TempImage, SaveRect.Left, SaveRect.Top);
    finally
      TempImage.Free;
    end;
  finally
    BoundsRect := SaveRect;
  end;
end;

procedure TSeBitmapSkinObject.MouseHover;
begin
end;

procedure TSeBitmapSkinObject.MouseLeave;
begin
end;

procedure TSeBitmapSkinObject.SetBitmap(const Value: TSeBitmapLink);
begin
  FBitmap.Assign(Value);
end;

{ TSeFormBitmapSkinObject }

constructor TSeFormBitmapSkinObject.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FInactiveBitmap := TSeBitmapLink.Create;
end;

destructor TSeFormBitmapSkinObject.Destroy;
begin
  FInactiveBitmap.Free;
  inherited Destroy;
end;

procedure TSeFormBitmapSkinObject.AfterLoad;
var
  NewLink: TSeBitmapLink;
begin
  inherited AfterLoad;
  if Bitmaps <> nil then
  begin
    NewLink := Bitmaps.GetBitmapLink(FInactiveBitmap.Name, FInactiveBitmap.Rect);
    if NewLink <> nil then
    begin
      FInactiveBitmap.Free;
      FInactiveBitmap := NewLink;
    end;
  end;
end;

procedure TSeFormBitmapSkinObject.Assign(Source: TPersistent);
begin