spcategorybuttons.pas

DynamicSkinForm.v9.15.For.Delphi.BCB 很好的皮肤控件

      AdjustScrollBar;
    end;
end;

procedure TspSkinCategoryButtons.CMSENCPaint(var Message: TMessage);
begin
  if (Message.wParam <> 0) and Self.FShowBorder
  then
    begin
      Self.PaintBorder(Message.wParam, True);
      Message.Result := SE_RESULT;
    end
  else
    Message.Result := 0;
end;

procedure TspSkinCategoryButtons.CMBENCPAINT;
begin
  if (Message.LParam = BE_ID)
  then
    begin
      if (Message.wParam <> 0) and Self.FShowBorder
      then
        Self.PaintBorder(Message.wParam, True);
      Message.Result := BE_ID;
    end
  else
    inherited;
end;

procedure TspSkinCategoryButtons.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
end;

destructor TspSkinCategoryButtons.Destroy;
begin
  if FSkinScrollBar <> nil then FSkinScrollBar.Free;
  if FIs9XOS then FMouseTimer.Free;
  FSkinScrollBar := nil;
  FDragImageList.Free;
  FButtonCategories.Free;
  FImageChangeLink.Free;
  inherited;
end;

procedure TspSkinCategoryButtons.AdjustScrollBar;
begin
  if FSkinScrollBar = nil then Exit;
  with  FSkinScrollBar do
  begin
  if (FButtonFlow = bscbfVertical) and (Kind <> sbVertical)
    then
      begin
        Kind := sbVertical;
        SkinDataName := 'vscrollbar';
      end
    else
    if (FButtonFlow =  bscbfHorizontal) and (Kind <> sbHorizontal)
    then
      begin
        Kind := sbHorizontal;
        SkinDataName := 'hscrollbar';
      end;
    if (FButtonFlow = bscbfVertical)
    then
      begin
        DefaultHeight := 0;
        DefaultWidth := 19;
      end
    else
      begin
        DefaultHeight := 19;
        DefaultWidth := 0;
      end;
  end;
  if (FButtonFlow = bscbfVertical)
  then
   begin
      FSkinScrollBar.SetBounds(ClientWidth - FSkinScrollBar.Width, 0,
         FSkinScrollBar.Width, ClientHeight);
    end
  else
    begin
      FSkinScrollBar.SetBounds(0, ClientHeight - FSkinScrollBar.Height,
        ClientWidth, FSkinScrollBar.Height);
    end;
  if not FSkinScrollBar.Visible then FSkinScrollBar.Visible := True;
end;


function TspSkinCategoryButtons.GetScrollOffset: Integer;
begin
  Result := FScrollBarPos * FGutterSize;
end;

function TspSkinCategoryButtons.GetButtonRect(const Button: TspButtonItem): TRect;
var
  ButtonsPerRow: Integer;
  Row, Col: Integer;
  StartingPos: Integer;
  CategoryBounds, ButtonBounds: TRect;
begin
  { Translate the current virtual position to the actual position }
  StartingPos := Button.Category.FStart - GetScrollOffset;
  GetCategoryBounds(Button.Category, StartingPos, CategoryBounds, ButtonBounds);

  if FButtonFlow = bscbfVertical then
    ButtonsPerRow := CalcButtonsPerRow
  else
    ButtonsPerRow := (ButtonBounds.Right - ButtonBounds.Left) div FButtonWidth;
  Row := Button.Index div ButtonsPerRow;
  Result.Top := ButtonBounds.Top + Row * FButtonHeight;
  if (FButtonFlow = bscbfVertical) and (spboFullSize in FButtonOptions) then
  begin
    Result.Left := ButtonBounds.Left;
    Result.Right := ButtonBounds.Right - 5;
  end
  else
  begin
    Col := Button.Index mod ButtonsPerRow;
    Result.Left := ButtonBounds.Left + Col*FButtonWidth;
    Result.Right := Result.Left + FButtonWidth;
  end;
  Result.Bottom := Result.Top + FButtonHeight;
end;

procedure TspSkinCategoryButtons.ImageListChange(Sender: TObject);
begin
  UpdateAllButtons;
end;

procedure TspSkinCategoryButtons.Notification(AComponent: TComponent;
  Operation: TOperation);
var
  I, J: Integer;
begin
  inherited;
  if (Operation = opRemove) then
  begin
    if AComponent = Images then
      Images := nil
    else
      if AComponent is TBasicAction then
        for I := 0 to FButtonCategories.Count - 1 do
          for J := 0 to FButtonCategories[I].Items.Count - 1 do
            if AComponent = FButtonCategories[I].Items[J].Action then
              FButtonCategories[I].Items[J].Action := nil;
  end;
end;

const
  cBorderBuffer = 15;

function TspSkinCategoryButtons.CalcCategoryHeight(const Category: TspButtonCategory;
  const ButtonsPerRow: Integer): Integer;
var
  RowCount: Integer;
begin
  if Category.Collapsed or (Category.Items = nil) or (Category.Items.Count = 0) then
    Result := FCollapsedHeight + cBorderBuffer
  else
  begin
    RowCount := Category.Items.Count div ButtonsPerRow;
    if Category.Items.Count mod ButtonsPerRow <> 0 then
      Inc(RowCount);

    Result := RowCount * FButtonHeight + cBorderBuffer;
    if not (spboVerticalCategoryCaptions in ButtonOptions) then
      Result := Result + FGutterSize;
  end;
end;

function TspSkinCategoryButtons.CalcCategoryWidth(
  const Category: TspButtonCategory; const ButtonsPerCol: Integer): Integer;
var
  ColCount: Integer;
begin
  if Category.Collapsed or (Category.Items = nil) or
      (Category.Items.Count = 0) then
    Result := FCollapsedHeight + cBorderBuffer
  else
  begin
    ColCount := Category.Items.Count div ButtonsPerCol;
    if Category.Items.Count mod ButtonsPerCol <> 0 then
      Inc(ColCount);

    Result := ColCount * FButtonWidth + cBorderBuffer;
    if spboVerticalCategoryCaptions in ButtonOptions then
      Result := Result + FGutterSize;
  end;
end;

procedure TspSkinCategoryButtons.GetCategoryBounds(const Category: TspButtonCategory;
  const StartingPos: Integer; var CategoryBounds, ButtonBounds: TRect);
var
  CatHeight, CatWidth: Integer;
  ButtonsPerRow, ButtonsPerCol: Integer;
  XStart, YStart: Integer;
  XEnd, YEnd: Integer;
begin
  if FButtonFlow = bscbfVertical then
  begin
    XStart := 0;
    XEnd := ClientWidth - GetScrollSize;

    ButtonsPerRow := CalcButtonsPerRow;
    CatHeight := CalcCategoryHeight(Category, ButtonsPerRow);

    with CategoryBounds do
    begin
      Left := XStart;
      Top := StartingPos;
      Right := XEnd;
      Bottom := StartingPos + CatHeight;
    end;

    if not Category.Collapsed then
    begin
      with ButtonBounds do
      begin
        Top := StartingPos + 8;
        if spboVerticalCategoryCaptions in ButtonOptions then
          Left := XStart + FGutterSize
        else
        begin
          Left := XStart + 8;
          Top := Top + FGutterSize;
        end;
        Right := XEnd - 1;
        Bottom := Top + (Category.Items.Count div ButtonsPerRow) * FButtonHeight;
        if Category.Items.Count mod ButtonsPerRow <> 0 then
          Inc(Bottom, FButtonHeight);
      end;
    end;
  end
  else
  begin
    YStart := 0;
    YEnd := ClientHeight - GetScrollSize;

    ButtonsPerCol := CalcButtonsPerCol;
    CatWidth := CalcCategoryWidth(Category, ButtonsPerCol);

    with CategoryBounds do
    begin
      Left := StartingPos;
      Top := YStart;
      Right := StartingPos + CatWidth;
      Bottom := YEnd;
    end;

    if not Category.Collapsed then
      with ButtonBounds do
      begin
        Left := StartingPos + 8;
        if not (spboVerticalCategoryCaptions in ButtonOptions) then
          Top := YStart + FGutterSize
        else
        begin
          Top := YStart + 8;
          Left := Left + FGutterSize;
        end;
        Bottom := YEnd - 1;
        Right := Left + (Category.Items.Count div ButtonsPerCol) * FButtonWidth;
        if Category.Items.Count mod ButtonsPerCol <> 0 then
          Inc(Right, FButtonWidth);
      end;
  end;
end;


const
  cDropDownSize = 13;

function TspSkinCategoryButtons.GetChevronBounds(const CategoryBounds: TRect): TRect;
begin
  Result.Left := CategoryBounds.Left + 2;
  Result.Top :=  CategoryBounds.Top + 2;
  Result.Right := Result.Left + cDropDownSize;
  Result.Bottom := Result.Top + cDropDownSize;
end;


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

  procedure DrawDropDownButton(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 }
        Canvas.Pixels[X-1, Y] := EdgeColor;
        Canvas.Pixels[X+0, Y] := EdgeColor;
        Canvas.Pixels[X+4, Y] := EdgeColor;
        Canvas.Pixels[X+5, Y] := EdgeColor;
        { Middle line }
        Canvas.Pixels[X+0, Y+1] := EdgeColor;
        Canvas.Pixels[X+1, Y+1] := EdgeColor;
        Canvas.Pixels[X+3, Y+1] := EdgeColor;
        Canvas.Pixels[X+4, Y+1] := EdgeColor;
        { Bottom line  }
        Canvas.Pixels[X + 1, Y + 2] := EdgeColor;
        Canvas.Pixels[X + 2, Y + 2] := EdgeColor;
        Canvas.Pixels[X + 3, Y + 2] := EdgeColor;
        { Bottom tip of the chevron }
        Canvas.Pixels[X+2, Y+3] := EdgeColor;
      end
      else
      begin
        { Top tip of the chevron }
        Canvas.Pixels[X+2, Y] := EdgeColor;
        { Top line  }
        Canvas.Pixels[X + 1, Y + 1] := EdgeColor;
        Canvas.Pixels[X + 2, Y + 1] := EdgeColor;
        Canvas.Pixels[X + 3, Y + 1] := EdgeColor;
        { Middle line }
        Canvas.Pixels[X, Y+2] := EdgeColor;
        Canvas.Pixels[X+1, Y+2] := EdgeColor;
        Canvas.Pixels[X+3, Y+2] := EdgeColor;
        Canvas.Pixels[X+4, Y+2] := EdgeColor;
        { Bottom line }
        Canvas.Pixels[X-1, Y+3] := EdgeColor;
        Canvas.Pixels[X+0, Y+3] := EdgeColor;
        Canvas.Pixels[X+4, Y+3] := EdgeColor;
        Canvas.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
        Canvas.Pen.Color := clBtnShadow;
        Canvas.Brush.Color := clWindow;
        Canvas.Rectangle(X, Y, X + Width, Y + Height);
        Canvas.Pen.Color := clWindowText;

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

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

  begin
    if spboUsePlusMinus in ButtonOptions then
    begin
      DrawPlusMinus;
    end
    else
    begin
      EdgeColor := clBtnShadow;
      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;