suitabcontrol.pas

新颖按钮控件

////////////////////////////////////////////////////////////////////////////////
//
//
//  FileName    :   SUITabControl.pas
//  Creator     :   Shen Min
//  Date        :   2002-09-10
//  Comment     :
//
//  Copyright (c) 2002-2003 Sunisoft
//  http://www.sunisoft.com
//  Email: [e-mail]
//
////////////////////////////////////////////////////////////////////////////////

unit SUITabControl;

interface

uses Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, Forms, Graphics,
     Dialogs,
     SUIThemes;

const
    SUI_TABCONTROL_MAXTABS      = 64;

type
    TsuiTab = class;

    TTabActiveNotify = procedure (Sender : TObject; TabIndex : Integer) of object;

    TsuiTabControlTopPanel = class(TCustomPanel)
    private
        m_Tabs : TStrings;
        m_UIStyle : TsuiUIStyle;
        m_ActiveTab : String;
        m_InactiveTab : String;
        m_Line : String;
        m_TabIndex : Integer;
        m_LeftMargin : Integer;
        m_TabPos : array [0 .. SUI_TABCONTROL_MAXTABS - 1] of Integer;
        m_TabHeight : Integer;

        procedure OnTabsChange(Sender : TObject);
        procedure SetTabs(const Value: TStrings);
        procedure SetUIStyle(const Value: TsuiUIStyle);
        procedure SetLeftMargin(const Value: Integer);
        procedure SetTabIndex(const Value: Integer);
        procedure WMERASEBKGND(var Msg : TMessage); message WM_ERASEBKGND;

    protected
        m_TabControl : TsuiTab;

        procedure Paint(); override;
        procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

    public
        m_TabVisible : array [0 .. SUI_TABCONTROL_MAXTABS - 1] of Boolean;

        constructor Create(AOwner : TComponent; TabControl : TsuiTab); reintroduce;
        destructor Destroy(); override;

    published
        property UIStyle : TsuiUIStyle read m_UIStyle write SetUIStyle;
        property Tabs : TStrings read m_Tabs write SetTabs;
        property TabIndex : Integer read m_TabIndex write SetTabIndex;
        property LeftMargin : Integer read m_LeftMargin write SetLeftMargin;

    end;

    TsuiTab = class(TCustomPanel)
    private
        m_UIStyle : TsuiUIStyle;
        m_BorderColor : TColor;
        m_Font : TFont;
        m_OnTabActive : TTabActiveNotify;

        procedure SetUIStyle(const Value: TsuiUIStyle);
        procedure SetTabs(const Value: TStrings);
        function GetTabs() : TStrings;
        function GetLeftMargin: Integer;
        function GetTabIndex: Integer;
        procedure SetLeftMargin(const Value: Integer);
        procedure SetBorderColor(const Value: TColor);
        procedure SetFont(const Value: TFont);

    protected
        m_TopPanel : TsuiTabControlTopPanel;

        procedure Paint(); override;
        function CreateTopPanel() : TsuiTabControlTopPanel; virtual; abstract;
        procedure SetTabIndex(const Value: Integer); virtual;
        procedure BorderColorChanged(); virtual;

        property Tabs : TStrings read GetTabs write SetTabs;
        property TabIndex : Integer read GetTabIndex write SetTabIndex;
        procedure TabActive(TabIndex : Integer); virtual;

    public
        constructor Create(AOwner : TComponent); override;
        destructor Destroy(); override;

        procedure UpdateUIStyle(UIStyle : TsuiUIStyle); virtual;

        property DockManager;

    published
        property Align;
        property UIStyle : TsuiUIStyle read m_UIStyle write SetUIStyle;
        property LeftMargin : Integer read GetLeftMargin write SetLeftMargin;
        property BorderColor : TColor read m_BorderColor write SetBorderColor;
        property Color;
        property Font : TFont read m_Font write SetFont;
        property Visible;

        property Anchors;
        property BiDiMode;
        property Constraints;
        property UseDockManager default True;
        property DockSite;
        property DragCursor;
        property DragKind;
        property DragMode;
        property Enabled;
        property FullRepaint;
        property Locked;
        property ParentBiDiMode;
        property ParentColor;
        property ParentCtl3D;
        property ParentFont;
        property ParentShowHint;
        property PopupMenu;
        property ShowHint;
        property TabOrder;
        property TabStop;

        property OnCanResize;
        property OnClick;
        property OnConstrainedResize;
        property OnContextPopup;
        property OnDockDrop;
        property OnDockOver;
        property OnDblClick;
        property OnDragDrop;
        property OnDragOver;
        property OnEndDock;
        property OnEndDrag;
        property OnEnter;
        property OnExit;
        property OnGetSiteInfo;
        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;
        property OnResize;
        property OnStartDock;
        property OnStartDrag;
        property OnUnDock;
        property OnTabActive : TTabActiveNotify read m_OnTabActive write m_OnTabActive;

    end;


    TsuiTabControl = class(TsuiTab)
    protected
        function CreateTopPanel() : TsuiTabControlTopPanel; override;

    published
        property Tabs;
        property TabIndex;

    end;

implementation

uses SUIPublic;


{ TsuiTabControlTopPanel }

constructor TsuiTabControlTopPanel.Create(AOwner: TComponent; TabControl : TsuiTab);
var
    i : Integer;
begin
    inherited Create(AOwner);

    m_Tabs := TStringList.Create();
    (m_Tabs as TStringList).OnChange := OnTabsChange;
    m_Tabs.Add('Tab1');

    m_TabControl := TabControl;
    Caption := ' ';
    BevelInner := bvNone;
    BevelOuter := bvNone;
    BorderWidth := 0;
    Align := alTop;
    m_LeftMargin := 10;
    m_TabIndex := 0;

    for i := 0 to SUI_TABCONTROL_MAXTABS - 1 do
    begin
        m_TabPos[i] := -1;
        m_TabVisible[i] := true;
    end;
end;

destructor TsuiTabControlTopPanel.Destroy;
begin
    m_Tabs.Free();
    m_Tabs := nil;

    inherited;
end;

procedure TsuiTabControlTopPanel.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
    i : Integer;
    nLeft : Integer;
    nRight : Integer;
begin
    Repaint();
    inherited;

    nRight := m_LeftMargin;
    for i := 0 to SUI_TABCONTROL_MAXTABS do
    begin
        if m_TabPos[i] = -1 then
            break;

        nLeft := nRight;
        Inc(nRight, m_TabPos[i]);

        if (X < nRight) and (X > nLeft) and (Y > 0) and (Y < m_TabHeight) then
        begin
            TabIndex := i;
            break;
        end;
    end;
end;

procedure TsuiTabControlTopPanel.OnTabsChange(Sender: TObject);
begin
    Repaint();
end;

procedure TsuiTabControlTopPanel.Paint;
var
    Buf : TBitmap;
    ActiveBitmap : TBitmap;
    InactiveBitmap : TBitmap;
    LineBitmap : TBitmap;
    nLeft : Integer;
    nWidth : Integer;
    i : Integer;
    R : TRect;
begin
    Buf := TBitmap.Create();
    Buf.Width := Width;
    Buf.Height := Height;

    DoTrans(Buf.Canvas, m_TabControl);

    ActiveBitmap := TBitmap.Create();
    InactiveBitmap := TBitmap.Create();
    LineBitmap := TBitmap.Create();

    ActiveBitmap.LoadFromResourceName(
        hInstance,
        m_ActiveTab
    );
    ActiveBitmap.TransparentColor := clFuchsia;
    ActiveBitmap.Transparent := true;
    m_TabHeight := ActiveBitmap.Height;

    InactiveBitmap.LoadFromResourceName(
        hInstance,
        m_InactiveTab
    );
    InactiveBitmap.TransparentColor := clFuchsia;
    InactiveBitmap.Transparent := true;

    LineBitmap.LoadFromResourceName(
        hInstance,
        m_Line
    );

    Buf.Canvas.StretchDraw(
        Rect(1, InactiveBitmap.Height, Width - 1, InactiveBitmap.Height + LineBitmap.Height),
        LineBitmap
    );

    Buf.Canvas.Pen.Color := m_TabControl.BorderColor;
    Buf.Canvas.MoveTo(0, InactiveBitmap.Height);
    Buf.Canvas.LineTo(0, InactiveBitmap.Height + LineBitmap.Height);
    Buf.Canvas.MoveTo(Width - 1, InactiveBitmap.Height);
    Buf.Canvas.LineTo(Width - 1, InactiveBitmap.Height + LineBitmap.Height);

    LineBitmap.Free();

    nLeft := m_LeftMargin;

    Buf.Canvas.Font := m_TabControl.Font;

    for i := 0 to m_Tabs.Count - 1 do
    begin
        if not m_TabVisible[i] then
        begin
            m_TabPos[i] := 0;
            continue;
        end;

        if m_Tabs[i] <> '' then
            nWidth := Buf.Canvas.TextWidth(m_Tabs[i]) + 20
        else
            nWidth := 80;
        if nWidth < 15 then
            nWidth := 15;
        if i < SUI_TABCONTROL_MAXTABS - 1 then
            m_TabPos[i] := nWidth;

        if m_TabIndex = i then
        begin
            R := Rect(nLeft, 1, nWidth + nLeft, InactiveBitmap.Height + 1);
            SpitDrawHorizontal(ActiveBitmap, Buf.Canvas, R, true);
        end
        else
        begin
            R := Rect(nLeft, 0, nWidth + nLeft, InactiveBitmap.Height);
            SpitDrawHorizontal(InactiveBitmap, Buf.Canvas, R, true);
        end;

        Inc(nLeft, nWidth);
        Buf.Canvas.Brush.Style := bsClear;
        DrawText(Buf.Canvas.Handle, PAnsiChar(m_Tabs[i]), -1, R, DT_CENTER or DT_SINGLELINE or DT_VCENTER);
    end;

    InactiveBitmap.Free();
    ActiveBitmap.Free();

    BitBlt(Canvas.Handle, 0, 0, Buf.Width, Buf.Height, Buf.Canvas.Handle, 0, 0, SRCCOPY);

    Buf.Free();
end;

procedure TsuiTabControlTopPanel.SetLeftMargin(const Value: Integer);
begin
    m_LeftMargin := Value;

    Repaint();
end;

procedure TsuiTabControlTopPanel.SetTabIndex(const Value: Integer);
begin
    if m_Tabs.Count = 0 then
    begin
        m_TabIndex := -1;
        Repaint();
        Exit;
    end;

    if (
        (Value < -1) or
        (Value > m_Tabs.Count -1)
    ) then
    begin
        Repaint();
        Exit;
    end;

    m_TabIndex := Value;
    Repaint();

    m_TabControl.TabActive(m_TabIndex);
end;

procedure TsuiTabControlTopPanel.SetTabs(const Value: TStrings);
begin
    m_Tabs.Assign(Value);
end;

procedure TsuiTabControlTopPanel.SetUIStyle(const Value: TsuiUIStyle);
begin
    m_UIStyle := Value;

    m_ActiveTab := GetThemeString(m_UIStyle, SUI_TAB_ACTIVE_IMAGE);
    m_InactiveTab := GetThemeString(m_UIStyle, SUI_TAB_INACTIVE_IMAGE);
    m_Line := GetThemeString(m_UIStyle, SUI_TAB_LINE_IMAGE);
    Height := GetThemeInt(m_UIStyle, SUI_TAB_TOP_HEIGHT);

    Repaint();
end;

procedure TsuiTabControlTopPanel.WMERASEBKGND(var Msg: TMessage);
begin
    // do nothing
end;

function TsuiTab.GetLeftMargin: Integer;
begin
    Result := m_TopPanel.LeftMargin;
end;

function TsuiTab.GetTabIndex: Integer;
begin
    Result := m_TopPanel.TabIndex;
end;

function TsuiTab.GetTabs: TStrings;
begin
    Result := m_TopPanel.Tabs;
end;

procedure TsuiTab.Paint;
var
    R : TRect;
begin
    Canvas.Brush.Color := Color;
    R := Rect(ClientRect.Left, m_TopPanel.Height, ClientRect.Right, ClientRect.Bottom);
    Canvas.FillRect(R);
    Canvas.Pen.Color := m_BorderColor;
    Canvas.MoveTo(0, m_TopPanel.Height);
    Canvas.LineTo(0, Height - 1);
    Canvas.LineTo(Width - 1, Height - 1);
    Canvas.LineTo(Width - 1, m_TopPanel.Height - 1);
end;

procedure TsuiTab.SetBorderColor(const Value: TColor);
begin
    m_BorderColor := Value;

    BorderColorChanged();
    Repaint();
    m_TopPanel.Repaint();
end;

procedure TsuiTab.SetFont(const Value: TFont);
begin
    m_Font.Assign(Value);
    m_TopPanel.Repaint();
end;

procedure TsuiTab.SetLeftMargin(const Value: Integer);
begin
    m_TopPanel.LeftMargin := Value;
end;

procedure TsuiTab.SetTabIndex(const Value: Integer);
begin
    m_TopPanel.TabIndex := Value;
end;

procedure TsuiTab.SetTabs(const Value: TStrings);
begin
    m_TopPanel.Tabs := Value;
end;

procedure TsuiTab.SetUIStyle(const Value: TsuiUIStyle);
begin
    if Value = Custom then
        Exit;

    m_UIStyle := Value;

    m_TopPanel.Color := GetThemeColor(m_UIStyle, SUI_CONTROL_BACKGROUND_COLOR);
    m_BorderColor := GetThemeColor(m_UIStyle, SUI_CONTROL_BORDER_COLOR);
    m_TopPanel.UIStyle := m_UIStyle;
    if m_UIStyle <> WinXP then
        Color := GetThemeColor(m_UIStyle, SUI_CONTROL_BACKGROUND_COLOR)
    else
        Color := clWhite;

    UpdateUIStyle(m_UIStyle);
    Repaint();
end;

procedure TsuiTab.UpdateUIStyle(UIStyle: TsuiUIStyle);
begin
    ContainerApplyUIStyle(self, UIStyle);
end;

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

    m_TopPanel := CreateTopPanel();
    m_TopPanel.Parent := self;

    m_Font := TFont.Create();

    Caption := ' ';
    BevelInner := bvNone;
    BevelOuter := bvNone;
    BorderWidth := 0;
    Height := 80;

    UIStyle := GetSUIFormStyle(TCustomForm(AOwner));
end;

destructor TsuiTab.Destroy;
begin
    m_Font.Free();
    m_Font := nil;

    m_TopPanel.Free();
    m_TopPanel := nil;

    inherited;
end;

{ TsuiTabControl }

function TsuiTabControl.CreateTopPanel: TsuiTabControlTopPanel;
begin
    Result := TsuiTabControlTopPanel.Create(self, self);
end;

procedure TsuiTab.TabActive(TabIndex : Integer);
begin
    if not (csLoading in ComponentState) then
        if Assigned(m_OnTabActive) then
            m_OnTabActive(self, TabIndex);
end;

procedure TsuiTab.BorderColorChanged;
begin
    // do nothing
end;

end.