📄 bsskintabs.pas
字号:
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 + -