spagecontrol.pas

Alpha Controls 界面控件包

unit sPageControl;
{$I sDefs.inc}
{.$DEFINE LOGGED}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, sCommonData, sConst, sFade, sUpDown, extctrls, sSpeedButton
  {$IFDEF TNTUNICODE}, TntComCtrls, TntGraphics{$ENDIF};

type
{$IFNDEF NOTFORHELP}
  TacCloseAction = (acaHide, acaFree);
  TacCloseBtnClick = procedure(Sender: TComponent; TabIndex : integer; var CanClose: boolean; var Action: TacCloseAction) of object;

  TsPageControl = class;

  TsTabSkinData = class(TPersistent)
  private
    FCustomColor: boolean;
    FCustomFont: boolean;
    FSkinSection: string;
    procedure SetCustomColor(const Value: boolean);
    procedure SetCustomFont(const Value: boolean);
    procedure SetSkinSection(const Value: string);
  published
    property CustomColor : boolean read FCustomColor write SetCustomColor;
    property CustomFont : boolean read FCustomFont write SetCustomFont;
    property SkinSection : TsSkinSection read FSkinSection write SetSkinSection;
  end;

  TsTabSheet = class;

  TsTabBtn = class(TsSpeedButton)
  public
    Page : TsTabSheet;
    constructor Create(AOwner:TComponent); override;
    procedure UpdateGlyph;
  end;

{$IFDEF TNTUNICODE}
  TsTabSheet = class(TTntTabSheet)                  
{$ELSE}
  TsTabSheet = class(TTabSheet)
{$ENDIF}
  private
    FTabSkin: TsSkinSection;
    FButtonSkin: TsSkinSection;
    FUseCloseBtn: boolean;
    FCommonData: TsTabSkinData;
    procedure SetUseCloseBtn(const Value: boolean);
    procedure SetButtonSkin(const Value: TsSkinSection);
    procedure SetTabSkin(const Value: TsSkinSection);
  public
    Btn : TsTabBtn;
    constructor Create(AOwner:TComponent); override;
    procedure CreateParams(var Params: TCreateParams); override;
    destructor Destroy; override;
    procedure WMPaint (var Message: TWMPaint); message WM_PAINT;
    procedure WndProc (var Message: TMessage); override;
  published
    property SkinData : TsTabSkinData read FCommonData write FCommonData;
    property ButtonSkin : TsSkinSection read FButtonSkin write SetButtonSkin;
    property TabSkin : TsSkinSection read FTabSkin write SetTabSkin;
    property UseCloseBtn : boolean read FUseCloseBtn write SetUseCloseBtn default True;
  end;
{$ENDIF}

{$IFDEF TNTUNICODE}
  TsPageControl = class(TTntPageControl)
{$ELSE}
  TsPageControl = class(TPageControl)
{$ENDIF}
{$IFNDEF NOTFORHELP}
  private
    StoredVisiblePageCount : integer;
    ChangedSkinSection : string;
    FCommonData: TsCommonData;
    UpDown: TsUpDown;
    FAnimatEvents: TacAnimatEvents;
    procedure CheckUpDown;
    function  GetInVisibleItemCount: Integer;
    procedure OnUpDownClick(Sender: TObject; Button: TUDBtnType);
    procedure UpdateUpDown;
    procedure UpdateUpDownRgn(Repaint : boolean = False);
    procedure ShowSkinUpDown;

    procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW; // v4.42
    procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
    procedure WMPaint (var Message: TWMPaint); message WM_PAINT;
    procedure DrawSkinTabs(CI : TCacheInfo);
    procedure DrawSkinTab(PageIndex: Integer; State : integer; Bmp : TBitmap; OffsetPoint : TPoint); overload;
    procedure DrawSkinTab(PageIndex: Integer; State : integer; DC : hdc); overload;
    function PageRect: TRect;
    function TabsRect: TRect;
    function GlyphRect: TRect;
    function SkinTabRect(Index : integer; Active : boolean) : TRect;
    function TabRow(TabIndex : integer) : integer;
    function GetActivePage: TsTabSheet;
    procedure SetActivePage(const Value: TsTabSheet);
    procedure UpdateBtnData;
    procedure PaintButtonEx(TabIndex : integer; BtnState : integer; TabState : integer);
    procedure PaintButtons(DC : hdc);
    function BtnRect(TabIndex : integer) : TRect;
  private
    FShowCloseBtns: boolean;
    FOnCloseBtnClick: TacCloseBtnClick;
    FCloseBtnSkin: TsSkinSection;
    procedure SetShowCloseBtns(const Value: boolean);
    procedure SetCloseBtnSkin(const Value: TsSkinSection);
  protected
    BtnIndex : integer;
    CurItem : integer;
    BtnWidth : integer;
    BtnHeight : integer;
    TabsChanging : boolean;
    procedure PaintButton(DC : hdc; TabRect : TRect; State : integer; BG : hdc = 0); virtual;
    function GetTabUnderMouse(p : TPoint) : integer;
    procedure RepaintTab(i, State : integer; TabDC : hdc = 0);
    procedure RepaintTabs(DC : HDC; ActiveTabNdx : integer);
    function VisibleTabsCount : integer;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure WndProc (var Message: TMessage); override;
    procedure Loaded; override;
    procedure AfterConstruction; override;
    procedure UpdateActivePage; override;
    procedure CloseClick(Sender: TObject);
    procedure ArrangeButtons;
  published
    property ActivePage: TsTabSheet read GetActivePage write SetActivePage; // v4.27
    property AnimatEvents : TacAnimatEvents read FAnimatEvents write FAnimatEvents default [aeGlobalDef];
    property Style;
{$ENDIF}
    property CloseBtnSkin : TsSkinSection read FCloseBtnSkin write SetCloseBtnSkin;
    property ShowCloseBtns : boolean read FShowCloseBtns write SetShowCloseBtns default False;
    property SkinData : TsCommonData read FCommonData write FCommonData;
    property OnCloseBtnClick: TacCloseBtnClick read FOnCloseBtnClick write FOnCloseBtnClick;
  end;

implementation

uses sMessages, sVclUtils, acUtils, sMaskData, sStyleSimply, math, Commctrl, sSkinProps, sAlphaGraph,
  sGraphUtils, sTabControl, sSkinManager {$IFDEF LOGGED}, sDebugMsgs{$ENDIF};

{ TsPageControl }

const
  BtnOffs = 1;
  iBtnWidth = 15;
  iBtnHeight = 15;

var
  acBtnPressed : boolean = False;

procedure TsPageControl.AfterConstruction;
begin
  inherited;                                                         
  SkinData.Loaded;
end;

procedure TsPageControl.CheckUpDown;
var
  Wnd : HWND;
  i : Integer;
begin
  if (csLoading in ComponentState) or (csCreating in ControlState) then Exit;
  if FCommonData.Skinned then begin
    Wnd := FindWindowEx(Handle, 0, 'msctls_updown32', nil);
    if Wnd <> 0 then DestroyWindow(Wnd);
    i := GetInVisibleItemCount;
    if TabPosition in [tpLeft, tpRight] then i := 0;
    if (i < 1) or Multiline then begin
      if (UpDown <> nil) then FreeAndNil(UpDown)
    end
    else if (UpDown = nil) then ShowSkinUpDown else UpdateUpDown;
  end
  else if UpDown <> nil then FreeAndNil(UpDown);
end;

procedure TsPageControl.CMHintShow(var Message: TMessage);
var
  Item : integer;
  P : TPoint;
begin
  with TCMHintShow(Message) do begin
    Item := GetTabUnderMouse(Point(HintInfo.CursorPos.X, HintInfo.CursorPos.Y));
    if Item <> -1 then begin
      with HintInfo^ do begin
        P := ClientToScreen(HintInfo.CursorPos);
        P.X := P.X + GetSystemMetrics(SM_CXCURSOR) div 2;
        P.Y := P.Y + GetSystemMetrics(SM_CYCURSOR) div 2;
        HintInfo.HintPos := P;
        HintInfo.HintStr := Pages[Item].Hint;
        Message.Result := 0;
      end;
    end;
  end;
end;

procedure TsPageControl.CNNotify(var Message: TWMNotify);
begin
  if FCommonData.Skinned then case Message.NMHdr^.code of
    TCN_SELCHANGE : begin
      inherited;
      UpdateUpDown;
      if not (csDesigning in ComponentState) and FCommonData.SkinManager.AnimEffects.PageChange.Active then begin
        AnimShowControl(Self, FCommonData.SkinManager.AnimEffects.PageChange.Time);
        SkinData.BGChanged := True;
        if ActivePage <> nil then RedrawWindow(ActivePage.Handle, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_ALLCHILDREN);
      end;
      Exit;
    end;
    TCN_SELCHANGING : begin
      if not (csDesigning in ComponentState) and FCommonData.SkinManager.AnimEffects.PageChange.Active then begin
        PrepareForAnimation(Self);
      end;
      UpdateUpDown;
    end;
  end;
  inherited;
  if FCommonData.Skinned then case Message.NMHdr^.code of
    TCN_SELCHANGING : begin
      if Message.Result = 1 then begin
        SendMessage(Handle, WM_SETREDRAW, 1, 0);
        if ow <> nil then FreeAndNil(ow);
        SendMessage(Handle, WM_MOUSEMOVE, 0, 0);
      end;
    end;
  end;
end;

constructor TsPageControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCommonData := TsCommonData.Create(Self, True);
  FCommonData.COC := COC_TsPageControl;
  TabsChanging := False;
  FAnimatEvents := [aeGlobalDef];
  FShowCloseBtns := False;
  CurItem := -1;
end;

destructor TsPageControl.Destroy;
begin
  if Assigned(FCommonData) then FreeAndNil(FCommonData);
  inherited Destroy;
end;

procedure TsPageControl.DrawSkinTab(PageIndex, State: integer; Bmp : TBitmap; OffsetPoint : TPoint);
var
  rText, aRect, R : TRect;
  VertFont : TLogFont;
  pFont : PLogFontA;
  i, h, w : integer;
  CI : TCacheInfo;
  TabIndex, TabMask, TabState : integer;
  TabSection : string;
  TempBmp : Graphics.TBitmap;
  SavedDC : hdc;

  lCaption: ACString;

  procedure MakeVertFont(Orient : integer);
  begin
    pFont := @VertFont;
    VertFont.lfFaceName := 'Arial';
    GetObject(Bmp.Canvas.Handle, SizeOf(TLogFont), pFont);
    VertFont.lfEscapement := Orient;
    VertFont.lfHeight := Font.Height;
    VertFont.lfStrikeOut := integer(fsStrikeOut in Font.Style);
    VertFont.lfItalic := integer(fsItalic in Font.Style);
    VertFont.lfUnderline := integer(fsUnderline	in Font.Style);
    VertFont.lfWeight := FW_NORMAL;
    VertFont.lfCharSet := Font.Charset;

    VertFont.lfWidth := 0;
    Vertfont.lfOutPrecision := OUT_DEFAULT_PRECIS;
    VertFont.lfClipPrecision := CLIP_DEFAULT_PRECIS;
    VertFont.lfOrientation := VertFont.lfEscapement;
    VertFont.lfPitchAndFamily := Default_Pitch;
    VertFont.lfQuality := Default_Quality;
    Bmp.Canvas.Font.Handle := CreateFontIndirect(VertFont);
    if State <> 0
      then Bmp.Canvas.Font.Color := FCommonData.SkinManager.gd[TabIndex].HotFontColor[1]
      else Bmp.Canvas.Font.Color := FCommonData.SkinManager.gd[TabIndex].FontColor[1];
  end;
  procedure KillVertFont; begin Bmp.Canvas.Font.Assign(Font) end;
begin
  R := SkinTabRect(Pages[PageIndex].TabIndex, PageIndex = ActivePageIndex);
  if (PageIndex = -1) or ((State = 1) and (R.Left < 0)) then Exit;
  if not Pages[PageIndex].TabVisible then Exit;

  rText := SkinTabRect(Pages[PageIndex].TabIndex, (State = 2) and (Pages[PageIndex] = ActivePage));
  aRect := rText;

  // Tabs drawing
  if FCommonData.SkinManager.ConstData.IndexTabTop > 0 then begin // new style
    TabState := State;
    case Style of
      tsTabs : begin
        if TsTabSheet(Pages[PageIndex]).TabSkin <> '' then begin
          TabSection := TsTabSheet(Pages[PageIndex]).TabSkin;
          TabIndex := FCommonData.SkinManager.GetSkinIndex(TabSection);
          TabMask := FCommonData.SkinManager.GetMaskIndex(TabSection, s_BordersMask);
        end
        else case TabPosition of // Init of skin data
          tpTop : begin TabIndex := FCommonData.SkinManager.ConstData.IndexTabTop; TabMask := FCommonData.SkinManager.ConstData.MaskTabTop; TabSection := s_TabTop end;
          tpLeft : begin TabIndex := FCommonData.SkinManager.ConstData.IndexTabLeft; TabMask := FCommonData.SkinManager.ConstData.MaskTabLeft; TabSection := s_TabLeft end;
          tpBottom : begin TabIndex := FCommonData.SkinManager.ConstData.IndexTabBottom; TabMask := FCommonData.SkinManager.ConstData.MaskTabBottom; TabSection := s_TabBottom end
          else begin TabIndex := FCommonData.SkinManager.ConstData.IndexTabRight; TabMask := FCommonData.SkinManager.ConstData.MaskTabRight; TabSection := s_TabRight end;
        end;
      end;
      tsButtons : begin
        if TsTabSheet(Pages[PageIndex]).TabSkin <> '' then TabSection := TsTabSheet(Pages[PageIndex]).TabSkin else TabSection := s_Button;
        TabIndex := FCommonData.SkinManager.GetSkinIndex(TabSection);
        TabMask := FCommonData.SkinManager.GetMaskIndex(TabSection, s_BordersMask);
      end
      else begin
        if TsTabSheet(Pages[PageIndex]).TabSkin <> '' then TabSection := TsTabSheet(Pages[PageIndex]).TabSkin else TabSection := s_ToolButton;
        TabIndex := FCommonData.SkinManager.GetSkinIndex(TabSection);
        TabMask := FCommonData.SkinManager.GetMaskIndex(TabSection, s_BordersMask);
      end;
    end;

    if FCommonData.SkinManager.IsValidImgIndex(TabMask) then begin // Drawing of tab
      TempBmp := CreateBmp24(WidthOf(aRect), HeightOf(aRect));
      try
        if (State = 2) and (Pages[PageIndex] = ActivePage) then begin
          // Restore BG for Active tab
          BitBlt(TempBmp.Canvas.Handle, aRect.Left + OffsetPoint.x, aRect.Top + OffsetPoint.y, TempBmp.Width, TempBmp.Height,
                   FCommonData.FCacheBmp.Canvas.Handle, aRect.Left, aRect.Top, SRCCOPY);
          OffsetRect(R, OffsetPoint.X, OffsetPoint.Y);
          if ParentCenterColor <> clFuchsia then FillDC(TempBmp.Canvas.Handle, R, ColorToRGB(ParentCenterColor))
          else begin
            CI := GetParentCache(FCommonData);
            if CI.Ready
              then BitBlt(TempBmp.Canvas.Handle, R.Left, R.Top, WidthOf(R), HeightOf(R),
                          CI.Bmp.Canvas.Handle, CI.X + Left + TabRect(Pages[PageIndex].TabIndex).Left,
                          CI.Y + Top + TabRect(Pages[PageIndex].TabIndex).Top, SRCCOPY)
              else FillDC(TempBmp.Canvas.Handle, R, ColorToRGB(TsHackedControl(Parent).Color));
          end;
          // Paint active tab
          BitBlt(Bmp.Canvas.Handle, aRect.Left + OffsetPoint.x, aRect.Top + OffsetPoint.y, TempBmp.Width, TempBmp.Height, TempBmp.Canvas.Handle, 0, 0, SRCCOPY);
          CI := MakeCacheInfo(TempBmp);
          PaintItem(TabIndex, TabSection, CI, True, TabState, Rect(0, 0, TempBmp.Width, TempBmp.Height),
                           Point(0, 0), Bmp, FCommonData.SkinManager);
        end
        else begin
          CI := MakeCacheInfo(FCommonData.FCacheBmp);
          if State = 1 then CI.X := 0;
          PaintItem(TabIndex, TabSection, CI, True, TabState, Rect(0, 0, TempBmp.Width, TempBmp.Height),
                           Point(aRect.Left, aRect.Top), TempBmp, FCommonData.SkinManager);

          SavedDC := SaveDC(Bmp.Canvas.Handle);
          R := PageRect;
          if TabPosition in [tpLeft, tpTop] then ExcludeClipRect(Bmp.Canvas.Handle, R.Left, R.Top, R.Right, R.Bottom);
          BitBlt(Bmp.Canvas.Handle, aRect.Left + OffsetPoint.x, aRect.Top + OffsetPoint.y, TempBmp.Width, TempBmp.Height, TempBmp.Canvas.Handle, 0, 0, SRCCOPY);
          RestoreDC(Bmp.Canvas.Handle, SavedDC);
        end;
      finally
        FreeAndNil(TempBmp);
      end;
    end;
  end;

  // End of tabs drawing
  if not OwnerDraw then begin
    // Drawing of the tab content
    OffsetRect(rText, OffsetPoint.x, OffsetPoint.y);

    {$IFDEF TNTUNICODE}
     if Pages[PageIndex] is TTntTabSheet then
        lCaption := TTntTabSheet(Pages[PageIndex]).Caption
     else
    {$ENDIF}
        lCaption := Pages[PageIndex].Caption;

    R := rText;
    InflateRect(R, -3, -3);
    case TabPosition of
      tpTop, tpBottom : begin
        Bmp.Canvas.Font.Assign(Font);
        if (Images <> nil) and (Pages[PageIndex].ImageIndex > -1) and (Pages[PageIndex].ImageIndex <= Images.Count - 1) then begin
          Images.Draw(Bmp.Canvas,
                rText.Left + (WidthOf(rText) - (acTextWidth(Bmp.Canvas, lCaption) + Images.Width + 8)) div 2,
                rText.Top + (HeightOf(rText) - Images.Height) div 2,
                Pages[PageIndex].ImageIndex,
                True);
          inc(rText.Left, WidthOf(GlyphRect));
          R := rText;
{$IFDEF TNTUNICODE}
          WriteTextExW(Bmp.Canvas, PACChar(lCaption),
              Enabled, rText, DT_CENTER or DT_SINGLELINE or DT_VCENTER, TabIndex, State <> 0, FCommonData.SkinManager);
{$ELSE}
          WriteTextEx(Bmp.Canvas, PACChar(lCaption),
              Enabled, rText, DT_CENTER or DT_SINGLELINE or DT_VCENTER, TabIndex, State <> 0, FCommonData.SkinManager);
{$ENDIF}

        end
        else begin
          R := rText;