📄 sputils.~pas
字号:
begin
S := IniFile.ReadString(Section, Ident, 'tacenter');
if S = 'tacenter' then Result := taCenter else
if S = 'taleftjustify' then Result := taLeftJustify else
Result := taRightJustify;
end;
procedure WriteAlignment;
var
S: String;
begin
if A = taCenter then S := 'tacenter' else
if A = taLeftJustify then S := 'taleftjustify' else
S := 'tarightjustify';
IniFile.WriteString(Section, Ident, S);
end;
{ TFBitmap }
constructor TFBitmap.Create(HBmp:Integer);
var
Bmp: Windows.TBITMAP;
memDC: Integer;
begin
GetObject(hBmp,SizeOf(Bmp),@Bmp);
Width:=Bmp.bmWidth;
Height:=Bmp.bmHeight;
Size:=((Width*3)+(Width mod 4))*Height;
with bmHeader do
begin
biSize:=SizeOf(bmHeader);
biWidth:=Width;
biHeight:=-Height;
biPlanes:=1;
biBitCount:=24;
biCompression:=BI_RGB;
end;
bmInfo.bmiHeader:=bmHeader;
Handle:=CreateDIBSection(0,
bmInfo,
DIB_RGB_COLORS,
Bits, 0, 0);
memDC:=GetDC(0);
GetDIBits(memDC,hBmp,0,Height,Bits,bmInfo,DIB_RGB_COLORS);
ReleaseDC(0,memDC);
Initialize;
end;
destructor TFBitmap.Destroy;
begin
DeleteDC(hDC);
DeleteObject(Handle);
FreeMem(Pixels);
inherited;
end;
procedure TFBitmap.Initialize;
var
x,i: Integer;
begin
GetMem(Pixels,Height*SizeOf(PBLine));
RowInc:=(Width*3)+Width mod 4;
Gap:=Width mod 4;
Size:=RowInc*Height;
x:=Integer(Bits);
for i:=0 to Height-1 do
begin
Pixels[i]:=Pointer(x);
Inc(x,RowInc);
end;
hDC:=CreateCompatibleDC(0);
SelectObject(hDC,Handle);
end;
// Region convert
function CreateRgnFromBmp(B: TBitmap; XO, YO: Integer; var RgnData: PRgnData): integer;
const
max = 10000;
var
j, i, i1: integer;
C: TFBColor;
FB: TFBitmap;
Rts: array [0..max] of TRect;
Count: integer;
begin
Result := 0;
If B.Empty Then Exit;
Count := 0;
FB := TFBitmap.Create(B.Handle);
for j := 0 to FB.Height - 1 do
begin
i := 0;
while i < FB.Width do
begin
C := FB.Pixels[j, i];
If C.R + C.G + C.B = 0 Then
begin
i1 := i;
C := FB.Pixels[j, i1];
while C.R + C.G + C.B = 0 do
begin
Inc(i1);
If i1 > FB.Width - 1 Then Break else C := FB.Pixels[j, i1];
end;
Rts[Count] := Rect(i + XO, j + YO, i1 + XO, j + 1 + YO);
Inc(Count);
i := i1;
Continue;
end;
Inc(i);
end;
end;
FB.Free;
// Make Region data
Result := Count*SizeOf(TRect);
GetMem(Rgndata, SizeOf(TRgnDataHeader)+Result);
FillChar(Rgndata^, SizeOf(TRgnDataHeader)+Result, 0);
RgnData^.rdh.dwSize := SizeOf(TRgnDataHeader);
RgnData^.rdh.iType := RDH_RECTANGLES;
RgnData^.rdh.nCount := Count;
RgnData^.rdh.nRgnSize := 0;
RgnData^.rdh.rcBound := Rect(0 + XO, 0 + YO, B.Width + XO, B.Height + YO);
// Update New Region
Move(Rts, RgnData^.Buffer, Result);
Result := SizeOf(TRgnDataHeader)+Count*SizeOf(TRect);
end;
procedure WriteStringToStream(Str: String; S: TStream);
var
L: Integer;
begin
L := Length(Str);
S.Write(L, SizeOf(Integer));
S.Write(Pointer(Str)^, L);
end;
procedure ReadStringFromStream(var Str: String; S: TStream);
var
L: Integer;
begin
L := 0;
S.Read(L, SizeOf(Integer));
SetLength(Str, L);
S.Read(Pointer(Str)^, L);
end;
procedure CreateStrechImage(B: TBitMap; SB: TBitMap; R: TRect; ClRect: TRect);
var
R1, R2, R3, R4, R5, R6, R7, R8, R9: TRect;
R11, R22, R33, R44, R55, R66, R77, R88, R99: TRect;
ClRect1: TRect;
begin
ClRect1 := ClRect;
ClRect1.Right := B.Width - (RectWidth(R) - ClRect.Right);
ClRect1.Bottom := B.Height - (RectHeight(R) - ClRect.Bottom);
//
R1 := Rect(0, 0, ClRect1.Left, ClRect1.Top);
R2 := Rect(ClRect1.Left, 0, ClRect1.Right, ClRect1.Top);
R3 := Rect(ClRect1.Right, 0, B.Width, ClRect1.Top);
R4 := Rect(ClRect1.Right, ClRect1.Top, B.Width, ClRect1.Bottom);
R5 := Rect(ClRect1.Right, ClRect1.Bottom, B.Width, B.Height);
R6 := Rect(ClRect1.Left, ClRect1.Bottom, ClRect1.Right, B.Height);
R7 := Rect(0, ClRect1.Bottom, ClRect1.Left, B.Height);
R8 := Rect(0, ClREct1.Top, ClRect1.Left, ClRect1.Bottom);
R9 := ClRect1;
//
R11 := Rect(0, 0, ClRect.Left, ClRect.Top);
R22 := Rect(ClRect.Left, 0, ClRect.Right, ClRect.Top);
R33 := Rect(ClRect.Right, 0, RectWidth(R), ClRect.Top);
R44 := Rect(ClRect.Right, ClRect.Top, RectWidth(R), ClRect.Bottom);
R55 := Rect(ClRect.Right, ClRect.Bottom, RectWidth(R), RectHeight(R));
R66 := Rect(ClRect.Left, ClRect.Bottom, ClRect.Right, RectHeight(R));
R77 := Rect(0, ClRect.Bottom, ClRect.Left, RectHeight(R));
R88 := Rect(0, ClREct.Top, ClRect.Left, ClRect.Bottom);
R99 := ClRect;
OffsetRect(R11, R.Left, R.Top);
OffsetRect(R22, R.Left, R.Top);
OffsetRect(R33, R.Left, R.Top);
OffsetRect(R44, R.Left, R.Top);
OffsetRect(R55, R.Left, R.Top);
OffsetRect(R66, R.Left, R.Top);
OffsetRect(R77, R.Left, R.Top);
OffsetRect(R88, R.Left, R.Top);
OffsetRect(R99, R.Left, R.Top);
//
B.Canvas.CopyRect(R1, SB.Canvas, R11);
B.Canvas.CopyRect(R2, SB.Canvas, R22);
B.Canvas.CopyRect(R3, SB.Canvas, R33);
B.Canvas.CopyRect(R4, SB.Canvas, R44);
B.Canvas.CopyRect(R5, SB.Canvas, R55);
B.Canvas.CopyRect(R6, SB.Canvas, R66);
B.Canvas.CopyRect(R7, SB.Canvas, R77);
B.Canvas.CopyRect(R8, SB.Canvas, R88);
B.Canvas.CopyRect(R9, SB.Canvas, R99);
end;
procedure CreateHSkinImage;
var
X, XCnt, w, XO: Integer;
R1: TRect;
begin
B.Width := AW;
B.Height := RectHeight(R);
with B.Canvas do
begin
if LO <> 0 then
CopyRect(Rect(0, 0, LO, B.Height), SB.Canvas,
Rect(R.Left, R.Top, R.Left + LO, R.Bottom));
if RO <> 0 then
CopyRect(Rect(B.Width - RO, 0, B.Width, B.Height),
SB.Canvas,
Rect(R.Right - RO, R.Top, R.Right, R.Bottom));
Inc(R.Left, LO);
Dec(R.Right, RO);
w := RectWidth(R);
if w = 0 then w := 1;
XCnt := (B.Width - LO - RO) div w;
if AStretch
then
begin
R1 := Rect(LO, 0, B.Width - RO, B.Height);
B.Canvas.CopyRect(R1, SB.Canvas, R);
end
else
for X := 0 to XCnt do
begin
if LO + X * w + w > B.Width - RO
then XO := LO + X * w + w - (B.Width - RO)
else XO := 0;
B.Canvas.CopyRect(Rect(LO + X * w, 0, LO + X * w + w - XO,
B.Height),
SB.Canvas,
Rect(R.Left, R.Top, R.Right - XO, R.Bottom));
end;
end;
end;
procedure CreateHSkinImage2;
var
X, XCnt, w, XO: Integer;
R1: TRect;
begin
B.Width := AW;
B.Height := RectHeight(R);
with B.Canvas do
begin
if LO <> 0 then
CopyRect(Rect(0, 0, LO, B.Height), SB.Canvas,
Rect(R.Left, R.Top, R.Left + LO, R.Bottom));
Inc(R.Left, LO);
Dec(R.Right, RO);
w := RectWidth(R);
if w = 0 then w := 1;
XCnt := (B.Width - LO) div w;
if AStretch
then
begin
R1 := Rect(LO, 0, B.Width, B.Height);
B.Canvas.CopyRect(R1, SB.Canvas, R);
end
else
for X := 0 to XCnt do
begin
if LO + X * w + w > B.Width
then XO := LO + X * w + w - B.Width
else XO := 0;
B.Canvas.CopyRect(Rect(LO + X * w, 0, LO + X * w + w - XO,
B.Height),
SB.Canvas,
Rect(R.Left, R.Top, R.Right - XO, R.Bottom));
end;
end;
end;
procedure CreateHSkinImage3;
var
X, XCnt, w, XO: Integer;
R1: TRect;
begin
B.Width := AW;
B.Height := RectHeight(R);
with B.Canvas do
begin
Inc(R.Left, LO);
Dec(R.Right, RO);
w := RectWidth(R);
if w = 0 then w := 1;
XCnt := B.Width div w;
if AStretch
then
begin
R1 := Rect(0, 0, B.Width, B.Height);
B.Canvas.CopyRect(R1, SB.Canvas, R);
end
else
for X := 0 to XCnt do
begin
if LO + X * w + w > B.Width
then XO := LO + X * w + w - B.Width
else XO := 0;
B.Canvas.CopyRect(Rect(X * w, 0, X * w + w - XO,
B.Height),
SB.Canvas,
Rect(R.Left, R.Top, R.Right - XO, R.Bottom));
end;
end;
end;
procedure CreateVSkinImage;
var
Y, YCnt, h, YO: Integer;
R1: TRect;
begin
B.Width := RectWidth(R);
B.Height := AH;
with B.Canvas do
begin
if TpO <> 0 then
CopyRect(Rect(0, 0, B.Width, TpO), SB.Canvas,
Rect(R.Left, R.Top, R.Right, R.Top + TpO));
if BO <> 0 then
CopyRect(Rect(0, B.Height - BO, B.Width, B.Height),
SB.Canvas,
Rect(R.Left, R.Bottom - BO, R.Right, R.Bottom));
Inc(R.Top, TpO);
Dec(R.Bottom, BO);
h := RectHeight(R);
if H <> 0
then
YCnt := (B.Height - TpO - BO) div h
else
YCnt := 0;
if AStretch
then
begin
R1 := Rect(0, TpO, B.Width, B.Height - BO);
B.Canvas.CopyRect(R1, SB.Canvas, R);
end
else
for Y := 0 to YCnt do
begin
if TpO + Y * h + h > B.Height - BO
then YO := TpO + Y * h + h - (B.Height - BO)
else YO := 0;
B.Canvas.CopyRect(
Rect(0, TpO + Y * h, B.Width, TpO + Y * h + h - YO),
SB.Canvas,
Rect(R.Left, R.Top, R.Right, R.Bottom - YO));
end;
end;
end;
procedure CreateSkinBG;
var
w, h, rw, rh: Integer;
X, Y, XCnt, YCnt: Integer;
XO, YO: Integer;
begin
B.Width := AW;
B.Height := AH;
if RectWidth(NewClRect) = 0 then Exit;
if RectHeight(NewClRect) = 0 then Exit;
with B.Canvas do
begin
w := RectWidth(ClRect);
h := RectHeight(ClRect);
rw := RectWidth(NewClRect);
rh := RectHeight(NewClRect);
XCnt := rw div w;
YCnt := rh div h;
for X := 0 to XCnt do
for Y := 0 to YCnt do
begin
if X * w + w > rw then XO := X * W + W - rw else XO := 0;
if Y * h + h > rh then YO := Y * h + h - rh else YO := 0;
CopyRect(Rect(X * w, Y * h, X * w + w - XO, Y * h + h - YO),
SB.Canvas,
Rect(R.Left + ClRect.Left, R.Top + ClRect.Top,
R.Left + ClRect.Right - XO,
R.Top + ClRect.Bottom - YO));
end;
end;
end;
procedure CreateSkinImage2;
var
w, h, rw, rh: Integer;
X, Y, XCnt, YCnt: Integer;
XO, YO: Integer;
NCLRect: TRect;
begin
B.Width := AW;
B.Height := AH;
if (RBPt.X - LTPt.X = 0) or
(RBPt.Y - LTPt.Y = 0) or SB.Empty then Exit;
with B.Canvas do
begin
// Draw lines
// top
w := RBPt.X - LTPt.X;
XCnt := (AW - NewLTPt.X) div (RBPt.X - LTPt.X);
for X := 0 to XCnt do
begin
if NewLTPt.X + X * w + w > AW
then XO := NewLTPt.X + X * w + w - AW else XO := 0;
CopyRect(Rect(NewLTPt.X + X * w, 0, NewLTPt.X + X * w + w - XO, NewClRect.Top),
SB.Canvas, Rect(R.Left + LTPt.X, R.Top,
R.Left + RTPt.X - XO, R.Top + ClRect.Top));
end;
// bottom
w := RBPt.X - LBPt.X;
XCnt := (AW - NewLBPt.X) div (RBPt.X - LBPt.X);
for X := 0 to XCnt do
begin
if NewLBPt.X + X * w + w > AW
then XO := NewLBPt.X + X * w + w - AW else XO := 0;
CopyRect(Rect(NewLBPt.X + X * w, NewClRect.Bottom, NewLBPt.X + X * w + w - XO, AH),
SB.Canvas, Rect(R.Left + LBPt.X, R.Top + ClRect.Bottom,
R.Left + RBPt.X - XO, R.Bottom));
end;
// left
w := NewClRect.Left;
h := LBPt.Y - LTPt.Y;
YCnt := (NewLBPt.Y - NewLTPt.Y) div h;
for Y := 0 to YCnt do
begin
if NewLTPt.Y + Y * h + h > NewLBPt.Y
then YO := NewLTPt.Y + Y * h + h - NewLBPt.Y else YO := 0;
CopyRect(Rect(0, NewLTPt.Y + Y * h, w, NewLTPt.Y + Y * h + h - YO),
SB.Canvas,
Rect(R.Left, R.Top + LTPt.Y, R.Left + w, R.Top + LBPt.Y - YO));
end;
// lefttop
CopyRect(Rect(0, 0, NewLTPt.X, NewClRect.Top),
SB.Canvas, Rect(R.Left, R.Top,
R.Left + LTPt.X, R.Top + ClRect.Top));
CopyRect(Rect(0, NewClRect.Top, NewClRect.Left, NewLTPt.Y),
SB.Canvas, Rect(R.Left, R.Top + ClRect.Top,
R.Left + ClRect.left, R.Top + LTPT.Y));
//leftbottom
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -