bscategorybuttons.pas

一套非常好用的delphi控件,方便程序员工作

          Rect(SkinRect.Left + ClRect.Left, SkinRect.Top + ClRect.Top,
               SkinRect.Left + ClRect.Right,
               SkinRect.Top + ClRect.Bottom));
      w := RectWidth(ClRect);
      h := RectHeight(ClRect);
      XCnt := RectWidth(R) div w;
      YCnt := RectHeight(R) div h;
      for X := 0 to XCnt do
      for Y := 0 to YCnt do
        Canvas.Draw(X * w + R.Left, Y * h + R.Top, Buffer);
  end;
  Buffer.Free;
end;

var
  TopCategory: Integer;
  CatIndex: Integer;
  StartingPos: Integer;
  EndingPos: Integer;
  Category: TbsButtonCategory;
  DrawRect: TRect;
begin
  StartingPos := 0;
  TopCategory := GetIndexOfFirstCategory;
  if (TopCategory > -1) and (TopCategory < FButtonCategories.Count) then
  begin
    { Calculate the virtual position and ending position }
    StartingPos := FButtonCategories[TopCategory].FStart - GetScrollOffset;
    if FButtonFlow = bscbfVertical then
      EndingPos := ClientHeight
    else
      EndingPos := ClientWidth;
    for CatIndex := TopCategory to FButtonCategories.Count - 1 do
    begin
      Category := FButtonCategories[CatIndex];
      DrawCategory(Category, Canvas, StartingPos);
      StartingPos := StartingPos + Category.FEnd - Category.FStart;
      { Stop drawing early, if we can }
      if StartingPos > EndingPos then
        Break;
    end;
  end;
  //
  Canvas.Brush.Color := clBtnFace;
  //
  if (FButtonFlow = bscbfVertical) and
     (StartingPos < ClientHeight)
  then
    begin
      DrawRect := Rect(0, StartingPos, ClientWidth,
        ClientHeight);
      if (SkinData <> nil) and (not Skindata.Empty) and
            (SkinData.GetControlIndex('panel') <> -1)
      then
        DrawSkinBGRect(DrawRect)
      else
        Canvas.FillRect(DrawRect);
    end
  else
  if (FButtonFlow = bscbfHorizontal) and
     (StartingPos < ClientWidth)
  then
    begin
      DrawRect := Rect(StartingPos, 0, ClientWidth,
        ClientHeight);
      if (SkinData <> nil) and (not Skindata.Empty) and
            (SkinData.GetControlIndex('panel') <> -1)
      then
        DrawSkinBGRect(DrawRect)
      else
        Canvas.FillRect(DrawRect);
    end
end;

function TbsSkinCategoryButtons.CalcButtonsPerRow: Integer;
begin
  if bsboFullSize in ButtonOptions
  then
    Result := 1
  else
  begin
    Result := (ClientWidth - GetScrollSize - FSideBufferSize - 1) div FButtonWidth;
    if Result * FButtonWidth > ClientWidth - GetScrollSize - FSideBufferSize - 1
    then
      Dec(Result)
    else
    if (Result + 1) * FButtonWidth < ClientWidth - GetScrollSize - FSideBufferSize - 1
    then
      Inc(Result);
    if Result <= 0 then Result := 1;
  end;
end;

function TbsSkinCategoryButtons.CalcButtonsPerCol: Integer;
begin
  Result := (ClientHeight - FSideBufferSize - GetScrollSize - 1) div FButtonHeight;
  if Result * FButtonHeight > ClientHeight - FSideBufferSize - GetScrollSize
  then
    Dec(Result)
  else
  if (Result + 1) * FButtonHeight < ClientHeight - FSideBufferSize - GetScrollSize
  then
    Inc(Result);
  if Result = 0 then
    Result := 1;
end;

const
  cScrollBarKind: array[TbsCatButtonFlow] of Integer = (SB_VERT, SB_HORZ);

procedure TbsSkinCategoryButtons.Resize;

  function CalcCategoryHeights: Integer;
  var
    I: Integer;
    Category: TbsButtonCategory;
    Y: Integer;
    ButtonsPerRow: Integer;
  begin
    ButtonsPerRow := CalcButtonsPerRow;
    Y := 0;
    for I := 0 to FButtonCategories.Count - 1 do
    begin
      Category := FButtonCategories[I];
      Category.FStart := Y;
      Category.FEnd := Y + CalcCategoryHeight(Category, ButtonsPerRow);
      Y := Category.FEnd;
    end;
    Result := Y;
  end;

  function CalcCategoryWidths: Integer;
  var
    I: Integer;
    Category: TbsButtonCategory;
    X: Integer;
    ButtonsPerCol: Integer;
  begin
    ButtonsPerCol := CalcButtonsPerCol;
    X := 0;
    for I := 0 to FButtonCategories.Count - 1 do
    begin
      Category := FButtonCategories[I];
      Category.FStart := X;
      Category.FEnd := X + CalcCategoryWidth(Category, ButtonsPerCol);
      X := Category.FEnd;
    end;
    Result := X;
  end;

var
  ScrollInfo: TScrollInfo;
  TotalAmount: Integer;
  AmountSeen: Integer;
begin
  inherited;
  if (not HandleAllocated) or (FGutterSize = 0) then
    Exit;

  if FButtonFlow = bscbfVertical then
  begin
    TotalAmount := CalcCategoryHeights;
    AmountSeen := ClientHeight;
  end
  else
  begin
    TotalAmount := CalcCategoryWidths;
    AmountSeen := ClientWidth;
  end;

  { Do we have to take the scrollbar into consideration? }
  if (TotalAmount > AmountSeen) then
  begin
    { The max size is the number of "rows of buttons" that are hidden }
    FScrollBarMax := TotalAmount div FGutterSize;
    ScrollInfo.nMax := FScrollBarMax;

    AmountSeen := AmountSeen div FGutterSize;
    if FScrollBarMax > AmountSeen then
      FPageAmount := AmountSeen
    else
      FPageAmount := FScrollBarMax;

    { Adjust the max to NOT contain the page amount }
    FScrollBarMax := FScrollBarMax - FPageAmount + 1;

    if FScrollBarPos > FScrollBarMax then
      FScrollBarPos := FScrollBarMax;

    ScrollInfo.cbSize := SizeOf(TScrollInfo);
    ScrollInfo.fMask := SIF_RANGE or SIF_POS or SIF_PAGE;
    ScrollInfo.nMin := 0;
    ScrollInfo.nPos := FScrollBarPos;
    ScrollInfo.nPage := FPageAmount;
    if FSkinScrollBar = nil
    then
      begin
        ShowSkinScrollBar(True);
      end;
    FSkinScrollBar.SetRange(ScrollInfo.nMin, ScrollInfo.nMax,
        FScrollBarPos, ScrollInfo.nPage);
  end
  else
  begin
    FScrollBarPos := 0;
    FScrollBarMax := 0;
    if FSkinScrollBar <> nil
    then
      begin
        ShowSkinScrollBar(False);
      end;
  end;
end;

procedure TbsSkinCategoryButtons.SetButtonHeight(const Value: Integer);
begin
  if FButtonHeight <> Value then
  begin
    FButtonHeight := Value;
    Resize;
    UpdateAllButtons;
  end;
end;

procedure TbsSkinCategoryButtons.SetButtonCategories(const Value: TbsButtonCategories);
begin
  FButtonCategories.Assign(Value);
end;

procedure TbsSkinCategoryButtons.SetCatButtonOptions(const Value: TbsCatButtonOptions);
begin
  if FButtonOptions <> Value then
  begin
    FButtonOptions := Value;
    CalcBufferSizes;
    Resize;
    UpdateAllButtons;
  end;
end;

procedure TbsSkinCategoryButtons.SetButtonWidth(const Value: Integer);
begin
  if FButtonWidth <> Value then
  begin
    FButtonWidth := Value;
    Resize;
    UpdateAllButtons;
  end;
end;

procedure TbsSkinCategoryButtons.SBChange(Sender: TObject);
var
  ScrollCode: TScrollCode;
begin
  ScrollCode := scPosition;
  ScrollPosChanged(TScrollCode(ScrollCode), FSkinScrollBar.Position);
end;

procedure TbsSkinCategoryButtons.SBUpClick(Sender: TObject);
var
  ScrollCode: TScrollCode;
begin
  ScrollCode := scLineDown;
  ScrollPosChanged(TScrollCode(ScrollCode), FSkinScrollBar.Position);
end;

procedure TbsSkinCategoryButtons.SBDownClick(Sender: TObject);
var
  ScrollCode: TScrollCode;
begin
  ScrollCode := scLineUp;
  ScrollPosChanged(TScrollCode(ScrollCode), FSkinScrollBar.Position);
end;

procedure TbsSkinCategoryButtons.SBPageUp(Sender: TObject);
var
  ScrollCode: TScrollCode;
begin
  ScrollCode := scPageUp;
  ScrollPosChanged(TScrollCode(ScrollCode), FSkinScrollBar.Position);
end;

procedure TbsSkinCategoryButtons.SBPageDown(Sender: TObject);
var
  ScrollCode: TScrollCode;
begin
  ScrollCode := scPageDown;
  ScrollPosChanged(TScrollCode(ScrollCode), FSkinScrollBar.Position);
end;

procedure TbsSkinCategoryButtons.ShowSkinScrollBar(const Visible: Boolean);
begin
  if Visible
  then
    begin
     FSkinScrollBar := TbsSkinScrollBar.Create(Self);
     FSkinScrollBar.Visible := False;
     FSkinScrollBar.Parent := Self;
     //
     FSkinScrollBar.OnChange := SBChange;
     FSkinScrollBar.OnUpButtonClick := SBUpClick;
     FSkinScrollBar.OnDownButtonClick := SBDownClick;
     FSkinScrollBar.OnPageUp := SBPageUp;
     FSkinScrollBar.OnPageDown := SBPageDown;
     //
     if FButtonFlow = bscbfVertical
     then
       begin
         FSkinScrollBar.SkinDataName := 'vscrollbar';
         FSkinScrollBar.Kind := sbVertical;
       end
     else
       begin
         FSkinScrollBar.SkinDataName := 'hscrollbar';
         FSkinScrollBar.Kind := sbHorizontal;
       end;
      FSkinScrollBar.SkinData := Self.SkinData;
      FSkinScrollBar.Visible := True;
      AdjustScrollBar;
      //
    end
  else
    begin
      FSkinScrollBar.Visible := False;
      FSkinScrollBar.Free;
      FSkinScrollBar := nil;
    end;
  Resize;
  Invalidate;
end;


procedure TbsSkinCategoryButtons.UpdateAllButtons;
begin
  Invalidate;
end;

procedure TbsSkinCategoryButtons.UpdateButton(const Button: TbsButtonItem);
var
  R: TRect;
begin
  { Just invalidate one button's rect }
  if (Button <> nil) and (HandleAllocated) then
  begin
    R := GetButtonRect(Button);
    InvalidateRect(Handle, @R, False);
  end;
end;

procedure TbsSkinCategoryButtons.ScrollPosChanged(ScrollCode: TScrollCode;
  ScrollPos: Integer);
var
  OldPos: Integer;
begin
  OldPos := FScrollBarPos;
  if (ScrollCode = scLineUp) and (FScrollBarPos > 0) then
    Dec(FScrollBarPos)
  else if (ScrollCode = scLineDown) and (FScrollBarPos < FScrollBarMax) then
    Inc(FScrollBarPos)
  else if (ScrollCode = scPageUp) then
  begin
    Dec(FScrollBarPos, FPageAmount);
    if FScrollBarPos < 0 then
      FScrollBarPos := 0;
  end
  else if ScrollCode = scPageDown then
  begin
    Inc(FScrollBarPos, FPageAmount);
    if FScrollBarPos > FScrollBarMax then
      FScrollBarPos := FScrollBarMax;
  end
  else if ScrollCode in [scPosition, scTrack] then
    FScrollBarPos := ScrollPos
  else if ScrollCode = scTop then
    FScrollBarPos := 0
  else if ScrollCode = scBottom then
    FScrollBarPos := FScrollBarMax;
  if OldPos <> FScrollBarPos then
  begin
    if FSkinScrollBar <> nil
    then
      FSkinScrollBar.SetRange(FSkinScrollBar.M