?? bsutils.pas
字號(hào):
end;
end
else
if ADrawColorMarker
then
with Cnvs do
begin
if Caption <> ''
then
begin
Pen.Color := AColorMarkerValue;
MoveTo(TR.Left, TR.Bottom - 1);
LineTo(TR.Right, TR.Bottom - 1);
MoveTo(TR.Left, TR.Bottom );
LineTo(TR.Right, TR.Bottom);
MoveTo(TR.Left, TR.Bottom + 1);
LineTo(TR.Right, TR.Bottom + 1);
end
else
begin
Brush.Color := AColorMarkerValue;
Brush.Style := bsSolid;
FillRect(Rect(R.Left + 4, R.Top + 4, R.Right - 2, R.Bottom - 4));
end;
end;
end;
procedure DrawGlyphAndText(Cnvs: TCanvas;
R: TRect; Margin, Spacing: Integer; Layout: TbsButtonLayout;
Caption: String; Glyph: TBitMap; NumGlyphs, GlyphNum: Integer; ADown: Boolean;
ADrawColorMarker: Boolean; AColorMarkerValue: TColor);
var
gw, gh: Integer;
tw, th: Integer;
TX, TY, GX, GY: Integer;
TR: TRect;
begin
if Glyph.Empty
then
begin
gw := 0;
gh := 0;
end
else
begin
gw := Glyph.Width div NumGlyphs;
gh := Glyph.Height;
end;
with Cnvs do
begin
if Caption = ''
then
begin
tw := 0;
th := 0;
end
else
begin
TR := Rect(0, 0, RectWidth(R), RectHeight(R));
if (Layout = blGlyphLeft) or (Layout = blGlyphRight)
then
begin
Dec(TR.Right, gw);
end
else
if (Layout = blGlyphTop) or (Layout = blGlyphBottom)
then
begin
Dec(TR.Bottom, gh);
end;
DrawText(Handle, PChar(Caption), Length(Caption), TR,
DT_EXPANDTABS or DT_WORDBREAK or DT_CALCRECT);
tw := RectWidth(TR);
th := RectHeight(TR);
Brush.Style := bsClear;
end;
end;
CalcLCoord(Layout, R, gw, gh, tw, th, Spacing, Margin, TX, TY, GX, GY);
if ADown
then
begin
Inc(GX); Inc(GY);
Inc(TX); Inc(TY);
end;
if Caption <> ''
then
begin
TR := Rect(TX, TY, TX + tw, TY + th);
Inc(TR.Right, 2);
DrawText(Cnvs.Handle, PChar(Caption),
Length(Caption), TR, DT_EXPANDTABS or DT_VCENTER or DT_CENTER or DT_WORDBREAK);
end;
if not Glyph.Empty then DrawGlyph(Cnvs, GX, GY, Glyph, NumGlyphs, GlyphNum);
if not Glyph.Empty
then
begin
if ADrawColorMarker
then
with Cnvs do
begin
Pen.Color := AColorMarkerValue;
MoveTo(GX, GY + Glyph.Height - 2);
LineTo(GX + Glyph.Width, GY + Glyph.Height - 2);
MoveTo(GX, GY + Glyph.Height - 1);
LineTo(GX + Glyph.Width, GY + Glyph.Height - 1);
MoveTo(GX, GY + Glyph.Height);
LineTo(GX + Glyph.Width, GY + Glyph.Height);
end;
end
else
if ADrawColorMarker
then
with Cnvs do
begin
if Caption <> ''
then
begin
Pen.Color := AColorMarkerValue;
MoveTo(TR.Left, TR.Bottom - 1);
LineTo(TR.Right, TR.Bottom - 1);
MoveTo(TR.Left, TR.Bottom);
LineTo(TR.Right, TR.Bottom);
MoveTo(TR.Left, TR.Bottom + 1);
LineTo(TR.Right, TR.Bottom + 1);
end
else
begin
Brush.Color := AColorMarkerValue;
Brush.Style := bsSolid;
if ADown
then
FillRect(Rect(R.Left + 4, R.Top + 5, R.Right - 2, R.Bottom - 3))
else
FillRect(Rect(R.Left + 4, R.Top + 4, R.Right - 2, R.Bottom - 4));
end;
end;
end;
procedure GetParentImage(Control: TControl; Dest: TCanvas);
var
I, Count, X, Y, SaveIndex: Integer;
DC: HDC;
R, SelfR, CtlR: TRect;
begin
if (Control = nil) or (Control.Parent = nil) then Exit;
Count := Control.Parent.ControlCount;
DC := Dest.Handle;
with Control.Parent do ControlState := ControlState + [csPaintCopy];
try
with Control do begin
SelfR := Bounds(Left, Top, Width, Height);
X := -Left; Y := -Top;
end;
SaveIndex := SaveDC(DC);
try
SetViewportOrgEx(DC, X, Y, nil);
IntersectClipRect(DC, 0, 0, Control.Parent.ClientWidth,
Control.Parent.ClientHeight);
if (Control.Parent is TForm) and
(TForm(Control.Parent).FormStyle = fsMDIForm)
then
begin
SendMessage(TForm(Control.Parent).ClientHandle, WM_ERASEBKGND, DC, 0);
end
else
if Control.Parent is TbsSkinTabControl
then
begin
TbsSkinTabControl(Control.Parent).PaintBG(DC);
end
else
with TParentControl(Control.Parent) do begin
Perform(WM_ERASEBKGND, DC, 0);
if not (Control.Parent is TForm) then PaintWindow(DC);
end;
finally
RestoreDC(DC, SaveIndex);
end;
for I := 0 to Count - 1 do
if Control.Parent.Controls[I] <> Control
then
begin
if (Control.Parent.Controls[I] <> nil) and
(Control.Parent.Controls[I] is TGraphicControl)
then
begin
with TGraphicControl(Control.Parent.Controls[I]) do begin
CtlR := Bounds(Left, Top, Width, Height);
if Bool(IntersectRect(R, SelfR, CtlR)) and Visible then begin
ControlState := ControlState + [csPaintCopy];
SaveIndex := SaveDC(DC);
try
SaveIndex := SaveDC(DC);
SetViewportOrgEx(DC, Left + X, Top + Y, nil);
IntersectClipRect(DC, 0, 0, Width, Height);
Perform(WM_PAINT, DC, 0);
finally
RestoreDC(DC, SaveIndex);
ControlState := ControlState - [csPaintCopy];
end;
end;
end;
end
end
else
Break;
finally
with Control.Parent do ControlState := ControlState - [csPaintCopy];
end;
end;
procedure GetParentImageRect(Control: TControl; Rct: TRect; Dest: TCanvas);
var
I, Count, X, Y, SaveIndex: Integer;
DC: HDC;
R, SelfR, CtlR: TRect;
begin
if (Control = nil) or (Control.Parent = nil) then Exit;
Count := Control.Parent.ControlCount;
DC := Dest.Handle;
with Control.Parent do ControlState := ControlState + [csPaintCopy];
try
with Control do begin
SelfR := Bounds(Left, Top, Width, Height);
X := -Left - Rct.Left; Y := -Top - Rct.Top;
end;
{ Copy parent control image }
SaveIndex := SaveDC(DC);
try
SetViewportOrgEx(DC, X, Y, nil);
IntersectClipRect(DC, 0, 0, Control.Parent.ClientWidth,
Control.Parent.ClientHeight);
if (Control.Parent is TForm) and
(TForm(Control.Parent).FormStyle = fsMDIForm)
then
begin
SendMessage(TForm(Control.Parent).ClientHandle, WM_ERASEBKGND, DC, 0);
end
else
if Control.Parent is TbsSkinTabControl
then
begin
TbsSkinTabControl(Control.Parent).PaintBG(DC);
end
else
with TParentControl(Control.Parent) do begin
Perform(WM_ERASEBKGND, DC, 0);
if not (Control.Parent is TForm) then PaintWindow(DC);
end;
finally
RestoreDC(DC, SaveIndex);
end;
for I := 0 to Count - 1 do
if Control.Parent.Controls[I] <> Control
then
begin
if (Control.Parent.Controls[I] <> nil) and
(Control.Parent.Controls[I] is TGraphicControl)
then
begin
with TGraphicControl(Control.Parent.Controls[I]) do begin
CtlR := Bounds(Left, Top, Width, Height);
if Bool(IntersectRect(R, SelfR, CtlR)) and Visible then begin
ControlState := ControlState + [csPaintCopy];
SaveIndex := SaveDC(DC);
try
SaveIndex := SaveDC(DC);
SetViewportOrgEx(DC, Left + X, Top + Y, nil);
IntersectClipRect(DC, 0, 0, Width, Height);
Perform(WM_PAINT, DC, 0);
finally
RestoreDC(DC, SaveIndex);
ControlState := ControlState - [csPaintCopy];
end;
end;
end;
end
end
else
Break;
finally
with Control.Parent do ControlState := ControlState - [csPaintCopy];
end;
end;
function CalcTextWidthW(C: TCanvas; Str: WideString): Integer;
var
R: TRect;
begin
R := Rect(0, 0, 0, 0);
BSDrawSkinText(C, Str, R, DT_CALCRECT);
Result := RectWidth(R);
end;
function CalcTextHeightW(C: TCanvas; Str: WideString): Integer;
var
R: TRect;
begin
R := Rect(0, 0, 0, 0);
BSDrawSkinText(C, Str, R, DT_CALCRECT);
Result := RectHeight(R);
end;
procedure CorrectTextbyWidthW(C: TCanvas; var S: WideString; W: Integer);
function GetTextWidth(Str: WideString): Integer;
var
R: TRect;
begin
R := Rect(0, 0, 0, 0);
BSDrawSkinText(C, Str, R, DT_CALCRECT);
Result := RectWidth(R);
end;
var
j: Integer;
begin
j := Length(S);
if GetTextWidth(S) > w
then
begin
repeat
Delete(S, j, 1);
Dec(j);
until (GetTextWidth(S + '...') <= w) or (S = '');
S := S + '...';
end;
end;
procedure CorrectTextbyWidth(C: TCanvas; var S: String; W: Integer);
var
j: Integer;
begin
j := Length(S);
with C do
begin
if TextWidth(S) > w
then
begin
repeat
Delete(S, j, 1);
Dec(j);
until (TextWidth(S + '...') <= w) or (S = '');
S := S + '...';
end;
end;
end;
function Max(A, B: Longint): Longint;
begin
if A > B then Result := A
else Result := B;
end;
function Min(A, B: Longint): Longint;
begin
if A < B then Result := A
else Result := B;
end;
function ReplaceStr(const S, Srch, Replace: string): string;
var
I: Integer;
Source: string;
begin
Source := S;
Result := '';
repeat
I := Pos(Srch, Source);
if I > 0 then begin
Result := Result + Copy(Source, 1, I - 1) + Replace;
Source := Copy(Source, I + Length(Srch), MaxInt);
end
else Result := Result + Source;
until I <= 0;
end;
function BSDrawSkinText(ACanvas: TCanvas; AText: WideString; var Bounds: TRect; Flag: cardinal): integer;
var
AnsiText: string;
begin
if BS_PlatformIsUnicode
then
Result := Windows.DrawTextW(ACanvas.Handle, PWideChar(AText), Length(AText), Bounds, Flag)
else
begin
AnsiText := WideCharToString(PWideChar(AText));
Result := Windows.DrawText(ACanvas.Handle, PChar(AnsiText), Length(AnsiText), Bounds, Flag);
end;
end;
procedure BSDrawText4(Cnvs: TCanvas; S: String; R: TRect);
begin
if S = '' then Exit;
if S[1] = 'W' then Inc(R.Right, 2);
DrawText(Cnvs.Handle, PChar(S), Length(S), R,
DT_VCENTER or DT_SINGLELINE or DT_CENTER);
end;
procedure BSDrawText(Cnvs: TCanvas; S: String; R: TRect);
begin
if S = '' then Exit;
DrawText(Cnvs.Handle, PChar(S), Length(S), R,
DT_VCENTER or DT_SINGLELINE or DT_LEFT);
end;
procedure BSDrawText2(Cnvs: TCanvas; S: String; R: TRect);
var
TX, TY: Integer;
begin
if S = '' then Exit;
TX := R.Left + 2;
TY := R.Top + RectHeight(R) div 2 - Cnvs.TextHeight(S) div 2;
Cnvs.TextRect(R, TX, TY, S);
end;
procedure BSDrawText3(Cnvs: TCanvas; S: String; R: TRect; HorOffset: Integer);
var
TX, TY: Integer;
begin
if S = '' then Exit;
TX := R.Left + 2 + HorOffset;
TY := R.Top + RectHeight(R) div 2 - Cnvs.TextHeight(S) div 2;
Cnvs.TextRect(R, TX, TY, S);
end;
procedure DrawTrackArrowImage(Cnvs: TCanvas; R: TRect; Color: TColor);
var
X, Y, i: Integer;
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -