?? bsskintabs.pas
字號:
procedure DrawTabGlyphAndText(Cnvs: TCanvas; W, H: Integer; S: String;
IM: TCustomImageList; IMIndex: Integer;
AEnabled: Boolean; TopOffset: Integer);
var
R, TR: TRect;
GX, GY, GW, GH, TW, TH: Integer;
begin
R := Rect(0, 0, 0, 0);
DrawText(Cnvs.Handle, PChar(S), Length(S), R, DT_CALCRECT);
TW := RectWidth(R) + 2;
TH := RectHeight(R);
GW := IM.Width;
GH := IM.Height;
GX := (W) div 2 - (GW + TW + 2) div 2;
GY := H div 2 - GH div 2 + TopOffset;
TR.Left := GX + GW + 2;
TR.Top := H div 2 - TH div 2 + TopOffset;
TR.Right := TR.Left + TW;
TR.Bottom := TR.Top + TH;
DrawText(Cnvs.Handle, PChar(S), Length(S), TR, DT_CENTER);
IM.Draw(Cnvs, GX, GY, IMIndex, AEnabled);
end;
constructor TbsSkinCustomTabSheet.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Align := alClient;
ControlStyle := ControlStyle + [csAcceptsControls, csNoDesignVisible];
Visible := False;
FWallPaper := TBitMap.Create;
ButtonMouseIn := False;
ButtonMouseDown := False;
end;
procedure TbsSkinCustomTabSheet.CMSENCPaint(var Message: TMessage);
begin
Message.Result := SE_RESULT;
end;
procedure TbsSkinCustomTabSheet.CheckControlsBackground;
var
i: Integer;
begin
for i := 0 to ControlCount - 1 do
begin
if Controls[i] is TWinControl
then
SendMessage(TWinControl(Controls[i]).Handle, WM_CHECKPARENTBG, 0, 0);
end;
end;
procedure TbsSkinCustomTabSheet.SetWallPaper(Value: TBitmap);
begin
FWallPaper.Assign(Value);
if (csDesigning in ComponentState) then RePaint;
end;
procedure TbsSkinCustomTabSheet.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params.WindowClass do
Style := Style and not (CS_HREDRAW or CS_VREDRAW);
end;
destructor TbsSkinCustomTabSheet.Destroy;
begin
PageControl := nil;
FWallPaper.Free;
inherited Destroy;
end;
procedure TbsSkinCustomTabSheet.WMEraseBkGnd;
begin
PaintBG(Msg.DC);
end;
procedure TbsSkinCustomTabSheet.WMSize;
var
PC: TbsSkinPageControl;
begin
inherited;
RePaint;
PC := TbsSkinPageControl(Parent);
if (PC <> nil) and (PC.SkinData <> nil) and
(not PC.SkinData.Empty) and (PC.StretchEffect)
then
CheckControlsBackground;
end;
procedure TbsSkinCustomTabSheet.PaintBG;
var
C: TCanvas;
TabSheetBG, Buffer2: TBitMap;
PC: TbsSkinPageControl;
X, Y, XCnt, YCnt, w, h, w1, h1: Integer;
begin
if (Width <= 0) or (Height <=0) then Exit;
PC := TbsSkinPageControl(Parent);
if PC = nil then Exit;
PC.GetSkinData;
C := TCanvas.Create;
C.Handle := DC;
if not FWallPaper.Empty
then
begin
if (Width > 0) and (Height > 0)
then
begin
XCnt := Width div FWallPaper.Width;
YCnt := Height div FWallPaper.Height;
for X := 0 to XCnt do
for Y := 0 to YCnt do
C.Draw(X * FWallPaper.Width, Y * FWallPaper.Height, FWallPaper);
end;
C.Free;
Exit;
end;
if (PC.FSD <> nil) and (not PC.FSD.Empty) and
(PC.FIndex <> -1) and (PC.BGPictureIndex <> -1)
then
begin
TabSheetBG := TBitMap(PC.FSD.FActivePictures.Items[PC.BGPictureIndex]);
if PC.StretchEffect and (Width > 0) and (Height > 0)
then
begin
case PC.StretchType of
bsstFull:
begin
C.StretchDraw(Rect(0, 0, Width, Height), TabSheetBG);
end;
bsstVert:
begin
Buffer2 := TBitMap.Create;
Buffer2.Width := Width;
Buffer2.Height := TabSheetBG.Height;
Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), TabSheetBG);
YCnt := Height div Buffer2.Height;
for Y := 0 to YCnt do
C.Draw(0, Y * Buffer2.Height, Buffer2);
Buffer2.Free;
end;
bsstHorz:
begin
Buffer2 := TBitMap.Create;
Buffer2.Width := TabSheetBG.Width;
Buffer2.Height := Height;
Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), TabSheetBG);
XCnt := Width div Buffer2.Width;
for X := 0 to XCnt do
C.Draw(X * Buffer2.Width, 0, Buffer2);
Buffer2.Free;
end;
end;
end
else
if (Width > 0) and (Height > 0)
then
begin
XCnt := Width div TabSheetBG.Width;
YCnt := Height div TabSheetBG.Height;
for X := 0 to XCnt do
for Y := 0 to YCnt do
C.Draw(X * TabSheetBG.Width, Y * TabSheetBG.Height, TabSheetBG);
end;
C.Free;
Exit;
end;
w1 := Width;
h1 := Height;
if PC.FIndex <> -1
then
with PC do
begin
TabSheetBG := TBitMap.Create;
TabSheetBG.Width := RectWidth(ClRect);
TabSheetBG.Height := RectHeight(ClRect);
TabSheetBG.Canvas.CopyRect(Rect(0, 0, TabSheetBG.Width, TabSheetBG.Height),
PC.Picture.Canvas,
Rect(SkinRect.Left + ClRect.Left, SkinRect.Top + ClRect.Top,
SkinRect.Left + ClRect.Right,
SkinRect.Top + ClRect.Bottom));
if PC.StretchEffect and (Width > 0) and (Height > 0)
then
begin
case PC.StretchType of
bsstFull:
begin
C.StretchDraw(Rect(0, 0, Width, Height), TabSheetBG);
end;
bsstVert:
begin
Buffer2 := TBitMap.Create;
Buffer2.Width := Width;
Buffer2.Height := TabSheetBG.Height;
Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), TabSheetBG);
YCnt := Height div Buffer2.Height;
for Y := 0 to YCnt do
C.Draw(0, Y * Buffer2.Height, Buffer2);
Buffer2.Free;
end;
bsstHorz:
begin
Buffer2 := TBitMap.Create;
Buffer2.Width := TabSheetBG.Width;
Buffer2.Height := Height;
Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), TabSheetBG);
XCnt := Width div Buffer2.Width;
for X := 0 to XCnt do
C.Draw(X * Buffer2.Width, 0, Buffer2);
Buffer2.Free;
end;
end;
end
else
begin
w := RectWidth(ClRect);
h := RectHeight(ClRect);
XCnt := w1 div w;
YCnt := h1 div h;
for X := 0 to XCnt do
for Y := 0 to YCnt do
C.Draw(X * w, Y * h, TabSheetBG);
end;
TabSheetBG.Free;
end
else
with C do
begin
Brush.Color := clbtnface;
FillRect(Rect(0, 0, w1, h1));
end;
C.Free;
end;
{TTabSheetes}
constructor TbsSkinTabSheet.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
end;
destructor TbsSkinTabSheet.Destroy;
begin
inherited Destroy;
end;
procedure TbsSkinTabSheet.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
end;
{ TbsSkinPageControl }
constructor TbsSkinPageControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
//
FHideTabs := False;
FOldTabHeight := -1;
FFreeOnClose := False;
FIsVistaOS := IsVistaOS;
FImages := nil;
FTempImages := TCustomImageList.Create(self);
FTempImages.Width := 1;
FTempImages.Height := 1;
inherited Images := FTempImages;
//
FTabsBGTransparent := False;
Ctl3D := False;
FIndex := -1;
Picture := nil;
Font.Name := 'Arial';
Font.Style := [];
Font.Color := clBtnText;
Font.Height := 14;
FSkinUpDown := nil;
FSkinDataName := 'tab';
FDefaultFont := TFont.Create;
FDefaultFont.Name := 'Arial';
FDefaultFont.Style := [];
FDefaultFont.Color := clBtnText;
FDefaultFont.Height := 14;
FDefaultItemHeight := 20;
FActiveTab := -1;
FOldActiveTab := -1;
FActiveTabIndex := -1;
FOldActiveTabIndex := -1;
FUseSkinFont := True;
FCloseSize := CLOSE_SIZE;
end;
destructor TbsSkinPageControl.Destroy;
begin
FTempImages.Free;
FDefaultFont.Free;
inherited Destroy;
end;
procedure TbsSkinPageControl.CMSENCPaint(var Message: TMessage);
begin
Message.Result := SE_RESULT;
end;
procedure TbsSkinPageControl.HideTabs;
function CanHide: Boolean;
var
i: Integer;
begin
Result := False;
if PageCount = 0
then
Result := False
else
begin
for i := 0 to PageCount - 1 do
begin
if Pages[i].TabVisible
then
begin
Result := True;
Break;
end;
end;
end;
end;
begin
if (FOldTabHeight = -1) and CanHide
then
begin
FHideTabs := True;
FOldTabPosition := TabPosition;
FOldMultiLine := Multiline;
if (TabPosition = tpLeft) or (TabPosition = tpRight)
then
TabPosition := tpTop;
if MultiLine = True then MultiLine := False;
FOldTabHeight := TabHeight;
TabHeight := 1;
if FSkinUpDown <> nil then HideSkinUpDown;
end;
end;
procedure TbsSkinPageControl.ShowTabs;
begin
if FOldTabHeight <> -1
then
begin
TabPosition := FOldTabPosition;
MultiLine := FOldMultiline;
FHideTabs := False;
TabHeight := FOldTabHeight;
if (TabHeight <= 0) and (FIndex <> -1)
then
SetItemSize(TabWidth, RectHeight(TabRect));
FOldTabHeight := -1;
if not MultiLine then CheckScroll;
end;
end;
function TbsSkinPageControl.GetCloseSize;
begin
if (FIndex <> -1) and not IsNullRect(CloseButtonRect)
then
Result := RectWidth(CloseButtonRect)
else
Result := CLOSE_SIZE;
end;
procedure TbsSkinPageControl.DoClose;
var
I: TTabSheet;
CanClose: Boolean;
P: TPoint;
begin
I := ActivePage;
CanClose := True;
if Assigned(FOnClose) then FOnClose(I, CanClose);
if CanClose
then
begin
I.TabVisible := False;
if FFreeOnClose then I.Free;
if Assigned(FOnAfterClose) then FOnAfterClose(Self);
end;
if CanClose = False
then
begin
GetCursorPos(P);
if Windows.WindowFromPoint(P) <> Self.Handle
then
begin
TbsSkinCustomTabSheet(I).ButtonMouseIn := False;
TbsSkinCustomTabSheet(I).ButtonMouseDown := False;
DrawTabs(Canvas);
end;
end;
end;
procedure TbsSkinPageControl.DrawCloseButton(Cnvs: TCanvas; R: TRect;
I, W, H: Integer);
var
Buffer: TBitMap;
CIndex: Integer;
BtnSkinPicture: TBitMap;
BtnLtPoint, BtnRTPoint, BtnLBPoint, BtnRBPoint: TPoint;
BtnCLRect: TRect;
BSR, ABSR, DBSR, R1: TRect;
CIX, CIY, X, Y, XO, YO: Integer;
ButtonData: TbsDataSkinButtonControl;
ButtonR, R2: TRect;
begin
if FIndex = -1
then
begin
X := R.Left;
Y := R.Top + RectHeight(R) div 2 - CLOSE_SIZE div 2;
ButtonR := Rect(X, Y, X + CLOSE_SIZE, Y + CLOSE_SIZE);
CIX := ButtonR.Left + 2;
CIY := ButtonR.Top + 2;
if TbsSkinCustomTabSheet(Self.Pages[I]).ButtonMouseDown and
TbsSkinCustomTabSheet(Self.Pages[I]).ButtonMouseIn
then
DrawCloseImage(Cnvs, CIX, CIY, clWhite)
else
if TbsSkinCustomTabSheet(Self.Pages[I]).ButtonMouseIn
then
begin
DrawCloseImage(Cnvs, CIX, CIY, clWhite)
end
else
begin
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -