ksskintabs.pas

来自「小区水费管理系统源代码水费收费管理系统 水费收费管理系统」· PAS 代码 · 共 469 行

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

  SkinEngine's TabControl & PageControl
  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: KsSkinTabs.pas,v 1.2 2002/10/28 21:04:21 Evgeny Exp $

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

unit KsSkinTabs;

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

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, se_controls, KsSkinVersion, KsSkinObjects, KsSkinSource,
  KsSkinEngine;

type

{ TSeSkinTabControl }

  TSeSkinTabControl = class(TSeCustomTabControl)
  private
    FSkinEngine: TSeSkinEngine;
    FSkinTabs: TSeSkinObject;
    FSkinObject: string;
    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 GetLeftMargin: integer; override;
    function GetTopMargin: integer; override;
    function GetRightMargin: integer; override;
    function GetBottomMargin: integer; override;
    function GetTabHeight: integer; override;

    procedure DrawTab(ATabIndex: integer); override;
    procedure DrawBorder; override;
    procedure DrawLeftScrlBtn; override;
    procedure DrawRightScrlBtn; override;
    { VCL protected  }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
  published
    { Link to TSeSkinEngine component. Specifies the appearance and behavior by using specified skins from TSeSkinEngine components
      See Also
        TSeSkinEngine
    }
    property SkinEngine: TSeSkinEngine read FSkinEngine write SetSkinEngine;
    { Specifies the SkinObject name, your can change default value to set custom skin object for the control
      For Example:
        For TSeSkinButton the SkinObject property set to 'Button', but your can use you own name - example 'My Button'
    }
    property SkinObject: string read FSkinObject write SetSkinObject;
    property Version: TSeSkinVersion read GetVersion write SetVersion
      stored false;
  end;

{ TSeSkinPageControl }

  TSeSkinPageControl = class(TSeSkinTabControl)
  private
    FUsePages: boolean;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property UsePages: boolean read FUsePages;
  end;

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

{ TSeSkinTabControl }

constructor TSeSkinTabControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSkinObject := 'Tabs';
end;

destructor TSeSkinTabControl.Destroy;
begin
  inherited Destroy;
end;

procedure TSeSkinTabControl.Loaded;
begin
  inherited Loaded;
  TabsChanged;
end;

function TSeSkinTabControl.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
       (FSkinTabs <> nil)
    then
      Result := true
    else
      Result := false;
end;

{ Inherited }

function TSeSkinTabControl.GetBottomMargin: integer;
var
  SkinObject: TSeSkinObject;
begin
  if not UseSkin then
    Result := inherited GetBottomMargin
  else
  begin
    SkinObject := FSkinTabs.FindObjectByName('Frame');
    if SkinObject <> nil then
      Result := SkinObject.MarginBottom;
  end;
end;

function TSeSkinTabControl.GetLeftMargin: integer;
var
  SkinObject: TSeSkinObject;
begin
  if not UseSkin then
    Result := inherited GetLeftMargin
  else
  begin
    SkinObject := FSkinTabs.FindObjectByName('Frame');
    if SkinObject <> nil then
      Result := SkinObject.MarginLeft;
  end;
end;

function TSeSkinTabControl.GetRightMargin: integer;
var
  SkinObject: TSeSkinObject;
begin
  if not UseSkin then
    Result := inherited GetRightMargin
  else
  begin
    SkinObject := FSkinTabs.FindObjectByName('Frame');
    if SkinObject <> nil then
      Result := SkinObject.MarginRight;
  end;
end;

function TSeSkinTabControl.GetTopMargin: integer;
var
  SkinObject: TSeSkinObject;
begin
  if not UseSkin then
    Result := inherited GetTopMargin
  else
  begin
    SkinObject := FSkinTabs.FindObjectByName('Frame');
    if SkinObject <> nil then
      Result := SkinObject.MarginTop;
  end;
end;

function TSeSkinTabControl.GetTabHeight: integer;
begin
  Result := inherited GetTabHeight;
end;

{ Drawing }

procedure TSeSkinTabControl.DrawBorder;
var
  R: TRect;
  SkinObject: TSeSkinObject;
begin
  if not UseSkin then
  begin
    inherited ;
    Exit;
  end;

  R := GetBorderRect;

  SkinObject := FSkinTabs.FindObjectByName('Frame');
  if SkinObject <> nil then
  begin
    SkinObject.BoundsRect := R;
    SkinOBject.Draw(Canvas);
  end
  else
    inherited ;
end;

procedure TSeSkinTabControl.DrawTab(ATabIndex: integer);
var
  R: TRect;
  SkinObject: TSeSkinObject;
  Index: integer;
begin
  if not UseSkin then
  begin
    inherited ;
    Exit;
  end;

  R := GetTabRect(ATabIndex);

  { Draw tab }
  if TabIndex <> ATabIndex then
    if TabPosition in [tpLeft, tpRight] then
      InflateRect(R, -GetLeftMargin, 0)
    else
      InflateRect(R, 0, -GetLeftMargin);

  case TabPosition of
    tpLeft: SkinObject := FSkinTabs.FindObjectByName('TabLeft');
    tpTop: SkinObject := FSkinTabs.FindObjectByName('TabTop');
    tpRight: SkinObject := FSkinTabs.FindObjectByName('TabRight');
    tpBottom: SkinObject := FSkinTabs.FindObjectByName('TabBottom');
  else
    SkinObject := nil;
  end;

  if SkinObject = nil then
    SkinObject := FSkinTabs.FindObjectByName('Tab');

  if SkinObject <> nil then
  begin
    { Set State }
    SkinObject.State := ssNormal;

    if MouseOnTabIndex = ATabIndex then
      SkinObject.State := ssHot
    else
      if ATabIndex = TabIndex then
        SkinObject.State := ssFocused;

    SkinObject.BoundsRect := R;
    SkinObject.Draw(Canvas);

    if FSkinTabs.FindObjectByName('Text') <> nil then
    begin
      FSkinTabs.FindObjectByName('Text').State := SkinObject.State; 
      Canvas.Font := FSkinTabs.FindObjectByName('Text').Font;
    end
    else
      Canvas.Font := SkinObject.Font;

    { Draw Glyph }
    if UsePages and (Images <> nil) then
    begin
      Index := GetPageIndexFromTabIndex(ATabIndex);
      if (Index >= 0) and (Index < Images.Count) then
      begin
        if Pages[Index].ImageIndex >= 0 then
        begin
          DrawTabGlyph(ATabIndex, TabPosition, R);
          { Change LRect for DrawText }
          case TabPosition of
            tpLeft, tpBottom: Dec(R.Bottom, GetTabHeight);
            tpTop: Inc(R.Left, GetTabHeight);
            tpRight: Inc(R.Top, GetTabHeight);
          end;
        end;
      end;
    end;

    { Draw Text }
    case TabPosition of
      tpLeft: begin
        R.Right := R.Left + GetTabHeight;
        DrawVerticalText(Canvas, Tabs[ATabIndex], R, DT_CENTER or DT_VCENTER or DT_SINGLELINE, false)
      end;
      tpTop: begin
        R.Bottom := R.Top + GetTabHeight;
        DrawText(Canvas, Tabs[ATabIndex], R, DT_CENTER or DT_VCENTER or DT_SINGLELINE)
      end;
      tpRight: begin
        R.Left := R.Right - GetTabHeight;
        DrawVerticalText(Canvas, Tabs[ATabIndex], R, DT_CENTER or DT_VCENTER or DT_SINGLELINE, true)
      end;
      tpBottom: begin
        R.Top := R.Bottom - GetTabHeight;
        DrawText(Canvas, Tabs[ATabIndex], R, DT_CENTER or DT_VCENTER or DT_SINGLELINE)
      end;
    end;
  end;
end;

procedure TSeSkinTabControl.DrawLeftScrlBtn;
var
  R: TRect;
  State: TSeState;
  SkinObject: TSeSkinObject;
begin
  if not GetScrlBtnsVisible then Exit;

  if UseSkin then
  begin
    R := GetLeftScrlBtnRect;

    if LeftBtnPressed then
      State := ssPressed
    else
      if MouseOnLeftBtn then
        State := ssHot
      else
        State := ssNormal;

    SkinObject := FSkinTabs.FindObjectByName('LeftButton');
    if SkinObject <> nil then
    begin
      SkinObject.BoundsRect := R;
      SkinObject.State := State;
      SkinObject.Draw(Canvas);
    end
    else
      inherited;
  end
  else
    inherited;
end;

procedure TSeSkinTabControl.DrawRightScrlBtn;
var
  R: TRect;
  State: TSeState;
  SkinObject: TSeSkinObject;
begin
  if not GetScrlBtnsVisible then Exit;

  if UseSkin then
  begin
    R := GetRightScrlBtnRect;

    if RightBtnPressed then
      State := ssPressed
    else
      if MouseOnRightBtn then
        State := ssHot
      else
        State := ssNormal;

    SkinObject := FSkinTabs.FindObjectByName('RightButton');
    if SkinObject <> nil then
    begin
      SkinObject.BoundsRect := R;
      SkinObject.State := State;
      SkinObject.Draw(Canvas);
    end
    else
      inherited;
  end
  else
    inherited;
end;

{ Skins }

procedure TSeSkinTabControl.WMInvalidateSkinObject(var Msg: TMessage);
begin
  Invalidate;
end;

procedure TSeSkinTabControl.WMBeforeChange(var Msg: TMessage);
begin
  if Pointer(Msg.LParam) = nil then Exit;
  if TSeSkinEngine(Msg.LParam) <> FSkinEngine then Exit;

  if FSkinTabs <> nil then FSkinTabs.Free;
  FSkinTabs := nil;
end;

procedure TSeSkinTabControl.WMSkinChange(var Msg: TMessage);
begin
  if Pointer(Msg.LParam) = nil then Exit;
  if TSeSkinEngine(Msg.LParam) <> FSkinEngine then Exit;

  SkinEngine := FSkinEngine;

  if UsePages and (ActivePageIndex >= 0) and (ActivePageIndex < PageCount) then
    Pages[ActivePageIndex].Invalidate;
end;

procedure TSeSkinTabControl.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FSkinEngine) then
    SkinEngine := nil;
end;

{ Properties }

function TSeSkinTabControl.GetVersion: TSeSkinVersion;
begin
  Result := sSeSkinVersion;
end;

procedure TSeSkinTabControl.SetVersion(const Value: TSeSkinVersion);
begin
end;

procedure TSeSkinTabControl.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 FSkinTabs <> nil then FSkinTabs.Free;
    FSkinTabs := nil;

    if FSkinEngine.SkinSource.GetObjectByName(FSkinObject) <> nil then
      FSkinTabs := FSkinEngine.SkinSource.GetObjectByName(FSkinObject).CreateCopy(nil);

    if FSkinTabs <> nil then
      FSkinTabs.ParentControl := Self;
  end
  else
  begin
    if FSkinTabs <> nil then FSkinTabs.Free;
    FSkinTabs := nil;
  end;

  Invalidate;
end;

procedure TSeSkinTabControl.SetSkinObject(const Value: string);
begin
  FSkinObject := Value;
end;

{ TSeSkinPageControl }

constructor TSeSkinPageControl.Create(AOwner: TComponent);
begin
  inherited;

  inherited UsePages := true;
end;

end.