⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 linecapfrm.pas

📁 FlexGraphics是一套创建矢量图形的VCL组件
💻 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 + -