📄 sputils.~pas
字号:
begin
if j <> 0 then
for i := 0 to RMTop.Width div j do
begin
if NewLTPt.X + i * j + j > NewRTPt.X
then Ofs := NewLTPt.X + i * j + j - NewRTPt.X else Ofs := 0;
CopyRect(Rect(NewLTPt.X + i * j, 0, NewLTPt.X + i * j + j - Ofs, TWidth),
FMask.Canvas,
Rect(LTPt.X, 0, RTPt.X - Ofs, TWidth));
end;
CopyRect(Rect(0, 0, LTPt.X, TWidth), FMask.Canvas,
Rect(0, 0, LTPt.X, TWidth));
CopyRect(Rect(NewRTPt.X, 0, RMTop.Width, TWidth), FMask.Canvas,
Rect(RTPt.X, 0, FMask.Width, TWidth));
end;
end;
// bottom
W := AW;
H := BWidth;
if (W > 0) and (H > 0) then
begin
j := RBPt.X - LBPt.X;
RMBottom.Height := H;
RMBottom.Width := W;
with RMBottom.Canvas do
begin
if j <> 0 then
for i := 0 to RMBottom.Width div j do
begin
if NewLBPt.X + i * j + j > NewRBPt.X
then Ofs := NewLBPt.X + i * j + j - NewRBPt.X else Ofs := 0;
CopyRect(Rect(NewLBPt.X + i * j, 0, NewLBPt.X + i * j + j - Ofs, BWidth),
FMask.Canvas,
Rect(LBPt.X, ClRect.Bottom, RBPt.X - Ofs, FMask.Height));
end;
CopyRect(Rect(0, 0, LBPt.X, BWidth), FMask.Canvas,
Rect(0, ClRect.Bottom, LBPt.X, FMask.Height));
CopyRect(Rect(NewRBPt.X, 0, RMBottom.Width, BWidth), FMask.Canvas,
Rect(RBPt.X, ClRect.Bottom, FMask.Width, FMask.Height));
end;
end;
end;
procedure CreateSkinSimplyRegion(var FRgn: HRgn; FMask: TBitMap);
var
Size: Integer;
RgnData: PRgnData;
begin
Size := CreateRgnFromBmp(FMask, 0, 0, RgnData);
FRgn := ExtCreateRegion(nil, Size, RgnData^);
FreeMem(RgnData, Size);
end;
procedure CreateSkinRegion;
var
RMTop, RMBottom, RMLeft, RMRight: TBitMap;
Size: Integer;
RgnData: PRgnData;
R1, R2, R3, R4: HRGN;
begin
if (NewLtPt.X > NewRTPt.X) or (NewLtPt.Y > NewLBPt.Y)
then
begin
FRgn := 0;
Exit;
end;
RMTop := TBitMap.Create;
RMBottom := TBitMap.Create;
RMLeft := TBitMap.Create;
RMRight := TBitMap.Create;
//
CreateSkinMask(LTPt, RTPt, LBPt, RBPt, ClRect,
NewLtPt, NewRTPt, NewLBPt, NewRBPt, NewClRect,
FMask, RMTop, RMLeft, RMRight, RMBottom,
AW, AH);
//
if (RMTop.Width > 0) and (RMTop.Height > 0)
then
begin
Size := CreateRgnFromBmp(RMTop, 0, 0, RgnData);
R1 := ExtCreateRegion(nil, Size, RgnData^);
FreeMem(RgnData, Size);
end
else
R1 := 0;
if (RMBottom.Width > 0) and (RMBottom.Height > 0)
then
begin
Size := CreateRgnFromBmp(RMBottom, 0, NewClRect.Bottom, RgnData);
R2 := ExtCreateRegion(nil, Size, RgnData^);
FreeMem(RgnData, Size);
end
else
R2 := 0;
if (RMLeft.Width > 0) and (RMleft.Height > 0)
then
begin
Size := CreateRgnFromBmp(RMLeft, 0, NewClRect.Top, RgnData);
R3 := ExtCreateRegion(nil, Size, RgnData^);
FreeMem(RgnData, Size);
end
else
R3 := 0;
if (RMRight.Width > 0) and (RMRight.Height > 0)
then
begin
Size := CreateRgnFromBmp(RMRight, NewClRect.Right, NewClRect.Top, RgnData);
R4 := ExtCreateRegion(nil, Size, RgnData^);
FreeMem(RgnData, Size);
end
else
R4 := 0;
if not isNullRect(NewClRect)
then
FRgn := CreateRectRgn(NewClRect.Left, NewClRect.Top,
NewClRect.Right, NewClRect.Bottom)
else
FRgn := 0;
CombineRgn(R1, R1, R2, RGN_OR);
CombineRgn(R3, R3, R4, RGN_OR);
CombineRgn(R3, R3, R1, RGN_OR);
CombineRgn(FRgn, FRgn, R3, RGN_OR);
DeleteObject(R1);
DeleteObject(R2);
DeleteObject(R3);
DeleteObject(R4);
//
RMTop.Free;
RMBottom.Free;
RMLeft.Free;
RMRight.Free;
end;
procedure DrawGlyph;
var
B: TBitMap;
gw, gh: Integer;
GR: TRect;
begin
if FGlyph.Empty then Exit;
gw := FGlyph.Width div FNumGlyphs;
gh := FGlyph.Height;
B := TBitMap.Create;
B.Width := gw;
B.Height := gh;
GR := Rect(gw * (FGlyphNum - 1), 0, gw * FGlyphNum, gh);
B.Canvas.CopyRect(Rect(0, 0, gw, gh), FGlyph.Canvas, GR);
B.Transparent := True;
Cnvs.Draw(X, Y, B);
B.Free;
end;
procedure CreateSkinBorderImages;
var
XCnt, YCnt, i, X, Y, XO, YO, w, h: Integer;
TB: TBitMap;
TR, TR1: TRect;
begin
// top
w := AW;
h := NewClRect.Top;
if (w > 0) and (h > 0) and (RTPt.X - LTPt.X > 0)
then
begin
TopB.Width := w;
TopB.Height := h;
w := RTPt.X - LTPt.X;
XCnt := TopB.Width div w;
if TS
then
begin
TB := TBitMap.Create;
TR := Rect(R.Left + LTPt.X, R.Top,
R.Left + RTPt.X, R.Top + h);
TR1 := Rect(NewLTPt.X, 0, NewRTPt.X, h);
TB.Width := RectWidth(TR);
TB.Height := RectHeight(TR);
TB.Canvas.CopyRect(Rect(0, 0, TB.Width, TB.Height),
SB.Canvas, TR);
TopB.Canvas.StretchDraw(TR1, TB);
TB.Free;
end
else
for X := 0 to XCnt do
begin
if X * w + w > TopB.Width
then XO := X * w + w - TopB.Width else XO := 0;
with TopB.Canvas do
begin
CopyRect(Rect(X * w, 0, X * w + w - XO, h),
SB.Canvas,
Rect(R.Left + LTPt.X, R.Top,
R.Left + RTPt.X - XO, R.Top + h));
end;
end;
with TopB.Canvas do
begin
CopyRect(Rect(0, 0, NewLTPt.X, h), SB.Canvas,
Rect(R.Left, R.Top, R.Left + LTPt.X, R.Top + h));
CopyRect(Rect(NewRTPt.X, 0, TopB.Width, h), SB.Canvas,
Rect(R.Left + RTPt.X, R.Top, R.Right, R.Top + h));
end;
end;
// bottom
w := AW;
h := AH - NewClRect.Bottom;
if (w > 0) and (h > 0) and (RBPt.X - LBPt.X > 0)
then
begin
BottomB.Width := w;
BottomB.Height := h;
w := RBPt.X - LBPt.X;
XCnt := BottomB.Width div w;
if BS
then
begin
TB := TBitMap.Create;
TR := Rect(R.Left + LBPt.X, R.Bottom - h,
R.Left + RBPt.X, R.Bottom);
TR1 := Rect(NewLBPt.X, 0, NewRBPt.X, h);
TB.Width := RectWidth(TR);
TB.Height := RectHeight(TR);
TB.Canvas.CopyRect(Rect(0, 0, TB.Width, TB.Height),
SB.Canvas, TR);
BottomB.Canvas.StretchDraw(TR1, TB);
TB.Free;
end
else
for X := 0 to XCnt do
begin
if X * w + w > BottomB.Width
then XO := X * w + w - BottomB.Width else XO := 0;
with BottomB.Canvas do
begin
CopyRect(Rect(X * w, 0, X * w + w - XO, h),
SB.Canvas,
Rect(R.Left + LBPt.X, R.Bottom - h,
R.Left + RBPt.X - XO, R.Bottom));
end;
end;
with BottomB.Canvas do
begin
CopyRect(Rect(0, 0, NewLBPt.X, h), SB.Canvas,
Rect(R.Left, R.Bottom - h, R.Left + LBPt.X, R.Bottom));
CopyRect(Rect(NewRBPt.X, 0, BottomB.Width, h), SB.Canvas,
Rect(R.Left + RBPt.X, R.Bottom - h, R.Right, R.Bottom));
end;
end;
// draw left
h := AH - BottomB.Height - TopB.Height;
w := NewClRect.Left;
if (w > 0) and (h > 0) and (LBPt.Y - LTPt.Y > 0)
then
begin
LeftB.Width := w;
LeftB.Height := h;
h := LBPt.Y - LTPt.Y;
YCnt := LeftB.Height div h;
if LS
then
begin
TB := TBitMap.Create;
TR := Rect(R.Left, R.Top + LTPt.Y,
R.Left + w, R.Top + LBPt.Y);
TR1 := Rect(0, LTPt.Y - ClRect.Top, w,
LeftB.Height - (ClRect.Bottom - LBPt.Y));
TB.Width := RectWidth(TR);
TB.Height := RectHeight(TR);
TB.Canvas.CopyRect(Rect(0, 0, TB.Width, TB.Height),
SB.Canvas, TR);
LeftB.Canvas.StretchDraw(TR1, TB);
TB.Free;
end
else
for Y := 0 to YCnt do
begin
if Y * h + h > LeftB.Height
then YO := Y * h + h - LeftB.Height else YO := 0;
with LeftB.Canvas do
CopyRect(Rect(0, Y * h, w, Y * h + h - YO),
SB.Canvas,
Rect(R.Left, R.Top + LTPt.Y, R.Left + w, R.Top + LBPt.Y - YO));
end;
with LeftB.Canvas do
begin
YO := LTPt.Y - ClRect.Top;
if YO > 0
then
CopyRect(Rect(0, 0, w, YO), SB.Canvas,
Rect(R.Left, R.Top + ClRect.Top,
R.Left + w, R.Top + LTPt.Y));
YO := ClRect.Bottom - LBPt.Y;
if YO > 0
then
CopyRect(Rect(0, LeftB.Height - YO, w, LeftB.Height),
SB.Canvas,
Rect(R.Left, R.Top + LBPt.Y,
R.Left + w, R.Top + ClRect.Bottom));
end;
end;
// draw right
h := AH - BottomB.Height - TopB.Height;
w := AW - NewClRect.Right;
if (w > 0) and (h > 0) and (RBPt.Y - RTPt.Y > 0)
then
begin
RightB.Width := w;
RightB.Height := h;
h := RBPt.Y - RTPt.Y;
YCnt := RightB.Height div h;
if RS
then
begin
TB := TBitMap.Create;
TR := Rect(R.Left + ClRect.Right, R.Top + RTPt.Y,
R.Right, R.Top + RBPt.Y);
TR1 := Rect(0, RTPt.Y - ClRect.Top, w,
RightB.Height - (ClRect.Bottom - RBPt.Y));
TB.Width := RectWidth(TR);
TB.Height := RectHeight(TR);
TB.Canvas.CopyRect(Rect(0, 0, TB.Width, TB.Height),
SB.Canvas, TR);
RightB.Canvas.StretchDraw(TR1, TB);
TB.Free;
end
else
for Y := 0 to YCnt do
begin
if Y * h + h > RightB.Height
then YO := Y * h + h - RightB.Height else YO := 0;
with RightB.Canvas do
CopyRect(Rect(0, Y * h, w, Y * h + h - YO),
SB.Canvas,
Rect(R.Left + ClRect.Right, R.Top + RTPt.Y,
R.Right, R.Top + RBPt.Y - YO));
end;
with RightB.Canvas do
begin
YO := RTPt.Y - ClRect.Top;
if YO > 0
then
CopyRect(Rect(0, 0, w, YO), SB.Canvas,
Rect(R.Left + ClRect.Right, R.Top + ClRect.Top,
R.Right, R.Top + RTPt.Y));
YO := ClRect.Bottom - RBPt.Y;
if YO > 0
then
CopyRect(Rect(0, RightB.Height - YO, w, RightB.Height),
SB.Canvas,
Rect(R.Left + ClRect.Right, R.Top + RBPt.Y,
R.Right, R.Top + ClRect.Bottom));
end;
end;
end;
procedure DrawRCloseImage(C: TCanvas; R: TRect; Color: TColor);
var
X, Y: Integer;
begin
X := R.Left + RectWidth(R) div 2 - 5;
Y := R.Top + RectHeight(R) div 2 - 5;
DrawCloseImage(C, X, Y, Color);
end;
procedure DrawCloseImage(C: TCanvas; X, Y: Integer; Color: TColor);
begin
with C do
begin
Pen.Color := Color;
MoveTo(X + 1, Y + 1); LineTo(X + 9, Y + 9);
MoveTo(X + 9, Y + 1); LineTo(X + 1, Y + 9);
MoveTo(X + 2, Y + 1); LineTo(X + 10, Y + 9);
MoveTo(X + 8, Y + 1); LineTo(X, Y + 9);
end;
end;
procedure DrawSysMenuImage(C: TCanvas; X, Y: Integer; Color: TColor);
begin
with C do
begin
Pen.Color := Color;
Brush.Style := bsClear;
Rectangle(X + 1, Y + 3, X + 9, Y + 6);
end;
end;
procedure DrawMinimizeImage(C: TCanvas; X, Y: Integer; Color: TColor);
begin
with C do
begin
Pen.Color := Color;
MoveTo(X + 1, Y + 8); LineTo(X + 9, Y + 8);
MoveTo(X + 1, Y + 9); LineTo(X + 9, Y + 9);
end;
end;
procedure DrawMaximizeImage(C: TCanvas; X, Y: Integer; Color: TColor);
begin
with C do
begin
Brush.Style := bsClear;
Pen.Color := Color;
Rectangle(X, Y, X + 11, Y + 10);
Rectangle(X, Y, X + 11, Y + 2);
end;
end;
procedure DrawRestoreImage(C: TCanvas; X, Y: Integer; Color: TColor);
begin
with C do
begin
Brush.Style := bsClear;
Pen.Color := Color;
Rectangle(X + 2, Y, X + 10, Y + 6);
Rectangle(X + 2, Y, X + 10, Y + 2);
Rectangle(X, Y + 4, X + 7, Y + 10);
Rectangle(X, Y + 4, X + 7, Y + 6);
end;
end;
procedure DrawRestoreRollUpImage(C: TCanvas; X, Y: Integer; Color: TColor);
begin
with C do
begin
Pen.Color := Color;
MoveTo(X + 5, Y + 6); LineTo(X + 5, Y + 6);
MoveTo(X + 4, Y + 5); LineTo(X + 6, Y + 5);
MoveTo(X + 3, Y + 4); LineTo(X + 7, Y + 4);
MoveTo(X + 2, Y + 3); LineTo(X + 8, Y + 3);
MoveTo(X + 1, Y + 2); LineTo(X + 9, Y + 2);
end;
end;
proc
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -