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

📄 bsskintabs.pas

📁 delphi 皮肤控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    begin
      CheckScroll;
    end;
end;

function TbsSkinPageControl.GetItemRect(index: integer): TRect;
var
  R: TRect;
begin
  SendMessage(Handle, TCM_GETITEMRECT, index, Integer(@R));
  Result := R;
  if (Index = 0) and not MultiLine then Result.Left := Result.Left + 1;
end;

procedure TbsSkinPageControl.SetItemSize;
begin
  SendMessage(Handle, TCM_SETITEMSIZE, 0, MakeLParam(AWidth, AHeight));
end;

procedure TbsSkinPageControl.PaintWindow(DC: HDC);
var
  SaveIndex: Integer;
begin
  if (Width <= 0) or (Height <=0) then Exit;
  GetSkinData;
  SaveIndex := SaveDC(DC);
  try
    Canvas.Handle := DC;
    if FIndex = -1
    then
      PaintDefaultWindow(Canvas)
    else
      PaintSkinWindow(Canvas);
    DrawTabs(Canvas);
    Canvas.Handle := 0;
  finally
    RestoreDC(DC, SaveIndex);
  end;
end;

procedure TbsSkinPageControl.TestActive(X, Y: Integer);
var
  i, j, k: Integer;
  R: TRect;
begin
  FOldActiveTab := FActiveTab;
  FOldActiveTabIndex := FActiveTabIndex;
  k := -1;
  j := -1;
  for i := 0 to PageCount - 1 do
  if Pages[i].TabVisible then
  begin
    Inc(k);
    R := GetItemRect(k);
    if PtInRect(R, Point(X, Y))
    then
      begin
        j := k;
        Break;
      end;
  end;

  FActiveTab := i;
  FActiveTabIndex := j;

  if (FOldActiveTabIndex <> FActiveTabIndex)
  then
    begin
      if (FOldActiveTabIndex <> - 1) and (FOldActiveTabIndex <> TabIndex) and
         (FOldActiveTabIndex < PageCount)
      then
        begin
          R := GetItemRect(FOldActiveTabIndex);
          DrawTab(FOldActiveTab, R, False, False, Canvas);
        end;
      if (FActiveTabIndex <> -1) and (FActiveTabIndex <> TabIndex) and
         (FActiveTabIndex < PageCount)
      then
        begin
          R := GetItemRect(FActiveTabIndex);
          DrawTab(FActiveTab, R, False, True, Canvas );
        end;
    end;
end;

procedure TbsSkinPageControl.DrawTabs;
var
  i, j: integer;
  IR: TRect;
  w, h, XCnt, YCnt, X, Y, TOff, LOff, Roff, BOff: Integer;
  Rct, R, DR: TRect;
  Buffer, Buffer2: TBitMap;
  ATabIndex: Integer;
begin
  //
  if PageCount = 0 then Exit;
  if FIndex = -1
  then
    begin
      j := -1;
      for i := 0 to PageCount-1 do
      if Pages[i].TabVisible then
      begin
        inc(j);
        R := GetItemRect(j);
        DrawTab(i, R, (j = TabIndex), j = FActiveTabIndex, Cnvs);
      end;
      Exit;
    end;
  //
  GetSkinData;
  TOff := ClRect.Top;
  LOff := ClRect.Left;
  ROff := RectWidth(SkinRect) - ClRect.Right;
  BOff := RectHeight(SkinRect) - ClRect.Bottom;
  DR := Self.DisplayRect;
  R := Rect(DR.Left - LOff, DR.Top - TOff, DR.Right + ROff, DR.Bottom + BOff);
  Buffer := TBitMap.Create;
  case TabPosition of
    tpTop:
      begin
        Buffer.Width := Width;
        Buffer.Height := R.Top;
      end;
    tpBottom:
      begin
        Buffer.Width := Width;
        Buffer.Height := Height - R.Bottom;
      end;
    tpRight:
      begin
        Buffer.Width := Width - R.Right;
        Buffer.Height := Height;
      end;
    tpLeft:
      begin
        Buffer.Width := R.Left;
        Buffer.Height := Height;
      end;
  end;
  // draw tabsbg
  if IsNullRect(TabsBGRect)
  then
    begin
      TabsBGRect := ClRect;
      OffsetRect(TabsBGRect, SkinRect.Left, SkinRect.Top);
    end;
  w := RectWidth(TabsBGRect);
  h := RectHeight(TabsBGRect);
  XCnt := Buffer.Width div w;
  YCnt := Buffer.Height div h;
  if not TabsBGTransparent
  then
    begin
      Buffer2 := TBitMap.Create;
      Buffer2.Width := w;
      Buffer2.Height := h;
      Buffer2.Canvas.CopyRect(Rect(0, 0, w, h), Picture.Canvas, TabsBGRect);
      for X := 0 to XCnt do
      for Y := 0 to YCnt do
      begin
       Buffer.Canvas.Draw(X * w, Y * h, Buffer2);
      end;
      Buffer2.Free;
    end
  else
    begin
      case TabPosition of
        tpTop:
          Rct := Rect(0, 0, Width, R.Top);
        tpBottom:
          Rct := Rect(0, Height - R.Bottom, Width, Height);
        tpRight:
          Rct := Rect(Width - R.Right, 0, Width, Height);
        tpLeft:
          Rct := Rect(0, 0, R.Left, R.Bottom);
      end;
      GetParentImageRect(Self, Rct, Buffer.Canvas);
    end;
  //
  j := -1;
  ATabIndex := 0;
  for i := 0 to PageCount-1 do
  if Pages[I].TabVisible then
  begin
    inc(j);
    IR := GetItemRect(j);
    case TabPosition of
    tpTop:
      begin
      end;
    tpBottom:
      begin
        OffsetRect(IR, 0, -R.Bottom);
      end;
    tpRight:
      begin
        OffsetRect(IR, - R.Right, 0);
      end;
    tpLeft:
      begin
                            
      end;
     end;
    DrawTab(i, IR, (j = TabIndex), j = FActiveTabIndex, Buffer.Canvas);
    if j = TabIndex then ATabIndex := i;
  end;
 case TabPosition of
    tpTop:
      begin
        Cnvs.Draw(0, 0, Buffer);
      end;
    tpBottom:
      begin
        Cnvs.Draw(0, Height - Buffer.Height, Buffer);
      end;
    tpRight:
      begin
        Cnvs.Draw(Width - Buffer.Width, 0, Buffer);
      end;
    tpLeft:
      begin
        Cnvs.Draw(0, 0, Buffer);
      end;
  end;
  Buffer.Free;
  if (ATabIndex <> -1) and (TabIndex <> -1) and (TabIndex >= 0) and (TabIndex < PageCount)
  then
    begin
      IR := GetItemRect(TabIndex);
      if (FIndex <> -1) and (RectHeight(TabRect) <> RectHeight(ActiveTabRect))
      then
        begin
          if (TabPosition = tpBottom) then OffsetRect(IR, 0, -1) else
          if (TabPosition = tpRight) then OffsetRect(IR, -1, 0);
        end;
      DrawTab(ATabIndex, IR, True, TabIndex = FActiveTabIndex, Cnvs);
    end;
end;

procedure TbsSkinPageControl.DrawTab;
var
  R, R1: TRect;
  S: String;
  TB, BufferTB: TBitMap;
  DrawGlyph: Boolean;
  W, H: Integer;
begin
  if TI > PageCount - 1 then Exit;
  DrawGlyph := (Images <> nil) and (TI < Images.Count);
  S := Pages[TI].Caption;
  if (TabPosition = tpTop) or (TabPosition = tpBottom)
  then
    begin
      W := RectWidth(Rct);
      H := RectHeight(Rct);
    end
  else
    begin
      H := RectWidth(Rct);
      W := RectHeight(Rct);
    end;
  if (W <= 0) or (H <= 0) then Exit;
  TB := TBitMap.Create;
  TB.Width := W;
  TB.Height := H;
  R := Rect(0, 0, W, H);
  if FIndex <> -1
  then
    begin
      if TabHeight <= 0
      then
        begin
          if MouseIn and not Active and not IsNullRect(MouseInTabRect)
          then
            CreateHSkinImage(TabLeftOffset, TabRightOffset,
             TB, Picture, MouseInTabRect, W, H, TabStretchEffect)
          else
            if Active and Focused
          then
           CreateHSkinImage(TabLeftOffset, TabRightOffset,
            TB, Picture, FocusTabRect, W, H, TabStretchEffect)
          else
          if Active
          then
            CreateHSkinImage(TabLeftOffset, TabRightOffset,
              TB, Picture, ActiveTabRect, W, H, TabStretchEffect)
          else
            CreateHSkinImage(TabLeftOffset, TabRightOffset,
             TB, Picture, TabRect, W, H, TabStretchEffect); 
       end
     else
       begin
         BufferTB := TBitMap.Create;
         BufferTB.Width := W;
         BufferTB.Height := RectHeight(TabRect);
         if MouseIn and not Active and not IsNullRect(MouseInTabRect)
          then
            CreateHSkinImage(TabLeftOffset, TabRightOffset,
             BufferTB, Picture, MouseInTabRect, W, H, TabStretchEffect)
          else
            if Active and Focused
          then
           CreateHSkinImage(TabLeftOffset, TabRightOffset,
            BufferTB, Picture, FocusTabRect, W, H, TabStretchEffect)
          else
          if Active
          then
            CreateHSkinImage(TabLeftOffset, TabRightOffset,
              BufferTB, Picture, ActiveTabRect, W, H, TabStretchEffect)
          else
            CreateHSkinImage(TabLeftOffset, TabRightOffset,
             BufferTB, Picture, TabRect, W, H, TabStretchEffect);
         TB.Width := W;
         TB.Height := H;
         TB.Canvas.StretchDraw(R, BufferTB);
         BufferTB.Free;
       end;
      if TabPosition = tpBottom then DrawFlipVert(TB);
      with TB.Canvas do
      begin
        Brush.Style := bsClear;
        if FUseSkinFont
        then
          begin
            Font.Name := FontName;
            Font.Style := FontStyle;
            Font.Height := FontHeight;
          end
        else
           Font.Assign(Self.Font);
        if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
        then
          Font.Charset := SkinData.ResourceStrData.CharSet
        else
          Font.CharSet := Self.Font.CharSet;
        if MouseIn and not Active
        then
          Font.Color := MouseInFontColor
        else
        if Active and Focused
        then
          Font.Color := FocusFontColor
        else
          if Active
          then Font.Color := ActiveFontColor
          else Font.Color := FontColor;
      end;
    end
  else
    begin
      TB.Width := W;
      TB.Height := H;
      if MouseIn and not Active
      then
        begin
          TB.Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
          TB.Canvas.FillRect(R);
        end
      else
      if Active and Focused
      then
        begin
          Frame3D(TB.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
          TB.Canvas.Brush.Color := BS_XP_BTNDOWNCOLOR;
          TB.Canvas.FillRect(R);
        end
      else
      if Active
      then
        begin
          Frame3D(TB.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
          TB.Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
          TB.Canvas.FillRect(R);
        end
      else
        begin
          TB.Canvas.Brush.Color := clBtnFace;
          TB.Canvas.FillRect(R);
        end;
      with TB.Canvas do
      begin
        Brush.Style := bsClear;
        Font.Assign(Self.Font);
        if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
        then
          Font.Charset := SkinData.ResourceStrData.CharSet;
      end;
    end;
  //
  if (FIndex <> -1) and ShowFocus and Focused and Active
  then
    begin
      R1 := R;
      InflateRect(R1, -FocusOffsetX, -FocusOffsetY);
      TB.Canvas.Brush.Style := bsSolid;
      TB.Canvas.Brush.Color := FSD.SkinColors.cBtnFace;
      TB.Canvas.DrawFocusRect(R1);
      TB.Canvas.Brush.Style := bsClear;
    end;
  //
  if (FIndex <> -1) and (RectHeight(TabRect) <> RectHeight(ActiveTabRect)) and
     not Active
  then
    begin
      if (TabPosition = tpTop) or (TabPosition = tpLeft)
      then
        R.Top := R.Top + 1
      else
        R.Top := R.Top - 1;
    end;
  //
  if Assigned(Self.FOnDrawSkinTab)
  then
    begin
      FOnDrawSkinTab(TI, Rect(0, 0, TB.Width, TB.Height), Active, MouseIn, TB.Canvas);
    end
  else
  if DrawGlyph
  then
    DrawTabGlyphAndText(TB.Canvas, TB.Width, TB.Height, S,
                        Images, Pages[TI].ImageIndex, Pages[TI].Enabled)
  else
    DrawText(TB.Canvas.Handle, PChar(S), Length(S), R, DT_CENTER or DT_SINGLELINE or DT_VCENTER);


  if TabPosition = tpLeft
  then
    DrawRotate90_1(Cnvs, TB, Rct.Left, Rct.Top)
  else
  if TabPosition = tpRight
  then
    DrawRotate90_2(Cnvs, TB, Rct.Left, Rct.Top)
  else
    Cnvs.Draw(Rct.Left, Rct.Top, TB);
  TB.Free;
end;


{ TbsSkinTabControl }

constructor TbsSkinTabControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTabsBGTransparent := False;
  FromWMPaint := False;
  Ctl3D := False;
  FIndex := -1;
  Picture := nil;
  Font.Name := 'Arial';
  Font.Style := [];
  Font.Color := clBtnText;
  Font.Height := 14;
  FOldTop := 0;
  FOldBottom := 0;
  FSkinUpDown := nil;
  FSkinDataName := 'tab';
  FDefaultFont := TFont.Create;
  FDefaultFont.Name := 'Arial';
  FDefaultFont.Style := [];
  FDefaultFont.Color := clBtnText;
  FDefaultFont.Height := 14;
  FDefaultItemHeight := 20;
  FUseSkinFont := True;
  TabStretchEffect := False;

⌨️ 快捷键说明

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