📄 dxbutton.pas
字号:
Arguments: Value: Boolean
Result: None
-----------------------------------------------------------------------------}
procedure TdxButton.SetShowAccelChar(Value: Boolean);
begin
if Value <> FShowAccelChar then
begin
FShowAccelChar := Value;
Invalidate;
end;
end;
{-----------------------------------------------------------------------------
Procedure: TdxButton.SetShowFocusRect
Author: mh
Date: 22-Feb-2002
Arguments: Value: Boolean
Result: None
-----------------------------------------------------------------------------}
procedure TdxButton.SetShowFocusRect(Value: Boolean);
begin
if Value <> FShowFocusRect then
begin
FShowFocusRect := Value;
Invalidate;
end;
end;
{-----------------------------------------------------------------------------
Procedure: TdxButton.SetSpacing
Author: mh
Date: 11-Apr-2002
Arguments: Value: Integer
Result: None
-----------------------------------------------------------------------------}
procedure TdxButton.SetSpacing(Value: Byte);
begin
if Value <> FSpacing then
begin
FSpacing := Value;
Invalidate;
end;
end;
{-----------------------------------------------------------------------------
Procedure: TdxButton.SetWordWrap
Author: mh
Date: 29-Apr-2002
Arguments: Value: Boolean
Result: None
-----------------------------------------------------------------------------}
procedure TdxButton.SetWordWrap(Value: Boolean);
begin
if Value <> FWordWrap then
begin
FWordWrap := Value;
Invalidate;
end;
end;
{-----------------------------------------------------------------------------
Procedure: TdxButton.ImageListChange
Author: mh
Date: 09-Apr-2002
Arguments: Sender: TObject
Result: None
-----------------------------------------------------------------------------}
procedure TdxButton.ImageListChange(Sender: TObject);
begin
if Assigned(Action) and (Sender is TCustomImageList)
and Assigned(TAction(Action).ActionList.Images)
and ((TAction(Action).ImageIndex < (TAction(Action).ActionList.Images.Count))) then
FImageIndex := TAction(Action).ImageIndex
else
FImageIndex := -1;
Invalidate;
end;
{-----------------------------------------------------------------------------
Procedure: TdxButton.KeyDown
Author: mh
Date: 22-Feb-2002
Arguments: var Key: Word; Shift: TShiftState
Result: None
-----------------------------------------------------------------------------}
procedure TdxButton.KeyDown(var Key: Word; Shift: TShiftState);
begin
if (Shift = []) and (Key = VK_SPACE) then
begin
Include(DrawState, dsHotLight);
HookMouseDown;
end;
inherited;
end;
{-----------------------------------------------------------------------------
Procedure: TdxButton.KeyUp
Author: mh
Date: 22-Feb-2002
Arguments: var Key: Word; Shift: TShiftState
Result: None
-----------------------------------------------------------------------------}
procedure TdxButton.KeyUp(var Key: Word; Shift: TShiftState);
var
cPos: TPoint;
begin
//
// It's not possible to call the 'HookMouseUp' or 'HookMouseLeave' methods,
// because we don't want to call there event handlers.
//
if dsSelected in DrawState then
begin
GetCursorPos(cPos);
cPos := ScreenToClient(cPos);
if not PtInRect(Bounds(0, 0, Width, Height), cPos) then
Exclude(DrawState, dsHotLight);
Exclude(DrawState, dsSelected);
Invalidate;
Click;
end;
inherited;
end;
{-----------------------------------------------------------------------------
Procedure: TdxButton.IsSpecialDrawState
Author: mh
Date: 22-Feb-2002
Arguments: None
Result: Boolean
-----------------------------------------------------------------------------}
function TdxButton.IsSpecialDrawState(IgnoreDefault: Boolean = False): Boolean;
begin
if dsSelected in DrawState then
Result := not (dsHotLight in DrawState)
else
Result := (dsHotLight in DrawState) or (dsFocused in DrawState);
if not IgnoreDefault then
Result := Result or FDefault and not IsSibling;
end;
{-----------------------------------------------------------------------------
Procedure: TdxButton.ActionChange
Author: mh
Date: 09-Apr-2002
Arguments: Sender: TObject; CheckDefaults: Boolean
Result: None
-----------------------------------------------------------------------------}
procedure TdxButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
inherited ActionChange(Sender, CheckDefaults);
if Sender is TCustomAction then
with TCustomAction(Sender) do
begin
if Assigned(TCustomAction(Sender).ActionList.Images) and
(FImageChangeLink.Sender <> TCustomAction(Sender).ActionList.Images) then
TCustomAction(Sender).ActionList.Images.RegisterChanges(FImageChangeLink);
if (ActionList <> nil) and (ActionList.Images <> nil) and
(ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
FImageIndex := ImageIndex;
Invalidate;
end;
end;
{-----------------------------------------------------------------------------
Procedure: TdxButton.HookResized
Author: mh
Date: 22-Feb-2002
Arguments: None
Result: None
-----------------------------------------------------------------------------}
procedure TdxButton.HookResized;
var
Offset, ColSteps: Integer;
Dithering: Boolean;
begin
inherited;
// calculate quality.
Dithering := FQuality = bqHigh;
ColSteps := 16;
if FQuality = bqLow then
ColSteps := 8;
if FQuality = bqHigh then
ColSteps := 64;
// calculate offset.
Offset := 4 * (Integer(IsSpecialDrawState(True)));
//
// create gradient rectangles for...
//
// background.
dxCreateGradientRect(Width - (2 + Offset), Height - (2 + Offset),
FColors.BackgroundFrom, FColors.BackgroundTo, ColSteps, gsTop, Dithering,
FBgGradient);
// clicked.
dxCreateGradientRect(Width - 2, Height - 2, FColors.ClickedFrom,
FColors.ClickedTo, ColSteps, gsTop, Dithering, FCkGradient);
// focused.
dxCreateGradientRect(Width - 2, Height - 2, FColors.FocusedFrom,
FColors.FocusedTo, ColSteps, gsTop, Dithering, FFcGradient);
// highlight.
dxCreateGradientRect(Width - 2, Height - 2, FColors.HighlightFrom,
FColors.HighlightTo, ColSteps, gsTop, Dithering, FHlGradient);
// redraw.
Invalidate;
end;
{-----------------------------------------------------------------------------
Procedure: TdxButton.Paint
Author: mh
Date: 21-Feb-2002
Arguments: None
Result: None
-----------------------------------------------------------------------------}
procedure TdxButton.Paint;
var
R: TRect;
c, x, y: Integer;
PxlColor: TColor;
Offset, Flags: Integer;
DrawPressed: Boolean;
Image: TBitmap;
Bitmap: TBitmap;
begin
with Canvas do
begin
// clear background.
R := GetClientRect;
Brush.Color := Self.Color;
FillRect(R);
// draw gradient borders.
if IsSpecialDrawState then
begin
Bitmap := TBitmap.Create;
try
if dsHotLight in DrawState then
Bitmap.Assign(FHlGradient)
else
Bitmap.Assign(FFcGradient);
BitBlt(Handle, 1, 1, Width, Height, Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
finally
Bitmap.Free;
end;
end;
// draw background gradient...
if not ((dsHotLight in DrawState) and (dsSelected in DrawState)) then
begin
Offset := 2 * Integer(IsSpecialDrawState);
BitBlt(Handle, 1 + Offset, 1 + Offset, Width - 3 * Offset, Height - 3 * Offset,
FBgGradient.Canvas.Handle, 0, 0, SRCCOPY);
end
// ...or click gradient.
else
BitBlt(Handle, 1, 1, Width, Height, FCkGradient.Canvas.Handle, 0, 0, SRCCOPY);
// draw border lines.
Pen.Color := FColors.BorderLine;
Brush.Style := bsClear;
RoundRect(0, 0, Width, Height, 5, 5);
// draw border edges.
Pen.Color := cColorBorderEdges;
dxDrawLine(Canvas, 0, 1, 2, 0);
dxDrawLine(Canvas, Width - 2, 0, Width, 2);
dxDrawLine(Canvas, 0, Height - 2, 2, Height);
dxDrawLine(Canvas, Width - 3, Height, Width, Height - 3);
// set drawing flags.
Flags := {DT_VCENTER or }DT_END_ELLIPSIS;
if FWordWrap then
Flags := Flags or DT_WORDBREAK;
// draw image & caption.
Image := TBitmap.Create;
try
// get image from action or glyph property.
if Assigned(Action) and Assigned(TAction(Action).ActionList.Images) and
(FImageIndex > -1) and (FImageIndex < TAction(Action).ActionList.Images.Count) then
TAction(Action).ActionList.Images.GetBitmap(FImageIndex, Image)
else
Image.Assign(FGlyph);
// autogray image (if allowed).
if FAutoGray and not Enabled then
for x := 0 to Image.Width - 1 do
for y := 0 to Image.Height - 1 do
begin
PxlColor := ColorToRGB(Image.Canvas.Pixels[x, y]);
c := Round((((PxlColor shr 16) + ((PxlColor shr 8) and $00FF) + (PxlColor and $0000FF)) div 3)) div 2 + 96;
Image.Canvas.Pixels[x, y] := RGB(c, c, c);
end;
// assign canvas font (change HotTrack-Color, if necessary).
Font.Assign(Self.Font);
if (FHotTrack) and (dsHotLight in DrawState) then
Font.Color := FColors.HotTrack;
// calculate textrect.
if not Image.Empty then
case FLayout of
blGlyphLeft:
Inc(R.Left, Image.Width + FSpacing);
blGlyphRight:
begin
Dec(R.Left, Image.Width + FSpacing);
Dec(R.Right, (Image.Width + FSpacing) * 2);
Flags := Flags or DT_RIGHT;
end;
blGlyphTop:
Inc(R.Top, Image.Height + FSpacing);
blGlyphBottom:
Dec(R.Top, Image.Height + FSpacing);
end;
dxRenderText(Self, Canvas, Caption, Font, Enabled, FShowAccelChar, R, Flags or DT_CALCRECT);
OffsetRect(R, (Width - R.Right) div 2, (Height - R.Bottom) div 2);
// should we draw the pressed state?
DrawPressed := (dsHotLight in DrawState) and (dsSelected in DrawState);
if DrawPressed then
OffsetRect(R, 1, 1);
// draw image - if available.
if not Image.Empty then
begin
Image.Transparent := True;
case FLayout of
blGlyphLeft:
Draw(R.Left - (Image.Width + FSpacing), (Height - Image.Height) div 2 +
Integer(DrawPressed), Image);
blGlyphRight:
Draw(R.Right + FSpacing, (Height - Image.Height) div 2 +
Integer(DrawPressed), Image);
blGlyphTop:
Draw((Width - Image.Width) div 2 + Integer(DrawPressed),
R.Top - (Image.Height + FSpacing), Image);
blGlyphBottom:
Draw((Width - Image.Width) div 2 + Integer(DrawPressed),
R.Bottom + FSpacing, Image);
end;
end;
// draw caption.
dxRenderText(Self, Canvas, Caption, Font, Enabled, FShowAccelChar, R, Flags);
// draw focusrect (if enabled).
if (dsFocused in DrawState) and (FShowFocusRect) then
DrawFocusRect(Bounds(3, 3, Width - 6, Height - 6));
finally
Image.Free;
end;
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -