?? vrbuttons.pas
字號:
BorderHighlight, BorderShadow, 1)
else
DrawFrame3D(BitmapCanvas, PaintRect,
BorderShadow, BorderHighlight, 1)
end else InflateRect(PaintRect, -1, -1);
if FPressed then
begin
OffsetRect(FImageRect, 1, 1);
OffsetRect(FTextBounds, 1, 1);
end;
if not FGlyph.Empty then
begin
BitmapCanvas.Brush.Style := bsClear;
BitmapCanvas.BrushCopy(FImageRect, FGlyph, BitmapRect(FGlyph),
FGlyph.TransparentColor);
end;
if not Enabled then
BitmapCanvas.Font.Color := DisabledText;
BitmapCanvas.Brush.Style := bsClear;
DrawText(BitmapCanvas.Handle, PChar(Caption), -1, FTextBounds,
DT_SINGLELINE + DT_VCENTER + DT_CENTER);
inherited Paint;
end;
procedure TVrHyperButton.CalcPaintParams;
var
Rect: TRect;
ImagePos: TPoint;
begin
Rect := ClientRect;
InflateRect(Rect, -1, -1); //fix borderwidth
FSize.X := FGlyph.Width;
FSize.Y := FGlyph.Height;
BitmapCanvas.Font.Assign(Self.Font);
CalcImageTextLayout(BitmapCanvas, Rect, Point(1, 1), Caption, FLayout,
FMargin, FSpacing, Point(FSize.X, FSize.Y), ImagePos, FTextBounds);
if FGlyph.Empty then OffsetRect(FTextBounds, 0, -1);
FImageRect := Bounds(ImagePos.X, ImagePos.Y, FSize.X, FSize.Y);
end;
procedure TVrHyperButton.CMFontChanged(var Message: TMessage);
begin
inherited;
BitmapCanvas.Font.Assign(Self.Font);
UpdateControlCanvas;
end;
procedure TVrHyperButton.CMEnabledChanged(var Message: TMessage);
begin
UpdateControlCanvas;
end;
procedure TVrHyperButton.GlyphChanged(Sender: TObject);
begin
UpdateControlCanvas;
end;
procedure TVrHyperButton.SetLayout(Value: TVrImageTextLayout);
begin
if FLayout <> Value then
begin
FLayout := Value;
UpdateControlCanvas;
end;
end;
procedure TVrHyperButton.SetMargin(Value: Integer);
begin
if FMargin <> Value then
begin
FMargin := Value;
UpdateControlCanvas;
end;
end;
procedure TVrHyperButton.SetSpacing(Value: Integer);
begin
if FSpacing <> Value then
begin
FSpacing := Value;
UpdateControlCanvas;
end;
end;
procedure TVrHyperButton.SetBorderColor(Value: TColor);
begin
if FBorderColor <> Value then
begin
FBorderColor := Value;
UpdateControlCanvas;
end;
end;
procedure TVrHyperButton.SetBorderHighlight(Value: TColor);
begin
if FBorderHighlight <> Value then
begin
FBorderHighlight := Value;
UpdateControlCanvas;
end;
end;
procedure TVrHyperButton.SetBorderShadow(Value: TColor);
begin
if FBorderShadow <> Value then
begin
FBorderShadow := Value;
UpdateControlCanvas;
end;
end;
procedure TVrHyperButton.SetColorEnter(Value: TColor);
begin
if FColorEnter <> Value then
begin
FColorEnter := Value;
UpdateControlCanvas;
end;
end;
procedure TVrHyperButton.SetColorLeave(Value: TColor);
begin
if FColorLeave <> Value then
begin
FColorLeave := Value;
UpdateControlCanvas;
end;
end;
procedure TVrHyperButton.SetGlyph(Value: TBitmap);
begin
FGlyph.Assign(Value);
end;
procedure TVrHyperButton.Click;
begin
end;
procedure TVrHyperButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if (Button = mbLeft) then
begin
FDown := True;
FPressed := True;
UpdateControlCanvas;
end;
inherited MouseDown(Button, Shift, X, Y);
end;
procedure TVrHyperButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
DoClick: Boolean;
begin
FDown := false;
DoClick := false;
if FPressed then
begin
FPressed := false;
UpdateControlCanvas;
DoClick := True;
end;
inherited MouseUp(Button, Shift, X, Y);
if DoClick then
inherited Click;
end;
procedure TVrHyperButton.MouseEnter;
begin
FHasMouse := True;
if FDown then FPressed := True;
UpdateControlCanvas;
inherited;
end;
procedure TVrHyperButton.MouseLeave;
begin
FHasMouse := false;
if FDown then FPressed := false;
UpdateControlCanvas;
inherited;
end;
{ TVrShadowBrush }
constructor TVrShadowBrush.Create;
begin
inherited Create;
Color := clBlack;
end;
{ TVrShadowPen }
constructor TVrShadowPen.Create;
begin
inherited Create;
Color := clLime;
end;
{TVrShadowButton}
constructor TVrShadowButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csOpaque] - [csDoubleClicks];
Width := 110;
Height := 30;
Font.Color := clWhite;
ParentColor := true;
ParentFont := false;
FDepth := 4;
FShadowColor := clBtnShadow;
FShadowOutline := clBtnShadow;
FBrush := TVrShadowBrush.Create;
FBrush.OnChange := StyleChanged;
FPen := TVrShadowPen.Create;
FPen.OnChange := StyleChanged;
FStyle := ssRoundRect;
FDirection := sdBottomRight;
FTextAlign := vtaCenter;
end;
destructor TVrShadowButton.Destroy;
begin
FBrush.Free;
FPen.Free;
inherited Destroy;
end;
procedure TVrshadowButton.Click;
begin
end;
procedure TVrShadowButton.SetBrush(Value: TVrShadowBrush);
begin
FBrush.Assign(Value);
end;
procedure TVrShadowButton.SetPen(Value: TVrShadowPen);
begin
FPen.Assign(Value);
end;
procedure TVrShadowButton.SetDepth(Value: Integer);
begin
if (FDepth <> Value) and (Value > 2) then
begin
FDepth := Value;
UpdateControlCanvas;
end;
end;
procedure TVrShadowButton.SetShadowColor(Value: TColor);
begin
if FShadowColor <> Value then
begin
FShadowColor := Value;
UpdateControlCanvas;
end;
end;
procedure TVrShadowButton.SetShadowOutline(Value: TColor);
begin
if FShadowOutline <> Value then
begin
FShadowOutline := Value;
UpdateControlCanvas;
end;
end;
procedure TVrShadowButton.SetStyle(Value: TVrShadowButtonStyle);
begin
if FStyle <> Value then
begin
FStyle := Value;
UpdateControlCanvas;
end;
end;
procedure TVrShadowButton.SetDirection(Value: TVrShadowDirection);
begin
if FDirection <> Value then
begin
FDirection := Value;
UpdateControlCanvas;
end;
end;
procedure TVrShadowButton.SetTextAlign(Value: TVrTextAlignment);
begin
if FTextAlign <> Value then
begin
FTextAlign := Value;
UpdateControlCanvas;
end;
end;
procedure TVrShadowButton.StyleChanged(Sender: TObject);
begin
UpdateControlCanvas;
end;
procedure TVrShadowButton.AdjustBtnRect(var Rect: TRect; Offset: Integer);
begin
case FDirection of
sdBottomRight: OffsetRect(Rect, Offset, Offset);
sdBottomLeft: OffsetRect(Rect, -Offset, Offset);
sdTopLeft: OffsetRect(Rect, -Offset, -Offset);
sdTopRight: OffsetRect(Rect, Offset, -Offset);
end;
end;
procedure TVrShadowButton.DrawButton;
const
ShapeStyles: array[TVrShadowButtonStyle] of TVrShapeType =
(stRectangle, stRoundRect);
var
ImageRect, ShadowRect: TRect;
begin
ImageRect := ClientRect;
with BitmapImage do
begin
InflateRect(ImageRect, -FPen.Width, -FPen.Width);
case FDirection of
sdBottomRight:
begin
Dec(ImageRect.Right, FDepth);
Dec(ImageRect.Bottom, FDepth);
end;
sdBottomLeft:
begin
Inc(ImageRect.Left, FDepth);
Dec(ImageRect.Bottom, FDepth);
end;
sdTopLeft:
begin
Inc(ImageRect.Top, FDepth);
Inc(ImageRect.Left, FDepth);
end;
sdTopRight:
begin
Inc(ImageRect.Top, FDepth);
Dec(ImageRect.Right, FDepth);
end;
end;
with Canvas do
begin
Pen.Width := 1;
Pen.Color := FShadowOutline;
Pen.Mode := pmCopy;
Pen.Style := psSolid;
Brush.Style := bsSolid;
Brush.Color := FShadowColor;
end;
ShadowRect := ImageRect;
AdjustBtnRect(ShadowRect, FDepth);
if Down then
AdjustBtnRect(ShadowRect, -1);
DrawShape(Canvas, ShapeStyles[FStyle], ShadowRect.Left, ShadowRect.Top,
ShadowRect.Right - ShadowRect.Left, ShadowRect.Bottom - ShadowRect.Top);
if Down then AdjustBtnRect(ImageRect, 2);
Canvas.Brush.Assign(FBrush);
Canvas.Pen.Assign(FPen);
Canvas.Font.Assign(Self.Font);
if not Enabled then Canvas.Font.Color := clInActiveCaption;
DrawShape(Canvas, ShapeStyles[FStyle], ImageRect.Left, ImageRect.Top,
ImageRect.Right - ImageRect.Left, ImageRect.Bottom - ImageRect.Top);
InflateRect(ImageRect, -Pen.Width, -Pen.Width);
Canvas.Brush.Style := bsClear;
DrawText(Canvas.Handle, PChar(Caption), -1, ImageRect,
DT_SINGLELINE + VrTextAlign[TextAlign]);
CurrentRect := ImageRect;
end;
end;
procedure TVrShadowButton.Paint;
begin
ClearBitmapCanvas;
DrawButton;
inherited Paint;
end;
procedure TVrShadowButton.CMTextChanged(var Message: TMessage);
begin
inherited;
UpdateControlCanvas;
end;
procedure TVrShadowButton.CMFontChanged(var Message: TMessage);
begin
inherited;
BitmapCanvas.Font.Assign(Self.Font);
UpdateControlCanvas;
end;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -