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

📄 bsbuttongroup.pas

📁 一套非常优秀的皮肤组件包
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  begin
    TotalRowsNeeded := FButtonItems.Count div ButtonsPerRow;
    if FButtonItems.Count mod ButtonsPerRow <> 0 then
      Inc(TotalRowsNeeded);

    if TotalRowsNeeded > RowsSeen then
      FPageAmount := RowsSeen
    else
      FPageAmount := TotalRowsNeeded;

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

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

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

procedure TbsSkinButtonGroup.SeTbsGrpButtonItems(const Value: TbsGrpButtonItems);
begin
  FButtonItems.Assign(Value);
end;

procedure TbsSkinButtonGroup.SetGrpButtonOptions(const Value: TbsGrpButtonOptions);
begin
  if FButtonOptions <> Value then
  begin
    FButtonOptions := Value;
    if not (bsgboGroupStyle in FButtonOptions) then
      FItemIndex := -1;
    if HandleAllocated then
    begin
      Resize;
      UpdateAllButtons;
    end;
  end;
end;

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

procedure TbsSkinButtonGroup.SetImages(const Value: TCustomImageList);
begin
  if Images <> Value then
  begin
    if Images <> nil then
      Images.UnRegisterChanges(FImageChangeLink);
    FImages := Value;
    if Images <> nil then
    begin
      Images.RegisterChanges(FImageChangeLink);
      Images.FreeNotification(Self);
   end;
   UpdateAllButtons;
  end;
end;

procedure TbsSkinButtonGroup.SetItemIndex(const Value: Integer);
var
  OldIndex: Integer;
begin
  if (FItemIndex <> Value) and (bsgboGroupStyle in ButtonOptions) then
  begin
    OldIndex := FItemIndex;
    { Assign the index before painting }
    FItemIndex := Value;
    FFocusIndex := Value; { Assign it to the focusl item too }
    UpdateButton(OldIndex);

    UpdateButton(FItemIndex);
  end;
end;

const
  cScrollBarKind = SB_VERT;

procedure TbsSkinButtonGroup.UpdateAllButtons;
begin
  Invalidate;
end;

procedure TbsSkinButtonGroup.UpdateButton(const Index: Integer);
var
  R: TRect;
begin
  { Just invalidate one button's rect }
  if Index >= 0 then
  begin
    R := GetButtonRect(Index);
    InvalidateRect(Handle, @R, False);
  end;
end;

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

procedure TbsSkinButtonGroup.DoFillRect(const Rect: TRect);
begin
  Canvas.FillRect(Rect);
end;

procedure TbsSkinButtonGroup.DrawStretchSkinButton(Index: Integer; Canvas: TCanvas;
   Rct: TRect; State: TbsButtonDrawState); 
var
  R, SR: TRect;
  ButtonData: TbsDataSkinButtonControl;
  Buffer: TBitMap;
  CIndex: Integer;
  NewClRect: TRect;
  XO, YO: Integer;
  C: TColor;
  FSkinPicture: TBitMap;
  ButtonItem: TbsGrpButtonItem;
begin

  Buffer := TBitMap.Create;
  Buffer.Width := RectWidth(Rct);
  Buffer.Height := RectHeight(Rct);

  CIndex := SkinData.GetControlIndex(FButtonsSkinDataName);

  ButtonData := SkinData.CtrlList[CIndex];

  with ButtonData do
  begin
    if bsbdsDown in State then
    begin
      SR := DownSkinRect;
      C := DownFontColor;
    end
    else
    if bsbdsSelected in State
    then
      begin
        SR := ActiveSkinRect;
        C := ActiveFontColor;
      end
    else
    if bsbdsHot in State
    then
      begin
        SR := ActiveSkinRect;
        C := ActiveFontColor;
      end
   else
    begin
      SR := SkinRect;
      C := FontColor;
    end;
    if IsNullRect(SR) then SR := SkinRect;
    XO := RectWidth(Rct) - RectWidth(SR);
    YO := RectHeight(Rct) - RectHeight(SR);
    NewClRect := Rect(CLRect.Left, ClRect.Top,
      CLRect.Right + XO, ClRect.Bottom + YO);

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

    CreateStrechImage(Buffer, FSkinPicture, SR, ClRect);
    //

    //
    if (bsbdsFocused in State) and FShowFocus
    then
      begin
        R := NewClRect;
        InflateRect(R, 1, 1);
        Buffer.Canvas.DrawFocusRect(R);
      end;
    // draw glpyh and text
    if FUseSkinFont
    then
      begin
        Buffer.Canvas.Font.Name := FontName;
        Buffer.Canvas.Font.Style := FontStyle;
        Buffer.Canvas.Font.Height := FontHeight;
      end
    else
      Buffer.Canvas.Font.Assign(Self.Font);
    Buffer.Canvas.Font.Color := C;
    if SkinData.ResourceStrData <>  nil
    then
      Buffer.Canvas.Font.Charset := SkinData.ResourceStrData.CharSet
    else
      Buffer.Canvas.Font.Charset := Font.CharSet;
    //
    ButtonItem := FButtonItems[Index];

    if gboShowCaptions in FButtonOptions
    then
      DrawImageAndText(Buffer.Canvas, NewClRect, -1, 2, blGlyphLeft,
         ButtonItem.Caption, ButtonItem.ImageIndex, FImages, bsbdsDown in State, True)
    else
      DrawImageAndText(Buffer.Canvas, NewClRect, -1, 0, blGlyphLeft,
         '', ButtonItem.ImageIndex, FImages, bsbdsDown in State, True);
  end;
  Canvas.Draw(Rct.Left, Rct.Top, Buffer);
  Buffer.Free;
end;

procedure TbsSkinButtonGroup.DrawSkinButton(Index: Integer; Canvas: TCanvas;
      Rct: TRect; State: TbsButtonDrawState); 
var
  R, SR: TRect;
  ButtonData: TbsDataSkinButtonControl;
  Buffer: TBitMap;
  CIndex: Integer;
  NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
  NewClRect: TRect;
  XO, YO: Integer;
  C: TColor;
  FSkinPicture: TBitMap;
  ButtonItem: TbsGrpButtonItem;
begin

  if (FButtonsSkinDataName <> 'resizebutton') and
     (SkinData.GetControlIndex(FButtonsSkinDataName) <> -1)
  then
    begin
      DrawStretchSkinButton(Index, Canvas, Rct, State);
      Exit;
    end;
   
  Buffer := TBitMap.Create;
  Buffer.Width := RectWidth(Rct);
  Buffer.Height := RectHeight(Rct);

  CIndex := SkinData.GetControlIndex('resizebutton');
  ButtonData := SkinData.CtrlList[CIndex];
  with ButtonData do
  begin
    if bsbdsDown in State then
    begin
      SR := DownSkinRect;
      C := DownFontColor;
    end
    else
    if bsbdsSelected in State
    then
      begin
        SR := ActiveSkinRect;
        C := ActiveFontColor;
      end
    else
    if bsbdsHot in State
    then
      begin
        SR := ActiveSkinRect;
        C := ActiveFontColor;
      end
   else
    begin
      SR := SkinRect;
      C := FontColor;
    end;
    if IsNullRect(SR) then SR := SkinRect;
    XO := RectWidth(Rct) - RectWidth(SR);
    YO := RectHeight(Rct) - RectHeight(SR);
    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[ButtonData.PictureIndex]);

    CreateSkinImage(LTPoint, RTPoint, LBPoint, RBPoint, CLRect,
         NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
         Buffer, FSkinPicture, SR, Buffer.Width, Buffer.Height, True);

    //
    if (bsbdsFocused in State) and FShowFocus
    then
      begin
        R := NewClRect;
        InflateRect(R, 1, 1);
        Buffer.Canvas.DrawFocusRect(R);
      end;
    // draw glpyh and text
    if FUseSkinFont
    then
      begin
        Buffer.Canvas.Font.Name := FontName;
        Buffer.Canvas.Font.Style := FontStyle;
        Buffer.Canvas.Font.Height := FontHeight;
      end
    else
      Buffer.Canvas.Font.Assign(Self.Font);
    Buffer.Canvas.Font.Color := C;
    if SkinData.ResourceStrData <>  nil
    then
      Buffer.Canvas.Font.Charset := SkinData.ResourceStrData.CharSet
    else
      Buffer.Canvas.Font.Charset := Font.CharSet;
    //
    ButtonItem := FButtonItems[Index];

    if gboShowCaptions in FButtonOptions
    then
      DrawImageAndText(Buffer.Canvas, NewClRect, -1, 2, blGlyphLeft,
         ButtonItem.Caption, ButtonItem.ImageIndex, FImages, bsbdsDown in State, True)
    else
      DrawImageAndText(Buffer.Canvas, NewClRect, -1, 0, blGlyphLeft,
         '', ButtonItem.ImageIndex, FImages, bsbdsDown in State, True);
  end;
  Canvas.Draw(Rct.Left, Rct.Top, Buffer);
  Buffer.Free;
end;

procedure TbsSkinButtonGroup.DrawButton(Index: Integer; Canvas: TCanvas;
  Rect: TRect; State: TbsButtonDrawState);
var
  ButtonItem: TbsGrpButtonItem;
  FillColor: TColor;
  EdgeColor: TColor;
  TextRect: TRect;
  R, OrgRect: TRect;
  CIndex: Integer;
begin
  if Assigned(FOnDrawButton) and (not (csDesigning in ComponentState)) then
    FOnDrawButton(Self, Index, Canvas, Rect, State)
  else
  begin
    if (SkinData <> nil) and not (SkinData.Empty)
    then
      begin
        CIndex := SkinData.GetControlIndex('resizebutton');
        if CIndex <> -1
        then
          begin
            DrawSkinButton(Index, Canvas, Rect, State);
            Exit;
          end;
      end;

    OrgRect := Rect;
    Canvas.Font := Font;

    if bsbdsDown in State then
    begin
      EdgeColor := BS_XP_BTNFRAMECOLOR;
      Canvas.Brush.Color := BS_XP_BTNDOWNCOLOR;
      Canvas.Font.Color := clBtnText;
    end
    else
    if bsbdsHot in State then
    begin
       EdgeColor := BS_XP_BTNFRAMECOLOR;
      Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
      Canvas.Font.Color := clBtnText;
    end
    else
    if bsbdsSelected in State then
    begin
      EdgeColor := BS_XP_BTNFRAMECOLOR;
      Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
      Canvas.Font.Color := clBtnText;
    end

⌨️ 快捷键说明

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