⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 stoolbar.pas

📁 Alpha Controls.v5.46b Source
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit sToolBar;
{$I sDefs.inc}
{.$DEFINE LOGGED}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ToolWin, ComCtrls, sCommonData, sConst, sDefaults{$IFDEF TNTUNICODE}, TntComCtrls{$ENDIF};

type
{$IFDEF TNTUNICODE}
  TsToolBar = class(TTntToolBar)
{$ELSE}
  TsToolBar = class(TToolBar)
{$ENDIF}
{$IFNDEF NOTFORHELP}
  private
    HotButtonIndex : integer;
    FCommonData: TsCommonData;
    FDisabledKind: TsDisabledKind;
    procedure WMNCPaint (var Message: TWMNCPaint); message WM_NCPAINT;
    procedure SetDisabledKind(const Value: TsDisabledKind);
  protected
    DroppedButton : TToolButton;
    procedure WndProc (var Message: TMessage); override;
    procedure UpdateDividers;

    procedure PrepareCache;
    procedure OurAdvancedCustomDraw(Sender: TToolBar; const ARect: TRect; Stage: TCustomDrawStage; var DefaultDraw: Boolean);
    procedure OurAdvancedCustomDrawButton(Sender: TToolBar; Button: TToolButton; State: TCustomDrawState; Stage: TCustomDrawStage; var Flags: TTBCustomDrawFlags; var DefaultDraw: Boolean);

    function GetButtonRect(Index : integer) : TRect;
    function IndexByMouse(MousePos : TPoint) : integer;
    procedure RepaintButton(Index : integer);
{$IFDEF DELPHI6UP}
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
{$ENDIF}
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AfterConstruction; override;
    procedure Loaded; override;
    procedure UpdateEvents;
  published
    property Flat;// default True;
{$ENDIF} // NOTFORHELP
    property BtnDisabledKind : TsDisabledKind read FDisabledKind write SetDisabledKind default DefDisabledKind;
    property SkinData : TsCommonData read FCommonData write FCommonData;
  end;

implementation

uses acntUtils, sStyleSimply, sVCLUtils, sMessages, sMaskData, sGraphUtils,
  sSKinProps, sAlphaGraph, CommCtrl, ImgList, sSKinManager
  {$IFDEF LOGGED}, sDebugMsgs{$ENDIF}, sThirdParty, Menus;

{ TsToolBar }

procedure TsToolBar.AfterConstruction;
begin
  inherited;
  FCommonData.Loaded;
  UpdateEvents;
end;

{$IFDEF DELPHI6UP}
procedure TsToolBar.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if not (csDesigning in ComponentState) and Assigned(FCommonData) and FCommonData.Skinned then begin
    if (AComponent is TPopupMenu) then begin
      if Assigned(DefaultManager) then DefaultManager.SkinableMenus.HookPopupMenu(TPopupMenu(AComponent), Operation = opInsert);
    end;
  end;
end;
{$ENDIF}

constructor TsToolBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCommonData := TsCommonData.Create(Self, True);
  FCommonData.COC := COC_TsToolBar;
  FDisabledKind := DefDisabledKind;
  HotButtonIndex := -1;
end;

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

function TsToolBar.GetButtonRect(Index: integer): TRect;
begin
  Perform(TB_GETITEMRECT, Index, Longint(@Result))
end;

function TsToolBar.IndexByMouse(MousePos: TPoint): integer;
var
  i : integer;
begin
  Result := -1;
  for i := 0 to ButtonCount - 1 do begin
    if PtInRect(GetButtonRect(i), MousePos) then begin
      if (TControl(Buttons[I]) is TToolButton) and (Buttons[i].Style in [tbsButton, tbsCheck, tbsDropDown]) then Result := i;
      Exit;
    end;
  end;
end;

procedure TsToolBar.Loaded;
begin
  inherited;
  FCommonData.Loaded;
  UpdateEvents;
end;

procedure CopyCache(Control : TWinControl; SkinData : TsCommonData; SrcRect, DstRect : TRect; DstDC : HDC);
var
  SaveIndex : HDC;
  i : integer;
  Designing : boolean;
begin
  sAlphaGraph.UpdateCorners(SkinData, 0);
  SaveIndex := SaveDC(DstDC);
  IntersectClipRect(DstDC, DstRect.Left, DstRect.Top, DstRect.Right, DstRect.Bottom);
  Designing := csDesigning in Control.ComponentState;
  try
    for i := 0 to Control.ControlCount - 1 do begin
      if (Control.Controls[i] is TToolButton) and (csDesigning in Control.ComponentState) then Continue;
      if (Control.Controls[i] is TGraphicControl) and StdTransparency then Continue;
      if not Control.Controls[i].Visible or not RectIsVisible(DstRect, Control.Controls[i].BoundsRect) then Continue;
      if ((csOpaque in Control.Controls[i].ControlStyle) or (Control.Controls[i] is TGraphicControl){v4.03} or Designing {v4.35}) then begin
        ExcludeClipRect(DstDC, Control.Controls[i].Left, Control.Controls[i].Top, // v4.32
                          Control.Controls[i].Left + Control.Controls[i].Width,
                          Control.Controls[i].Top + Control.Controls[i].Height);
      end;
    end;
    BitBlt(DstDC, DstRect.Left, DstRect.Top, WidthOf(DstRect), HeightOf(DstRect), SkinData.FCacheBmp.Canvas.Handle, SrcRect.Left, SrcRect.Top, SRCCOPY); // v4.22
  finally
    RestoreDC(DstDC, SaveIndex);
  end;
end;

procedure TsToolBar.OurAdvancedCustomDraw(Sender: TToolBar; const ARect: TRect; Stage: TCustomDrawStage; var DefaultDraw: Boolean);
var
  RC, RW: TRect;
begin
  if FCommonData.Skinned then begin
    FCommonData.Updating := FCommonData.Updating;
    if not (Stage in [cdPrePaint]) then begin DefaultDraw := False; Exit end;
    if not FCommonData.Updating then begin
      FCommonData.FCacheBMP.Canvas.Font.Assign(Font);
      if FCommonData.BGChanged then PrepareCache;

      Windows.GetClientRect(Handle, RC);
      GetWindowRect(Handle, RW);
      MapWindowPoints(0, Handle, RW, 2);
      OffsetRect(RC, -RW.Left, -RW.Top);

      CopyCache(Self, FCommonData, RC, ARect, Canvas.Handle); // v4.12
      sVCLUtils.PaintControls(Canvas.Handle, Self, True, Point(0, 0));
      SetParentUpdated(Self);
      if (RC.Left > 0) or (RC.Top > 0) or (RC.Right <> Width) or (RC.Bottom <> Height) then SendMessage(Handle, WM_NCPAINT, 0, 0);
    end;
  end
  else begin
    DefaultDraw := True;
    inherited;
  end
end;

procedure TsToolBar.OurAdvancedCustomDrawButton(Sender: TToolBar; Button: TToolButton; State: TCustomDrawState; Stage: TCustomDrawStage; var Flags: TTBCustomDrawFlags; var DefaultDraw: Boolean);
var
  Mode, SkinIndex, BorderIndex : integer;
  ci : TCacheInfo;
  R, iR : TRect;
  BtnBmp : TBitmap;
  bWidth, bHeight : integer;
  function AddedWidth : integer;
  begin
    if (Button.Style = tbsDropDown) {and (Button.DropdownMenu <> nil) v4.64} then Result := GetSystemMetrics(SM_CXVSCROLL) else Result := 0
  end;
  function IntButtonWidth : integer;
  begin
    Result := Button.Width - AddedWidth;
  end;
  function ButtonWidth : integer;
  begin
    Result := Button.Width;
  end;
  function ImgRect : TRect; begin
    if not List then begin
      Result.Left := (IntButtonWidth - Images.Width) div 2 + 1;
      Result.Top := (Button.Height - Images.Height - integer(ShowCaptions) * (FCommonData.FCacheBMP.Canvas.TextHeight('A') + 3)) div 2;
      Result.Right := Result.Left + Images.Width;
      Result.Bottom := Result.Bottom + Images.Height;
    end
    else begin
      Result.Left := 5;
      Result.Top := (Button.Height - Images.Height) div 2;
      Result.Right := Result.Left + Images.Width;
      Result.Bottom := Result.Bottom + Images.Height;
    end;
    if Mode = 2 then OffsetRect(Result, 1, 1);
  end;
  procedure DrawBtnCaption;
  var
    cRect : TRect;
    function CaptionRect : TRect; var l, t, r, b, dh : integer; begin
      if not List then begin
        l := (IntButtonWidth - FCommonData.FCacheBMP.Canvas.TextWidth(Button.Caption)) div 2;
        if Assigned(Images) then begin
          dh := (Button.Height - Images.Height - FCommonData.FCacheBMP.Canvas.TextHeight('A') - 3) div 2;
          t := dh + Images.Height + 3;
        end
        else begin
          dh := (Button.Height - FCommonData.FCacheBMP.Canvas.TextHeight('A')) div 2;
          t := dh;
        end;
        r := IntButtonWidth - l;
        b := Button.Height - dh;
        Result := Rect(l - 1, t, r + 2, b);
      end
      else begin
        if Assigned(Images) then Result.Left := 6 + Images.Width else Result.Left := 1;
        Result.Right := IntButtonWidth - 2;
        Result.Top := 2;
        Result.Bottom := Button.Height - 2;
      end;
      OffsetRect(Result, integer(Mode = 2), integer(Mode = 2));
    end;
  begin
    if ShowCaptions then begin
      cRect := CaptionRect;
{$IFDEF TNTUNICODE}
      if Button is TTntToolButton
        then WriteTextExW(BtnBMP.Canvas, PWideChar(TTntToolButton(Button).Caption), True, cRect, DT_CENTER or DT_VCENTER or DT_SINGLELINE, SkinIndex, Mode > 0)
        else
{$ENDIF}
      WriteTextEx(BtnBMP.Canvas, PChar(Button.Caption), True, cRect, DT_CENTER or DT_VCENTER or DT_SINGLELINE, SkinIndex, Mode > 0);
    end;
  end;
  procedure DrawBtnGlyph;
  begin
    if Assigned(Images) and (Button.ImageIndex > -1) and (Button.ImageIndex < Images.Count) then begin
      CopyToolBtnGlyph(Self, Button, State, Stage, Flags, BtnBmp);
    end;
  end;
  procedure DrawArrow;
  var
    Mode : integer;
    x, y : integer;
  begin
    if FCommonData.SkinManager.ConstData.MaskArrowBottom > -1 then begin
      if ((DroppedButton = Button) and Assigned(Button.DropDownMenu) or Button.Down) then Mode := 2 else if cdsHot in State then Mode := 1 else Mode := 0;

      R.Left := IntButtonWidth;
      R.Right := Button.Width;
      BorderIndex := FCommonData.SkinManager.GetMaskIndex(SkinIndex, s_ToolButton, s_BordersMask);
      if FCommonData.SkinManager.IsValidImgIndex(BorderIndex) then DrawSkinRect(BtnBmp, R, True, ci, FCommonData.SkinManager.ma[BorderIndex], Mode, True);

      if (FCommonData.SkinManager.ConstData.MaskArrowBottom > -1) and (FCommonData.SkinManager.ConstData.MaskArrowBottom < High(FCommonData.SkinManager.ma)) then begin
        x := IntButtonWidth + (AddedWidth - 3 - WidthOf(FCommonData.SkinManager.ma[FCommonData.SkinManager.ConstData.MaskArrowBottom].R) div FCommonData.SkinManager.ma[FCommonData.SkinManager.ConstData.MaskArrowBottom].ImageCount) div 2 + 2;
        y := (ButtonHeight - HeightOf(FCommonData.SkinManager.ma[FCommonData.SkinManager.ConstData.MaskArrowBottom].R) div (1 + FCommonData.SkinManager.ma[FCommonData.SkinManager.ConstData.MaskArrowBottom].MaskType)) div 2;

        DrawSkinGlyph(BtnBmp, Point(x, y), Mode, 1, FCommonData.SkinManager.ma[FCommonData.SkinManager.ConstData.MaskArrowBottom]);
      end;
    end;
  end;
begin
  if FCommonData.Skinned then begin
    DefaultDraw := False;
    if not (Stage in [cdPrePaint]) then begin DefaultDraw := False; Exit end;
    if Stage in [cdPrePaint] then begin
      if not Flat and not (csDesigning in ComponentState) and (HotButtonIndex = Button.Index) then State := State + [cdsHot];
      Flags := Flags + [tbNoEtchedEffect, tbNoEdges];

      iR := GetButtonRect(Button.Index);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -