📄 xpbuttonclass.pas
字号:
if Spacing = -1 then
begin
TotalSize := Point(ClientSize.X - (Margin + GlyphSize.X), ClientSize.Y - (Margin + GlyphSize.Y));
if Layout in [blGlyphLeft, blGlyphRight] then
Spacing := (TotalSize.X - TextSize.X) div 2
else
Spacing := (TotalSize.Y - TextSize.Y) div 2;
end;
end;
case Layout of
blGlyphLeft:
begin
GlyphPos.X := Margin;
TextPos.X := GlyphPos.X + GlyphSize.X + Spacing;
end;
blGlyphRight:
begin
GlyphPos.X := ClientSize.X - Margin - GlyphSize.X;
TextPos.X := GlyphPos.X - Spacing - TextSize.X;
end;
blGlyphTop:
begin
GlyphPos.Y := Margin;
TextPos.Y := GlyphPos.Y + GlyphSize.Y + Spacing;
end;
blGlyphBottom:
begin
GlyphPos.Y := ClientSize.Y - Margin - GlyphSize.Y;
TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y;
end;
end;
// fixup the result variables
with GlyphPos do
begin
Inc(X, Client.Left + Offset.X);
Inc(Y, Client.Top + Offset.Y);
end;
OffsetRect(TextBounds, TextPos.X + Client.Left + Offset.X, TextPos.Y + Client.Top + Offset.X);
end;
//==============================================================================
// Function: GetGradColor GetGradientColors
//==============================================================================
function GetGradColor(const ARect: TRect; const StartColor, EndColor: TColor; const Counter: Integer): TColor;
var
rc1, rc2, gc1, gc2, bc1, bc2, Sum : Integer;
begin
rc1 := GetRValue(StartColor);
gc1 := GetGValue(StartColor);
bc1 := GetBValue(StartColor);
rc2 := GetRValue(EndColor);
gc2 := GetGValue(EndColor);
bc2 := GetBValue(EndColor);
Sum := ARect.Bottom - ARect.Top ;
Result := RGB((rc1 + ((rc2 - rc1) * Counter) div Sum),
(gc1 + ((gc2 - gc1) * Counter) div Sum),
(bc1 + ((bc2 - bc1) * Counter) div Sum));
end;
function CreateDisabledBitmap(FOriginal: TBitmap; OutlineColor, BackColor, HighlightColor, ShadowColor: TColor; DrawHighlight: Boolean): TBitmap;
const
ROP_DSPDxax = $00E20746;
var
MonoBmp: TBitmap;
IRect: TRect;
begin
IRect := Rect(0, 0, FOriginal.Width, FOriginal.Height);
Result := TBitmap.Create;
try
Result.Width := FOriginal.Width;
Result.Height := FOriginal.Height;
MonoBmp := TBitmap.Create;
try
with MonoBmp do begin
Width := FOriginal.Width;
Height := FOriginal.Height;
Canvas.CopyRect(IRect, FOriginal.Canvas, IRect);
{$IFDEF DFS_DELPHI_3_UP}
HandleType := bmDDB;
{$ENDIF}
Canvas.Brush.Color := OutlineColor;
if Monochrome then begin
Canvas.Font.Color := clWhite;
Monochrome := False;
Canvas.Brush.Color := clWhite;
end;
Monochrome := True;
end;
with Result.Canvas do begin
Brush.Color := BackColor;
FillRect(IRect);
if DrawHighlight then begin
Brush.Color := HighlightColor;
SetTextColor(Handle, clBlack);
SetBkColor(Handle, clWhite);
BitBlt(Handle, 1, 1, IRect.Right - IRect.Left, IRect.Bottom - IRect.Top, MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
end;
Brush.Color := ShadowColor;
SetTextColor(Handle, clBlack);
SetBkColor(Handle, clWhite);
BitBlt(Handle, 0, 0, IRect.Right - IRect.Left, IRect.Bottom - IRect.Top, MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
end;
finally
MonoBmp.Free;
end;
except
Result.Free;
raise;
end;
end;
function GetFontMetrics(Font: TFont): TTextMetric;
var
DC: HDC;
SaveFont: HFont;
begin
DC := GetDC(0);
SaveFont := SelectObject(DC, Font.Handle);
GetTextMetrics(DC, Result);
SelectObject(DC, SaveFont);
ReleaseDC(0, DC);
end;
function GetFontHeight(Font: TFont): Integer;
begin
with GetFontMetrics(Font) do
Result := Round(tmHeight + tmHeight / 8);
end;
function RectInRect(R1, R2: TRect): Boolean;
begin
Result := IntersectRect(R1, R1, R2);
end;
procedure DrawXPStyleBorder(Canvas: TCanvas; ARect:TRect; const TBColor1, TBColor2, BBColor1, BBColor2, BBColor3: TColor);
function GetDrawLRRect(DRect: TRect; RectType:String): TRect ;
var
R : TRect ;
begin
R := DRect ;
with R do begin
if RectType = 'L' then begin
Right := Left + 4 ;
Top := Top + 2 ;
Bottom := Bottom - 2 ;
end;
if RectType = 'R' then begin
Left := Right - 4 ;
Top := Top + 2 ;
Bottom := Bottom - 2 ;
end;
end;
Result := R ;
end;
begin
with Canvas, ARect, XPButtonColor do begin
Pen.Color := TBColor1;
MoveTo(Left + 2, Top + 1);
LineTo(Right - 2, Top + 1);
Pen.Color := TBColor2;
MoveTo(Left + 1, Top + 2);
LineTo(Right - 1, Top + 2);
if BBColor1 <> clNone then begin
Pen.Color := BBColor1;
MoveTo(Left + 1, Bottom - 4);
LineTo(Right - 1, Bottom - 4);
end;
Pen.Color := BBColor2;
MoveTo(Left + 1, Bottom - 3);
LineTo(Right - 1, Bottom - 3);
Pen.Color := BBColor3;
MoveTo(Left + 2, Bottom - 2);
LineTo(Right - 2, Bottom - 2);
DrawGradientColor(Canvas,GetDrawLRRect(ARect, 'L'),TBColor2,BBColor2);
DrawGradientColor(Canvas,GetDrawLRRect(ARect, 'R'),TBColor2,BBColor2);
end;
end;
procedure DrawXpStyle(Canvas: TCanvas; ARect:TRect; FState: TButtonState);
var
R, T : TRect ;
begin
R := ARect ;
with T do begin
Left := R.Left ;
Right := R.Right ;
Top := R.Top + 2 ;
Bottom := R.Bottom - 3 ;
end;
with Canvas, XPButtonColor do begin
if FState = bsDisabled then
Pen.Color := clBtnShadow
else
Pen.Color := BorderColor;
RoundRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, 6, 6) ;
if FState = bsDown then
begin
DrawGradientColor(Canvas,T,RectBColor,RectTColor);
DrawXPStyleBorder(Canvas, R, DBBorderColor3, DBBorderColor2, DTBorderColor1, DTBorderColor1, DTBorderColor2);
end
else begin
DrawGradientColor(Canvas,T,RectTColor,RectBColor);
DrawXPStyleBorder(Canvas, R, DTBorderColor1, DTBorderColor2, DBBorderColor1, DBBorderColor2, DBBorderColor3);
end;
Pen.Color := RectPointColor;
//左上角
MoveTo(R.Left + 1, R.Top);
LineTo(R.Left + 2, R.Top);
MoveTo(R.Left, R.Top + 1);
LineTo(R.Left + 1, R.Top + 1);
//右上角
MoveTo(R.Right - 2, R.Top);
LineTo(R.Right - 1, R.Top);
MoveTo(R.Right - 1, R.Top + 1);
LineTo(R.Right, R.Top + 1);
//左下角
MoveTo(R.Left, R.Bottom - 2);
LineTo(R.Left + 1, R.Bottom - 2);
MoveTo(R.Left + 1, R.Bottom - 1);
LineTo(R.Left + 2, R.Bottom - 1);
//右下角
MoveTo(R.Right - 2, R.Bottom - 1);
LineTo(R.Right - 1, R.Bottom - 1);
MoveTo(R.Right - 1, R.Bottom - 2);
LineTo(R.Right, R.Bottom - 2);
end;
end;
procedure SetXPStyleColors(ButtonStyle: TButtonStyle);
begin
with XPButtonColor do begin
if ButtonStyle = bsXPBlue then begin
BorderColor := RGB(0,60,116);
RectPointColor := RGB(123,149,169);
RectTColor := RGB(255,255,255);
RectBColor := RGB(224,230,211);
STBorderColor1 := RGB(251,220,147);
STBorderColor2 := RGB(253,216,137);
SBBorderColor1 := RGB(230,161,50);
SBBorderColor2 := RGB(229,151,0);
FTBorderColor1 := RGB(206,231,255);
FTBorderColor2 := RGB(155,212,246);
FBBorderColor1 := RGB(137,173,228);
FBBorderColor2 := RGB(105,130,238);
DTBorderColor1 := RGB(255,255,255);
DTBorderColor2 := RGB(254,254,254);
DBBorderColor1 := RGB(224,230,211);
DBBorderColor2 := RGB(224,230,208);
DBBorderColor3 := RGB(224,230,204);
end ;
if ButtonStyle = bsXPArgent then begin
BorderColor := RGB(0,60,116);
RectPointColor := RGB(123,149,169);
RectTColor := RGB(255,255,255);
RectBColor := RGB(205,204,223);
STBorderColor1 := RGB(251,220,147);
STBorderColor2 := RGB(253,216,137);
SBBorderColor1 := RGB(230,161,50);
SBBorderColor2 := RGB(229,151,0);
FTBorderColor1 := RGB(206,231,255);
FTBorderColor2 := RGB(155,212,246);
FBBorderColor1 := RGB(137,173,228);
FBBorderColor2 := RGB(105,130,238);
DTBorderColor1 := RGB(255,255,255);
DTBorderColor2 := RGB(254,254,254);
DBBorderColor1 := RGB(202,196,224);
DBBorderColor2 := RGB(199,192,224);
DBBorderColor3 := RGB(197,190,224);
end;
if ButtonStyle = bsXPGreen then begin
BorderColor := RGB(55,98,6);
RectPointColor := RGB(117,137,91);
RectTColor := RGB(255,255,246);
RectBColor := RGB(194,205,149);
STBorderColor1 := RGB(251,220,147);
STBorderColor2 := RGB(253,216,137);
SBBorderColor1 := RGB(230,161,50);
SBBorderColor2 := RGB(229,151,0);
FTBorderColor1 := RGB(210,228,184);
FTBorderColor2 := RGB(177,208,128);
FBBorderColor1 := RGB(135,201,84);
FBBorderColor2 := RGB(135,180,54);
DTBorderColor1 := RGB(255,255,255);
DTBorderColor2 := RGB(254,254,254);
DBBorderColor1 := RGB(205,200,149);
DBBorderColor2 := RGB(205,198,149);
DBBorderColor3 := RGB(205,194,149);
end;
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -