再学 GDI+[36]: TGPPen SetLineCap

本例效果图:

---

代码文件:

---

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    ComboBox3: TComboBox;
    ComboBox4: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure ComboBox3Change(Sender: TObject);
    procedure ComboBox4Change(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses GDIPOBJ, GDIPAPI, TypInfo;

var StartCap,EndCap,DashCap: Integer;

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  ComboBox1.Text := '虚线样式';
  ComboBox2.Text := '起点线帽';
  ComboBox3.Text := '中间线帽';
  ComboBox4.Text := '终点线帽';

  for i := 0 to 5 do
    ComboBox1.Items.Add(GetEnumName(TypeInfo(TDashStyle), i));

  ComboBox2.Items.Add('LineCapFlat');
  ComboBox2.Items.Add('LineCapSquare');
  ComboBox2.Items.Add('LineCapRound');
  ComboBox2.Items.Add('LineCapTriangle');
  ComboBox2.Items.Add('LineCapNoAnchor');
  ComboBox2.Items.Add('LineCapSquareAnchor');
  ComboBox2.Items.Add('LineCapRoundAnchor');
  ComboBox2.Items.Add('LineCapDiamondAnchor');
  ComboBox2.Items.Add('LineCapArrowAnchor');

  ComboBox3.Items := ComboBox2.Items;
  ComboBox4.Items := ComboBox2.Items;
end;

procedure TForm1.FormPaint(Sender: TObject);
const
  ColorArr: array[0..2] of TGPColor = (aclRed, aclGreen, aclBlue);
var
  g: TGPGraphics;
  p: TGPPen;
  x1,x2,y: Integer;
  i: Integer;
begin
  g := TGPGraphics.Create(Canvas.Handle);
  p := TGPPen.Create($FF000000, 16);

  p.SetDashStyle(TDashStyle(ComboBox1.ItemIndex));
  p.SetLineCap(StartCap, EndCap, DashCap);

  x1 := 50;
  x2 := ClientWidth - 50;
  y := 60;
  for i := 0 to 2 do
  begin
    p.SetColor(ColorArr[i]);
    g.DrawLine(p, x1, y, x2, y);
    Inc(y, 40);
  end;

  p.Free;
  g.Free;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  Repaint;
end;

procedure TForm1.ComboBox2Change(Sender: TObject);
var
  i: Integer;
begin
  i := 0;
  case TComboBox(Sender).ItemIndex of
    0 : i := LineCapFlat;
    1 : i := LineCapSquare;
    2 : i := LineCapRound;
    3 : i := LineCapTriangle;
    4 : i := LineCapNoAnchor;
    5 : i := LineCapSquareAnchor;
    6 : i := LineCapRoundAnchor;
    7 : i := LineCapDiamondAnchor;
    8 : i := LineCapArrowAnchor;
    9 : i := LineCapCustom;
    10: i := LineCapAnchorMask;
  end;
  if TComboBox(Sender) = ComboBox2 then StartCap := i;
  if TComboBox(Sender) = ComboBox3 then DashCap := i;
  if TComboBox(Sender) = ComboBox4 then EndCap := i;
  Repaint;
end;

procedure TForm1.ComboBox3Change(Sender: TObject);
begin
  ComboBox2Change(Sender);
end;

procedure TForm1.ComboBox4Change(Sender: TObject);
begin
  ComboBox2Change(Sender);
end;

end.

窗体文件:

---

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 165
  ClientWidth = 515
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  OnCreate = FormCreate
  OnPaint = FormPaint
  PixelsPerInch = 96
  TextHeight = 13
  object ComboBox1: TComboBox
    Left = 8
    Top = 8
    Width = 121
    Height = 21
    ItemHeight = 13
    TabOrder = 0
    Text = 'ComboBox1'
    OnChange = ComboBox1Change
  end
  object ComboBox2: TComboBox
    Left = 135
    Top = 8
    Width = 121
    Height = 21
    ItemHeight = 13
    TabOrder = 1
    Text = 'ComboBox2'
    OnChange = ComboBox2Change
  end
  object ComboBox3: TComboBox
    Left = 262
    Top = 8
    Width = 121
    Height = 21
    ItemHeight = 13
    TabOrder = 2
    Text = 'ComboBox3'
    OnChange = ComboBox3Change
  end
  object ComboBox4: TComboBox
    Left = 389
    Top = 8
    Width = 121
    Height = 21
    ItemHeight = 13
    TabOrder = 3
    Text = 'ComboBox4'
    OnChange = ComboBox4Change
  end
end