📄 linecapfrm.pas
字号:
unit LineCapFrm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ExtCtrls, FlexProps, FlexUtils, FlexPath, FlexControls,
RXSpin, RxCombos, ColorComboEdit;
type
TLineCapPropForm = class(TForm)
Panel1: TPanel;
Label1: TLabel;
cbLineCapStyles: TComboBox;
chFixedSize: TCheckBox;
chFixedOutline: TCheckBox;
chFixedFill: TCheckBox;
bbOk: TBitBtn;
bbCancel: TBitBtn;
ccbOutlineColor: TColorComboEdit;
ccbFillColor: TColorComboEdit;
sedSize: TRxSpinEdit;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure chCheckClick(Sender: TObject);
procedure cbLineCapStylesDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
private
{ Private declarations }
FLineCapProp: TLineCapProp;
public
{ Public declarations }
end;
var
LineCapPropForm: TLineCapPropForm;
implementation
{$R *.DFM}
procedure TLineCapPropForm.FormCreate(Sender: TObject);
var i: integer;
begin
// Fill cap styles
for i:=0 downto psLastStandard do cbLineCapStyles.Items.Add('');
end;
procedure TLineCapPropForm.FormShow(Sender: TObject);
begin
if (Tag <> 0) and (TObject(Tag) is TLineCapProp) then
FLineCapProp := TLineCapProp(Tag);
if Assigned(FLineCapProp) then with FLineCapProp do begin
cbLineCapStyles.ItemIndex := -CapStyle;
// Size
chFixedSize.Checked := FixedSize;
sedSize.Value := Size / PixelScaleFactor;
sedSize.Enabled := FixedSize;
// Outline
chFixedOutline.Checked := FixedOutlineColor;
ccbOutlineColor.ColorValue := OutlineColor;
ccbOutlineColor.Enabled := FixedOutlineColor;
// Fill
chFixedFill.Checked := FixedFillColor;
ccbFillColor.ColorValue := FillColor;
ccbFillColor.Enabled := FixedFillColor;
end;
end;
procedure TLineCapPropForm.FormClose(Sender: TObject; var Action: TCloseAction);
var Recording: boolean;
begin
if (ModalResult <> mrOk) or not Assigned(FLineCapProp) then exit;
with FLineCapProp do begin
Recording := Assigned(Owner.History) and
Assigned(Owner.History.BeginAction(TPropHistoryGroup, FLineCapProp));
try
CapStyle := -cbLineCapStyles.ItemIndex;
FixedSize := chFixedSize.Checked;
Size := Round(sedSize.Value * PixelScaleFactor);
FixedOutlineColor := chFixedOutline.Checked;
OutlineColor := ccbOutlineColor.ColorValue;
FixedFillColor := chFixedFill.Checked;
FillColor := ccbFillColor.ColorValue;
finally
if Recording then Owner.History.EndAction;
end;
end;
end;
procedure TLineCapPropForm.chCheckClick(Sender: TObject);
begin
sedSize.Enabled := chFixedSize.Checked;
ccbOutlineColor.Enabled := chFixedOutline.Checked;
ccbFillColor.Enabled := chFixedFill.Checked;
end;
procedure TLineCapPropForm.cbLineCapStylesDrawItem(Control: TWinControl;
Index: Integer; Rect: TRect; State: TOwnerDrawState);
var R: TRect;
Y: integer;
p0, p1: TPoint;
CapStyle: integer;
Info: TLineCapInfo;
begin
with Control as TComboBox, Canvas do begin
Brush.Style := bsSolid;
FillRect(Rect);
//R := Classes.Rect(Rect.Left+3, Rect.Top+3, Rect.Left + 38, Rect.Bottom - 3);
//R := Rect;
//InflateRect(R, -3, -3);
R := Classes.Rect(Rect.Left+6, Rect.Top+3, Rect.Right-6, Rect.Bottom-3);
if odSelected in State
then Pen.Color := clWhite
else Pen.Color := clBlack;
Brush.Color := Pen.Color;
Y := R.Top + (R.Bottom - R.Top) div 2;
// Define cap style
CapStyle := -Index;
if GetLineCapInfo(CapStyle, Info, R.Bottom - R.Top) then begin
// Adjust line size
dec(R.Right, Info.Bounds.Right);
// Draw line
MoveTo(R.Left, Y);
LineTo(R.Right, Y);
// Draw cap
p0.x := R.Left;
p0.y := Y;
p1.x := R.Right;
p1.y := Y;
RenderCap(Handle, CapStyle, p0, p1, R.Bottom - R.Top);
end else begin
// Draw line only
MoveTo(R.Left, Y);
LineTo(R.Right, Y);
end;
end;
end;
initialization
RegisterDefaultPropEditForm(TLineCapProp, TLineCapPropForm);
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -