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

📄 spcategorybuttons.pas

📁 DynamicSkinForm.v9.15.For.Delphi.BCB 很好的皮肤控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  Button: TspButtonItem;
  CategoryBounds, ButtonBounds, ChevronBounds: TRect;
  Caption: string;
  CaptionRect: TRect;
  CategoryRealBounds: TRect;
  //
  F: TLogFont;
  TY: Integer;
  CIndex: Integer;
begin
  if (SkinData <> nil) and not SkinData.Empty
  then
    begin
      CIndex := SkinData.GetControlIndex('panel');
      if CIndex <> -1
      then
        begin
          DrawSkinCategory(Category, Canvas, StartingPos);
          Exit;
        end;
    end;

  GetCategoryBounds(Category, StartingPos, CategoryBounds, ButtonBounds);
  CategoryRealBounds := CategoryBounds;

  Canvas.Font := Self.Font;
  Canvas.Brush.Color := clBtnFace;
  Canvas.FillRect(CategoryRealBounds);

  with CategoryRealBounds do
  begin
    Canvas.Pen.Color := clBtnShadow;
    Canvas.Rectangle(Left, Top, Right, Bottom);
  end;

  ChevronBounds := GetChevronBounds(CategoryRealBounds);

  if Category.Items.Count > 0 then
    DrawDropDownButton(ChevronBounds.Left + 2, ChevronBounds.Top + 2,
      Category.Collapsed);

  VerticalCaption := True;
  if FButtonFlow = bscbfVertical then
  begin
    if not (spboVerticalCategoryCaptions in ButtonOptions) or
        Category.Collapsed or
        (Category.Items = nil) or
        (Category.Items.Count = 0) then
      VerticalCaption := False
  end
  else if not (spboVerticalCategoryCaptions in ButtonOptions) and
      not (Category.Collapsed or (Category.Items = nil) or (Category.Items.Count = 0)) then
    VerticalCaption := False;

  { Draw the category caption. Truncating and vertical as needed. }
  Caption := Category.Caption;

  if (spboBoldCaptions in ButtonOptions) then
    Canvas.Font.Style := Canvas.Font.Style + [fsBold];

  Canvas.Brush.Style := bsClear;
  Canvas.Font.Color := clBlack;

  if not VerticalCaption then
  begin
    CaptionRect.Left := CategoryBounds.Left + 5 + cDropDownSize;
    CaptionRect.Right := CategoryBounds.Right - 5;
    CaptionRect.Top := CategoryBounds.Top + 3;
    CaptionRect.Bottom := CaptionRect.Top + Canvas.TextHeight(Caption);
    Canvas.TextRect(CaptionRect, CaptionRect.Left, CaptionRect.Top, Caption);
  end
  else
    begin
      CaptionRect.Left := CategoryBounds.Left + 3;
      CaptionRect.Top := CategoryBounds.Top + cDropDownSize + 5;
      CaptionRect.Right := CaptionRect.Left + (FCollapsedHeight + cBorderBuffer);
      CaptionRect.Bottom := CategoryBounds.Bottom - 5;
      TY := CaptionRect.Bottom - RectHeight(CaptionRect) div 2 +
       Canvas.TextWidth(Caption) div 2;
      if TY > CaptionRect.Bottom then TY := CaptionRect.Bottom;

      GetObject(Canvas.Font.Handle, SizeOf(F), @F);
      F.lfEscapement := round(900);
      Canvas.Font.Handle := CreateFontIndirect(F);

      Canvas.TextRect(CaptionRect, CaptionRect.Left, TY, Caption);

      GetObject(Canvas.Font.Handle, SizeOf(F), @F);
      F.lfEscapement := round(0);
      Canvas.Font.Handle := CreateFontIndirect(F);
    end;

  if (spboBoldCaptions in ButtonOptions) then
    Canvas.Font.Style := Canvas.Font.Style - [fsBold];

  if not Category.Collapsed then
  begin
    { Draw the buttons }
    if (FButtonFlow = bscbfVertical) and (spboFullSize in ButtonOptions) then
      ActualWidth := ClientWidth - FSideBufferSize - GetScrollSize - 5
    else
      ActualWidth := FButtonWidth;

    ButtonStart := ButtonBounds.Left;
    ButtonTop := ButtonBounds.Top;
    ButtonLeft := ButtonStart;
    for I := 0 to Category.Items.Count - 1 do
    begin
      { Don't waste time painting clipped things }
      if (FButtonFlow = bscbfVertical) and (ButtonTop > ClientHeight) then
        Break; { Done drawing }

      { Don't waste time drawing what is offscreen }
      ButtonBottom := ButtonTop + FButtonHeight;
      ButtonRight := ButtonLeft + ActualWidth;
      if (ButtonBottom >= 0) and (ButtonRight >= 0) then
      begin
        ButtonRect := Rect(ButtonLeft, ButtonTop, ButtonRight, ButtonBottom);

        Button := Category.Items[I];
        DrawState := [];
        if Button = FHotButton then
        begin
          Include(DrawState, spbdsHot);
          if Button = FDownButton then
            Include(DrawState, spbdsDown);
        end;
        if Button = FSelectedItem then
          Include(DrawState, spbdsSelected)
        else if (Button = FFocusedItem) and Focused and (FDownButton = nil) then
          Include(DrawState, spbdsFocused);

        if Button = FInsertTop then
          Include(DrawState, spbdsInsertTop)
        else if Button = FInsertBottom then
          Include(DrawState, spbdsInsertBottom)
        else if Button = FInsertRight then
          Include(DrawState, spbdsInsertRight)
        else if Button = FInsertLeft then
          Include(DrawState, spbdsInsertLeft);

        DrawButton(Button, Canvas, ButtonRect, DrawState);
      end;
      Inc(ButtonLeft, ActualWidth);

      if (ButtonLeft + ActualWidth) > ButtonBounds.Right then
      begin
        ButtonLeft := ButtonStart;
        Inc(ButtonTop, FButtonHeight);
      end;
    end;
  end;
end;

procedure TspSkinCategoryButtons.DrawSkinCategory(
  const Category: TspButtonCategory; const Canvas: TCanvas; StartingPos: Integer);

  procedure DrawDropDownButton(Cnv: TCanvas; X, Y: Integer; Collapsed: Boolean);
  var
    Middle: Integer;
    EdgeColor: TColor;

    procedure SmallCheveron(const X, Y: Integer);
    begin
      { Shared portions }
      if Collapsed then
      begin
        { Top line }
        Cnv.Pixels[X-1, Y] := EdgeColor;
        Cnv.Pixels[X+0, Y] := EdgeColor;
        Cnv.Pixels[X+4, Y] := EdgeColor;
        Cnv.Pixels[X+5, Y] := EdgeColor;
        { Middle line }
        Cnv.Pixels[X+0, Y+1] := EdgeColor;
        Cnv.Pixels[X+1, Y+1] := EdgeColor;
        Cnv.Pixels[X+3, Y+1] := EdgeColor;
        Cnv.Pixels[X+4, Y+1] := EdgeColor;
        { Bottom line  }
        Cnv.Pixels[X + 1, Y + 2] := EdgeColor;
        Cnv.Pixels[X + 2, Y + 2] := EdgeColor;
        Cnv.Pixels[X + 3, Y + 2] := EdgeColor;
        { Bottom tip of the chevron }
        Cnv.Pixels[X+2, Y+3] := EdgeColor;
      end
      else
      begin
        { Top tip of the chevron }
        Cnv.Pixels[X+2, Y] := EdgeColor;
        { Top line  }
        Cnv.Pixels[X + 1, Y + 1] := EdgeColor;
        Cnv.Pixels[X + 2, Y + 1] := EdgeColor;
        Cnv.Pixels[X + 3, Y + 1] := EdgeColor;
        { Middle line }
        Cnv.Pixels[X, Y+2] := EdgeColor;
        Cnv.Pixels[X+1, Y+2] := EdgeColor;
        Cnv.Pixels[X+3, Y+2] := EdgeColor;
        Cnv.Pixels[X+4, Y+2] := EdgeColor;
        { Bottom line }
        Cnv.Pixels[X-1, Y+3] := EdgeColor;
        Cnv.Pixels[X+0, Y+3] := EdgeColor;
        Cnv.Pixels[X+4, Y+3] := EdgeColor;
        Cnv.Pixels[X+5, Y+3] := EdgeColor;
      end;
    end;

    procedure DrawPlusMinus;
    var
      Width, Height: Integer;
    begin
      Width := 9;
      Height := Width;
      Inc(X, 2);
      Inc(Y, 2);
      begin
        Cnv.Pen.Color := Cnv.Font.Color;
        Cnv.Brush.Color := clWindow;
        Cnv.Rectangle(X, Y, X + Width, Y + Height);
        Cnv.Pen.Color := clWindowText;

        Cnv.MoveTo(X + 2, Y + Width div 2);
        Cnv.LineTo(X + Width - 2, Y + Width div 2);

        if Collapsed then
        begin
          Cnv.MoveTo(X + Width div 2, Y + 2);
          Cnv.LineTo(X + Width div 2, Y + Width - 2);
        end;
      end;
    end;

  begin
    if spboUsePlusMinus in ButtonOptions then
    begin
      DrawPlusMinus;
    end
    else
    begin
      EdgeColor := Cnv.Font.Color;
      Middle := cDropDownSize div 2;
      SmallCheveron(X + Middle - 2, Y + Middle - 4);
      SmallCheveron(X + Middle - 2, Y + Middle + 1);
    end;
  end;

var
  I: Integer;
  ButtonTop, ButtonLeft, ButtonRight: Integer;
  ButtonRect: TRect;
  ActualWidth: Integer;
  ButtonStart: Integer;
  ButtonBottom: Integer;
  VerticalCaption: Boolean;
  DrawState: TspButtonDrawState;
  Button: TspButtonItem;
  CategoryBounds, ButtonBounds, ChevronBounds: TRect;
  Caption: string;
  CaptionRect: TRect;
  CategoryRealBounds: TRect;
  //
  F: TLogFont;
  TY: Integer;
  Buffer: TBitMap;
  BR, CR, CB: TREct;
  NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
  NewClRect: TRect;
  XO, YO, CIndex: Integer;
  FSkinPicture: TBitMap;
  PanelData: TspDataSkinPanelControl;
  LabelData: TspDataSkinStdLabelControl;
begin
  GetCategoryBounds(Category, StartingPos, CategoryBounds, ButtonBounds);
  CategoryRealBounds := CategoryBounds;

  Buffer := TBitMap.Create;
  Buffer.Width := RectWidth(CategoryRealBounds);
  Buffer.Height := RectHeight(CategoryRealBounds);
  // draw panel
  CIndex := SkinData.GetControlIndex(FCategorySkinDataName);
  PanelData := TspDataSkinPanelControl(SkinData.CtrlList[CIndex]);
  with PanelData do
  begin
    XO := RectWidth(CategoryRealBounds) - RectWidth(SkinRect);
    YO := RectHeight(CategoryRealBounds) - RectHeight(SkinRect);
    NewLTPoint := LTPoint;
    NewRTPoint := Point(RTPoint.X + XO, RTPoint.Y);
    NewLBPoint := Point(LBPoint.X, LBPoint.Y + YO);
    NewRBPoint := Point(RBPoint.X + XO, RBPoint.Y + YO);
    NewClRect := Rect(CLRect.Left, ClRect.Top,
      CLRect.Right + XO, ClRect.Bottom + YO);

    FSkinPicture := TBitMap(FSD.FActivePictures.Items[panelData.PictureIndex]);

    CreateSkinImage(LTPoint, RTPoint, LBPoint, RBPoint, CLRect,
         NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
         Buffer, FSkinPicture, SkinRect, Buffer.Width, Buffer.Height, True,
            LeftStretch, TopStretch, RightStretch, BottomStretch,
           StretchEffect, StretchType);

  end;
  // get font parameters
  CIndex := SkinData.GetControlIndex('stdlabel');
  if CIndex <> -1
  then
    begin
      LabelData := TspDataSkinStdLabelControl(SkinData.CtrlList[CIndex]);
      with LabelData do
      begin
        if FUseSkinFont
        then
          begin
            Buffer.Canvas.Font.Name := FontName;
            Buffer.Canvas.Font.Style := FontStyle;
            Buffer.Canvas.Font.Height := FontHeight;
            if SkinData.ResourceStrData <>  nil
            then
              Buffer.Canvas.Font.Charset := SkinData.ResourceStrData.CharSet
            else
              Buffer.Canvas.Font.Charset := Font.CharSet;
          end
        else
          Buffer.Canvas.Font.Assign(Self.Font);
        Buffer.Canvas.Font.Color := FontColor;  
      end;
    end
  else
    Buffer.Canvas.Font := Self.Font;
  //
  ChevronBounds := GetChevronBounds(CategoryRealBounds);
  CB := ChevronBounds;
  OffsetRect(CB, -CategoryRealBounds.Left, -CategoryRealBounds.Top);
  if Category.Items.Count > 0 then
    DrawDropDownButton(Buffer.Canvas, CB.Left + 2, CB.Top + 2,
      Category.Collapsed);

  VerticalCaption := True;
  if FButtonFlow = bscbfVertical then
  begin
    if not (spboVerticalCategoryCaptions in ButtonOptions) or
        Category.Collapsed or
        (Category.Items = nil) or
        (Category.Items.Count = 0) then
      VerticalCaption := False
  end
  else if not (spboVerticalCategoryCaptions in ButtonOptions) and
      not (Category.Collapsed or (Category.Items = nil) or (Category.Items.Count = 0)) then
    VerticalCaption := False;

  { Draw the category caption. Truncating and vertical as needed. }
  Caption := Category.Caption;

  if (spboBoldCaptions in ButtonOptions) then
    Buffer.Canvas.Font.Style := Canvas.Font.Style + [fsBold];

  if not VerticalCaption then
  begin
    CaptionRect.Left := CategoryBounds.Left + 5 + cDropDownSize;
    CaptionRect.Right := CategoryBounds.Right - 5;
    CaptionRect.Top := CategoryBounds.Top + 3;
    CaptionRect.Bottom := CaptionRect.Top + Canvas.TextHeight(Caption);
    CR := CaptionRect;
    OffsetRect(CR, -CategoryRealBounds.Left, -CategoryRealBounds.Top);
    Buffer.Canvas.Brush.Style := bsClear;
    Buffer.Canvas.TextRect(CR, CR.Left, CR.Top, Caption);
  end
  else
    begin
      CaptionRect.Left := CategoryBounds.Left + 3;
      CaptionRect.Top := CategoryBounds.Top + cDropDownSize + 5;
      CaptionRect.Right := CaptionRect.Left + (FCollapsedHeight + cBorderBuffer);
      CaptionRect.Bottom := CategoryBounds.Bottom - 3;

      CR := CaptionRect;
      OffsetRect(CR, -CategoryRealBounds.Left, -CategoryRealBounds.Top);

      TY := CR.Bottom - RectHeight(CR) div 2 +
      Buffer.Canvas.TextWidth(Caption) div 2;
      if TY > CR.Bottom then TY := CR.Bottom;

      GetObject(Buffer.Canvas.Font.Handle, SizeOf(F), @F);
      F.lfEscapement := round(900);
      Buffer.Canvas.Font.Handle := CreateFontIndirect(F);
      Buffer.Canvas.Brush.Style := bsClear;
      Buffer.Canvas.TextRect(CR, CR.Left, TY, Caption);

⌨️ 快捷键说明

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