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

📄 bsbuttongroup.pas

📁 BusinessSkinForm的控件包与实例
💻 PAS
📖 第 1 页 / 共 5 页
字号:
     FSkinScrollBar.OnPageUp := SBPageUp;
     FSkinScrollBar.OnPageDown := SBPageDown;
     //
     FSkinScrollBar.SkinDataName := 'vscrollbar';
     FSkinScrollBar.Kind := sbVertical;
     FSkinScrollBar.SkinData := Self.SkinData;
     FSkinScrollBar.Visible := True;
     AdjustScrollBar;
      //
    end
  else
    begin
      FSkinScrollBar.Visible := False;
      FSkinScrollBar.Free;
      FSkinScrollBar := nil;
    end;
  Resize;
  Invalidate;
end;

procedure TbsSkinButtonGroup.WMNCPAINT(var Message: TMessage);
begin
  if FShowBorder
  then
    PaintBorder(0, False)
  else
    inherited;
end;

procedure TbsSkinButtonGroup.PaintBorder;
begin
  if (SkinData <> nil) and (not SkinData.Empty) and
     (SkinData.GetControlIndex('panel') <> -1)
  then
    PaintSkinBorder(ADC, AUseExternalDC)
  else
    PaintDefaultBorder(ADC, AUseExternalDC);  
end;

procedure TbsSkinButtonGroup.PaintDefaultBorder;
var
  DC: HDC;
  Cnvs: TControlCanvas;
  R: TRect;
begin
  if not AUseExternalDC
  then
    DC := GetWindowDC(Handle)
  else
    DC := ADC;

  Cnvs := TControlCanvas.Create;
  Cnvs.Handle := DC;
  R := Rect(0, 0, Width, Height);
  InflateRect(R, -2, -2);

  if R.Bottom > R.Top
  then
    ExcludeClipRect(Cnvs.Handle,R.Left, R.Top, R.Right, R.Bottom);

  with Cnvs do
  begin
    Pen.Color := clBtnShadow;
    Brush.Style := bsClear;
    Rectangle(0, 0, Width, Height);
    Pen.Color := clBtnFace;
    Rectangle(1, 1, Width - 1, Height - 1);
  end;
  Cnvs.Handle := 0;
  if not AUseExternalDC
  then
    ReleaseDC(Handle, DC);
  Cnvs.Free;
end;


procedure TbsSkinButtonGroup.PaintSkinBorder;
var
  LeftBitMap, TopBitMap, RightBitMap, BottomBitMap: TBitMap;
  DC: HDC;
  Cnvs: TControlCanvas;
  OX, OY: Integer;
  PanelData: TbsDataSkinPanelControl;
  CIndex: Integer;
  FSkinPicture: TBitMap;
  NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
  NewClRect: TRect;
begin
  CIndex := SkinData.GetControlIndex('panel');
  PanelData := TbsDataSkinPanelControl(SkinData.CtrlList[CIndex]);

  if not AUseExternalDC
  then
    DC := GetWindowDC(Handle)
  else
    DC := ADC;

  Cnvs := TControlCanvas.Create;
  Cnvs.Handle := DC;
  LeftBitMap := TBitMap.Create;
  TopBitMap := TBitMap.Create;
  RightBitMap := TBitMap.Create;
  BottomBitMap := TBitMap.Create;
  //
  with PanelData do
  begin
  OX := Width - RectWidth(SkinRect);
  OY := Height - RectHeight(SkinRect);
  NewLTPoint := LTPoint;
  NewRTPoint := Point(RTPoint.X + OX, RTPoint.Y);
  NewLBPoint := Point(LBPoint.X, LBPoint.Y + OY);
  NewRBPoint := Point(RBPoint.X + OX, RBPoint.Y + OY);
  NewClRect := Rect(ClRect.Left, ClRect.Top,
    ClRect.Right + OX, ClRect.Bottom + OY);
  //
  FSkinPicture := TBitMap(FSD.FActivePictures.Items[panelData.PictureIndex]);
  CreateSkinBorderImages(LTPoint, RTPoint, LBPoint, RBPoint, ClRect,
      NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
      LeftBitMap, TopBitMap, RightBitMap, BottomBitMap,
      FSkinPicture, SkinRect, Width, Height,
      LeftStretch, TopStretch, RightStretch, BottomStretch);
  end;
  if NewClRect.Bottom > NewClRect.Top
  then
    ExcludeClipRect(Cnvs.Handle,
      NewClRect.Left, NewClRect.Top, NewClRect.Right, NewClRect.Bottom);

  Cnvs.Draw(0, 0, TopBitMap);
  Cnvs.Draw(0, TopBitMap.Height, LeftBitMap);
  Cnvs.Draw(Width - RightBitMap.Width, TopBitMap.Height, RightBitMap);
  Cnvs.Draw(0, Height - BottomBitMap.Height, BottomBitMap);
  //
  TopBitMap.Free;
  LeftBitMap.Free;
  RightBitMap.Free;
  BottomBitMap.Free;
  Cnvs.Handle := 0;
  if not AUseExternalDC
  then
    ReleaseDC(Handle, DC);
  Cnvs.Free;
end;

procedure TbsSkinButtonGroup.WMSIZE;
begin
  inherited;
  if FShowBorder then PaintBorder(0, False);
end;

procedure TbsSkinButtonGroup.WMNCCALCSIZE;
var
  PanelData: TbsDataSkinPanelControl;
  CIndex: Integer;
begin
  if FShowBorder
  then
    begin
      if (SkinData <> nil) and (not SkinData.Empty) and
         (SkinData.GetControlIndex('panel') <> -1)
      then
        begin
          CIndex := SkinData.GetControlIndex('panel');
          PanelData := TbsDataSkinPanelControl(SkinData.CtrlList[CIndex]);
          with PanelData, TWMNCCALCSIZE(Message).CalcSize_Params^.rgrc[0] do
          begin
            Inc(Left, ClRect.Left);
            Inc(Top,  ClRect.Top);
            Dec(Right, RectWidth(SkinRect) - ClRect.Right);
            Dec(Bottom, RectHeight(SkinRect) - ClRect.Bottom);
            if Right < Left then Right := Left;
            if Bottom < Top then Bottom := Top;
          end;
        end
      else
        begin
          with TWMNCCALCSIZE(Message).CalcSize_Params^.rgrc[0] do
          begin
            Inc(Left, 2);
            Inc(Top,  2);
            Dec(Right, 2);
            Dec(Bottom, 2);
            if Right < Left then Right := Left;
            if Bottom < Top then Bottom := Top;
          end;
        end;
    end
  else
    inherited;
end;

procedure TbsSkinButtonGroup.WMEraseBkgnd;
begin
  if not FromWMPaint
  then
    PaintWindow(Message.DC);
end;

procedure TbsSkinButtonGroup.SetShowBorder;
begin
  if FShowBorder <> Value
  then
    begin
      FShowBorder := Value;
      RecreateWnd;
   end;
end;

function TbsSkinButtonGroup.CreateButton: TbsGrpButtonItem;
begin
  Result := GetButtonClass.Create(FButtonItems);
end;


procedure TbsSkinButtonGroup.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 TbsSkinButtonGroup.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 TbsSkinButtonGroup.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
end;

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

function TbsSkinButtonGroup.GetButtonClass: TbsGrpButtonItemClass;
begin
  Result := TbsGrpButtonItem;
end;

function TbsSkinButtonGroup.GetButtonRect(const Index: Integer): TRect;
var
  ButtonsPerRow: Integer;
  HiddenCount: Integer;
  Item: Integer;
  Row, Col: Integer;
begin
  ButtonsPerRow := CalcButtonsPerRow;
  HiddenCount := FHiddenItems*ButtonsPerRow;
  { Subtract out what we can't see }
  Item := Index - HiddenCount;

  Row := Item div ButtonsPerRow;
  Result.Top := Row*FButtonHeight;
  if bsgboFullSize in FButtonOptions then
  begin
    Result.Left := 0;
    Result.Right := ClientWidth - GetScrollSize;
  end
  else
  begin
    Col := Item mod ButtonsPerRow;
    Result.Left := Col*FButtonWidth;
    Result.Right := Result.Left + FButtonWidth;
  end;
  Result.Bottom := Result.Top + FButtonHeight;
end;

function TbsSkinButtonGroup.GetButtonsClass: TbsGrpButtonItemsClass;
begin
  Result := TbsGrpButtonItems;
end;

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

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

procedure TbsSkinButtonGroup.Paint;
var
  PanelData: TbsDataSkinPanelControl;

procedure DrawSkinBGRect(R: TRect);
var
  w, h, X, Y, XCnt, YCnt: Integer;
  Buffer, Buffer2: TBitMap;
  FSkinPicture: TBitMap;
begin
  if (RectWidth(R) <= 0) or (RectHeight(R) <= 0) then Exit;
  PanelData := TbsDataSkinPanelControl(SkinData.CtrlList[SkinData.GetControlIndex('panel')]);
  Buffer := TBitMap.Create;
  with PanelData do
  begin
    FSkinPicture := TBitMap(SkinData.FActivePictures.Items[PictureIndex]);
    Buffer.Width := RectWidth(ClRect);
    Buffer.Height := RectHeight(ClRect);
    Buffer.Canvas.CopyRect(Rect(0, 0, Buffer.Width, Buffer.Height),
        FSkinPicture.Canvas,
          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;
     if StretchEffect
      then
        begin
          case StretchType of
            bsstFull:
              Canvas.StretchDraw(R, Buffer);
            bsstHorz:
              begin
                Buffer2 := TBitMap.Create;
                Buffer2.Width := Buffer.Width;
                Buffer2.Height := RectHeight(R);
                Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), Buffer);
                XCnt := Width div Buffer2.Width;
                 for X := 0 to XCnt do
                   Canvas.Draw(R.Left + X * Buffer2.Width, R.Top, Buffer2);
                 Buffer2.Free;
              end;
            bsstVert:
              begin
                Buffer2 := TBitMap.Create;
                Buffer2.Width := RectWidth(R);
                Buffer2.Height := Buffer.Height;
                Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), Buffer);
                YCnt := RectHeight(R) div Buffer2.Height;
                for Y := 0 to YCnt do
                  Canvas.Draw(R.Left, R.Top + Y * Buffer2.Height, Buffer2);
                Buffer2.Free;
              end;
          end;
        end
     else
      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
  ButtonCount: Integer;
  RowsSeen, ButtonsPerRow: Integer;
  HiddenCount, VisibleCount: Integer;
  CurOffset: TPoint;
  RowPos: Integer;
  X: Integer;
  ItemRect: TRect;
  ActualWidth, ActualHeight: Integer;
  DrawState: TbsButtonDrawState;
  SaveIndex: Integer;
begin
  //
  Canvas.Brush.Color := clBtnFace;
  //
  ButtonCount := FButtonItems.Count;
  if ButtonCount > 0 then
  begin
    RowsSeen := CalcRowsSeen;
    ButtonsPerRow := CalcButtonsPerRow;
    HiddenCount := FHiddenItems * ButtonsPerRow;
    VisibleCount := RowsSeen*ButtonsPerRow;

    if (HiddenCount + VisibleCount) > ButtonCount then
      VisibleCount := ButtonCount - HiddenCount; { We can see more items than we have }

    CurOffset.X := 0; { Start at the very top left }
    CurOffset.Y := 0;
    RowPos := 0;
    if bsgboFullSize in ButtonOptions then
      ActualWidth := ClientWidth - GetScrollSize
    else
      ActualWidth := FButtonWidth;
    ActualHeight := FButtonHeight;

    for X := HiddenCount to HiddenCount + VisibleCount - 1 do
    begin
      ItemRect := Bounds(CurOffset.X, CurOffset.Y, ActualWidth, ActualHeight);
      DrawState := [];
      if X = FHotIndex then
      begin
        Include(DrawState, bsbdsHot);
        if X = FDownIndex then
          Include(DrawState, bsbdsDown);
      end;
      if X = FItemIndex then
        Include(DrawState, bsbdsSelected);

      if X = FInsertTop then
        Include(DrawState, bsbdsInsertTop)
      else if X = FInsertBottom then
        Include(DrawState, bsbdsInsertBottom)

⌨️ 快捷键说明

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