Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2005年04月23日] [更新 2012年09月03日]　Delphi サンプルプログラム集
190_線の端点形状と接合スタイル
動作確認等 Windows XP(SP3) + Delphi XE Pro
Windows 7 U64(SP1) + Delphi XE Pro
190_LineEdgeStyle.zip　[2,775 KB]　2012年09月03日版 (EXE 同梱)



  • 2012年09月03日
  • 表を加筆修正
  • 図形描画と接合スタイルのサンプルを 4 つ追加



線の端点形状と接合スタイル


線や図形を描く場合，GDI では端点の形状は，通常丸となります．Windows API の ExCreatePen 関数を使用するとこの形状を変更することができ，太い点線なども描画可能です．また，図形の直線あるいは，曲線の接合部分の形状も変更できます．

下表は ExtCreatePen 関数の第一引数で指定可能な，線の端点形状(エンドキャップ)，スタイル，結合の属性の値です．各表中の 1 つが指定可能で，それらの組み合わせで指定します．

古い Delphi には，これらの定数の定義はありません．MSDN の記事等で確認して定義します．


ペンタイプの値

PS_GEOMETRIC ジオメトリックペンの作成
(論理単位で指定する幅のペン)
PS_COSMETIC コスメティックペンの作成 (幅が 1 のペン)


ペンスタイルの値

PS_ALTERNATE 全てのピクセルを対象とした設定
コスメティックペンだけに適用可能
PS_SOLID 実線
PS_DASH 破線
PS_DOT 点線
PS_DASHDOT 一点鎖線
PS_DASH と PS_DOT の交互
PS_DASHDOTDOT 二点鎖線
PS_NULL 非可視のペン
PS_INSIDEFRAME 描画範囲に矩形領域を指定する描画関数用
ペンの幅を考慮に入れて図形を縮小描画する
ジオメトリックペンのみ対応
線は常に実線となる


端点形状の値

PS_ENDCAP_ROUND 丸
PS_ENDCAP_SQUARE 角
PS_ENDCAP_FLAT フラット


接合スタイルの値

PS_JOIN_BEBEL ベベル接合
PS_JOIN_MITER マイター接合
PS_JOIN_ROUND ラウンド接合




01_線の端点形状と太い点線


ExCreatePen 関数を使用して，直線の端点の形が変わることを確認するテストです．太い点線も描画します．


図1
実行結果

リスト1
線の端点形状の変更と太い点線 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption := '線の端点形状とスタイル';
end;

//=============================================================================
//  2本の線を，端点の形状を変えて描画
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  PenHandle : HPEN;
  LogBrush  : TLogBrush;
begin
  //最初の線
  Image1.Canvas.Pen.Width := 14;
  Image1.Canvas.Pen.Color := clBlue;

  Image1.Canvas.MoveTo( 20, 40);
  Image1.Canvas.LineTo(230, 40);


  //2番目の線
  LogBrush.lbStyle := BS_SOLID;
  LogBrush.lbColor := clBlue;
  LogBrush.lbHatch := 0;
  PenHandle := ExtCreatePen(PS_GEOMETRIC   or  //ジオメトリック
                            PS_DOT         or  //点線
                            PS_ENDCAP_FLAT or  //端はフラット
                            PS_JOIN_MITER,     //マイター接続
                            14,                //幅
                            LogBrush,          //Blush情報
                            0, nil);
  try
    Image1.Canvas.Pen.Handle := PenHandle;
    Image1.Canvas.MoveTo( 20, 70);
    Image1.Canvas.LineTo(230, 70);
  finally
    DeleteObject(PenHandle);
  end;

  //3番目の線
  LogBrush.lbColor := clGreen;
  PenHandle := ExtCreatePen(PS_GEOMETRIC   or  //ジオメトリック
                            PS_SOLID       or  //塗潰し
                            PS_ENDCAP_FLAT or  //端はフラット
                            PS_JOIN_MITER,     //マイター接続
                            14,                //幅
                            LogBrush,          //Blush情報
                            0, nil);
  try
    Image1.Canvas.Pen.Handle := PenHandle;
    Image1.Canvas.MoveTo( 20, 100);
    Image1.Canvas.LineTo(230, 100);
  finally
    DeleteObject(PenHandle);
  end;
end;

end.



02_直線の複数描画と端点形状


TCanvas に直線を複数描けば，画面の上では図形として見えます．
ただし，これらの直線は結合されているわけではありません．1 つ 1 つの直線が独立した図形となりまます．したがって，接合スタイルの設定は無効となります．これを確認するテストです．

この先のサンプルでは，ExtCreatePen 関数で描画する部分を Form1 のメソッドにしています．メソッド名が全て同じ名前となっていますが，サンプルによって引数の内容もコードも違います．


図2
設計時画面
  • 破線は TImage
図3
PS_ENDCAP_ROUND の場合
  • 全て単独の直線なので，接合スタイルの設定は無効
  • 白線は，太さ 1 の実線
図4
PS_ENDCAP_FLAT の場合

リスト2
直線の複数描画と端点形状 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    RadioGroup1: TRadioGroup;
    RadioGroup2: TRadioGroup;
    procedure Button1Click(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    procedure DrawShapeByPenhandle(ACanvas: TCanvas; Points: array of TPoint;
      AColor: Cardinal; AWidth: Cardinal; EndCap : Cardinal; JoinType: Cardinal);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption := 'ExtCreatePen  LineToでの線は単独図形';

  //GDIによる描画の際のデフォルトの設定
  RadioGroup1.ItemIndex := 1;
  RadioGroup2.ItemIndex := 2;
end;

//=============================================================================
//  指定した設定内容で線を描画
//  LineToによる直線は，各々が単独図形であることの確認用
//  したがって，線の接合スタイルを指定しても無効であることが確認できる
//
//  [注意]
//  本サンプルには，実際にはTButtonは配置していない．メソッド代わりに使用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  P1         : TPoint;
  EndCap     : Cardinal;
  JoinType   : Cardinal;
  PointArray : array of TPoint;
begin
  //描画する図形よりも少し大きめに設定
  Image1.Width  := 150;
  Image1.Height := 150;

  //端点の形と結合スティルを設定
  EndCap   := PS_ENDCAP_ROUND;
  JoinType := PS_JOIN_ROUND;
  if RadioGroup1.ItemIndex = 0 then EndCap := PS_ENDCAP_FLAT;
  if RadioGroup1.ItemIndex = 1 then EndCap := PS_ENDCAP_ROUND;
  if RadioGroup1.ItemIndex = 2 then EndCap := PS_ENDCAP_SQUARE;

  if RadioGroup2.ItemIndex = 0 then JoinType := PS_JOIN_BEVEL;
  if RadioGroup2.ItemIndex = 1 then JoinType := PS_JOIN_MITER;
  if RadioGroup2.ItemIndex = 2 then JoinType := PS_JOIN_ROUND;

  //動的配列のサイズ設定
  SetLength(PointArray, 3);
  //動的配列に点の座標値を代入
  P1 := Point(80, 30);
  PointArray[0] := Point(P1.X,      P1.Y);
  PointArray[1] := Point(P1.X + 50, P1.Y + 100);
  PointArray[2] := Point(P1.X - 50, P1.Y + 100);


  //直線を複数を描画して，三角形に見せる
  Image1.Picture.Assign(nil);
  DrawShapeByPenhandle(Image1.Canvas, PointArray, $0000AA55, 16,
                       EndCap, JoinType);
  //前に描画した内容を消去しないで，点を結ぶ線を太さ1の線で描画
  Image1.Canvas.Brush.Style := bsClear;
  DrawShapeByPenhandle(Image1.Canvas, PointArray, clWhite, 1,
                       EndCap, JoinType);


  //動的配列の明示的解放
  //実際には不要(本サンプルでは続けて実行するために，初期化の意味で実行)
  Finalize(PointArray);
end;

//=============================================================================
//  RadioGroup1とRadioGroup2共有のOnClickイベント
//=============================================================================
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  //Button1をクリックした時と同じコードを実行
  Button1Click(nil);
end;

//=============================================================================
//  引数で指定するスタイルで点を結ぶ直線を描画するメソッド
//  LineToによる直線は，各々が単独図形であることの確認用
//  線は実線固定
//
//  ACanvas   : 描画先のTCanvas
//  Points    : 点の座標値を格納した配列
//  AColor    : 線の色
//  AWidth    : 線の太さ
//  EndCap    : 線の端の形状
//  JoinType  : 線の結合タイプ
//
//  [備考]
//  本サンプルの配列Pointsの定義方法では，この関数内で配列サイズの変更は不可
//=============================================================================
procedure TForm1.DrawShapeByPenhandle(ACanvas: TCanvas; Points: array of TPoint;
  AColor, AWidth, EndCap, JoinType: Cardinal);
var
  PenStyle  : Cardinal;
  PenHandle : HPEN;
  LogBrush  : TLogBrush;
  i         : Integer;
begin
  LogBrush.lbStyle := BS_SOLID;
  LogBrush.lbColor := AColor;
  LogBrush.lbHatch := 0;
  PenStyle         := PS_GEOMETRIC or PS_SOLID or EndCap or JoinType;
  PenHandle        := ExtCreatePen(PenStyle, AWidth, LogBrush, 0, nil);
  try
    ACanvas.Pen.Handle := PenHandle;

    ACanvas.MoveTo (Points[0].X, Points[0].Y);
    for i := 1 to Length(Points) - 1 do begin
      ACanvas.LineTo (Points[i].X, Points[i].Y);
    end;
    ACanvas.LineTo (Points[0].X, Points[0].Y);
  finally
    DeleteObject(PenHandle);
  end;
end;

end.



03_閉じた図形と開いた図形 - 三角形


MoveTo，LineTo で描画した直線群を 1 つの図形として扱うには無理があります．一般的に，図形は専用のメソッド類を使用して描画します．より複雑な図形の場合は，リージョンやパスを使用することになります．逆に，単純な図形であれば TShape が使えます．

図形描画用のメソッドを使用して描画した直線や曲線は結合されています．その結合部に対して接合のスタイルを設定すると，その形状を指定することができます．
ここでは，閉じた図形描画に Polygon メソッドを，開いた図形には Polyline メソッドを使用して，接合スタイルの動作を確認してみました．図形は三角形としています．

これ以降のサンプルでは，描画の座標値の格納に配列(オープン配列)を使用しているだけですが，座標の追加や削除を伴うアプリケーションでは，座標値の管理に，TList あるいはジェネリックスを併用する場面も考えられます．


図5
設計時画面
  • 破線は TImage
図6
ラウンド接合の場合
  • 左は閉じた図形なので，線の端点の設定は無効
  • 右は開いた図形．開いた部分(端点)では端点の設定になる．結合部分は接合スタイルの設定になる
  • 白線は，太さ 1 の実線
図7
ベベル接合の場合
  • 端点は，PS_ENDCAP_FLAT
図8
マイター接合の場合
  • 端点は，PS_ENDCAP_SQUARE

リスト3
閉じた図形と開いた図形 - 三角形 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    RadioGroup1: TRadioGroup;
    RadioGroup2: TRadioGroup;
    Image2: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure DrawShapeByPenhandle(ACanvas: TCanvas; Points: array of TPoint;
      AColor: Cardinal; AWidth: Cardinal; EndCap : Cardinal; JoinType: Cardinal;
      ClosedFlag: Boolean);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption := 'ExtCreatePen  閉じた図形と開いた図形 三角形';

  //GDIによる描画の際のデフォルトの設定
  RadioGroup1.ItemIndex := 1;
  RadioGroup2.ItemIndex := 2;
end;

//=============================================================================
//  指定した設定内容で図形を描画
//  PolygonとPolylineによる三角形の描画
//  各々直線が結合されるので，線の接合スタイルの設定が有効となる
//
//  [注意]
//  本サンプルには，実際にはTButtonは配置していない．メソッド代わりに使用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  P1         : TPoint;
  EndCap     : Cardinal;
  JoinType   : Cardinal;
  PointArray : array of TPoint;
begin
  //描画する図形よりも少し大きめに設定
  Image1.Width  := 150;
  Image1.Height := 150;
  Image2.Width  := Image1.Width;
  Image2.Height := Image1.Height;

  //端点の形と結合スティルを設定
  EndCap   := PS_ENDCAP_ROUND;
  JoinType := PS_JOIN_ROUND;
  if RadioGroup1.ItemIndex = 0 then EndCap := PS_ENDCAP_FLAT;
  if RadioGroup1.ItemIndex = 1 then EndCap := PS_ENDCAP_ROUND;
  if RadioGroup1.ItemIndex = 2 then EndCap := PS_ENDCAP_SQUARE;

  if RadioGroup2.ItemIndex = 0 then JoinType := PS_JOIN_BEVEL;
  if RadioGroup2.ItemIndex = 1 then JoinType := PS_JOIN_MITER;
  if RadioGroup2.ItemIndex = 2 then JoinType := PS_JOIN_ROUND;

  //動的配列のサイズ設定
  SetLength(PointArray, 3);
  //動的配列に点の座標値を代入
  P1 := Point(80, 30);
  PointArray[0] := Point(P1.X,      P1.Y);
  PointArray[1] := Point(P1.X + 50, P1.Y + 100);
  PointArray[2] := Point(P1.X - 50, P1.Y + 100);


  //閉じた図形を描画
  Image1.Picture.Assign(nil);
  DrawShapeByPenhandle(Image1.Canvas, PointArray, $0000AA55, 16,
                       EndCap, JoinType, True);
  //前に描画した内容を消去しないで，点を結ぶ線を太さ1の線で描画
  Image1.Canvas.Brush.Style := bsClear;
  DrawShapeByPenhandle(Image1.Canvas, PointArray, clWhite, 1,
                       EndCap, JoinType, True);


  //開いた図形を描画
  Image2.Picture.Assign(nil);
  DrawShapeByPenhandle(Image2.Canvas, PointArray, $0000AA55, 16,
                       EndCap, JoinType, False);
  //前に描画した内容を消去しないで，点を結ぶ線を太さ1の線で描画
  Image2.Canvas.Brush.Style := bsClear;
  DrawShapeByPenhandle(Image2.Canvas, PointArray, clWhite, 1,
                       EndCap, JoinType, True);


  //動的配列の明示的解放
  //実際には不要(本サンプルでは続けて実行するために，初期化の意味で実行)
  Finalize(PointArray);
end;

//=============================================================================
//  RadioGroup1とRadioGroup2共有のOnClickイベント
//=============================================================================
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  //Button1をクリックした時と同じコードを実行
  Button1Click(nil);
end;

//=============================================================================
//  引数で指定するスタイルで点と点を結ぶ図形を描画するメソッド
//  このメソッドでは，線は実線に固定している
//  閉じた図形と開いた図形の端点と結合スタイルの確認用
//  図形は，基本的に図形描画用の関数類を使用する
//
//  ACanvas   : 描画先のTCanvas
//  Points    : 点の座標値を格納した配列
//  AColor    : 線の色
//  AWidth    : 線の太さ
//  EndCap    : 線の端の形状
//  JoinType  : 線の結合タイプ
//  CloseFlag : 始点と終点を閉じた図形とするかのフラグ
//
//  [備考]
//  本サンプルの配列Pointsの定義方法では，この関数内で配列サイズの変更は不可
//=============================================================================
procedure TForm1.DrawShapeByPenhandle(ACanvas: TCanvas; Points: array of TPoint;
  AColor, AWidth, EndCap, JoinType: Cardinal; ClosedFlag: Boolean);
var
  PenStyle  : Cardinal;
  PenHandle : HPEN;
  LogBrush  : TLogBrush;
begin
  LogBrush.lbStyle := BS_SOLID;
  LogBrush.lbColor := AColor;
  LogBrush.lbHatch := 0;
  PenStyle         := PS_GEOMETRIC or PS_SOLID or EndCap or JoinType;
  PenHandle        := ExtCreatePen(PenStyle, AWidth, LogBrush, 0, nil);
  try
    ACanvas.Pen.Handle := PenHandle;
    if ClosedFlag then begin
      //閉じた図形
      //本サンプルの場合であれば，以下でも可
      //ACanvas.Polygon(Points);
      ACanvas.Polygon(Slice(Points, Length(Points)));
    end else begin
      //開いた図形
      ACanvas.Polyline(Points);
    end;
  finally
    DeleteObject(PenHandle);
  end;
end;

end.


マイター接合は，接合部分が鋭角になると自動的にフラット接合になります．このことを確認したのが下の図です．リストはこの確認に使用したコードです．


図9
鋭角のマイター接合

リスト4
マイター接合が，鋭角になるとフラット接合になることを確認するのに使用したコード 
procedure TForm1.Button1Click(Sender: TObject);
var
  P1         : TPoint;
  EndCap     : Cardinal;
  JoinType   : Cardinal;
  PointArray : array of TPoint;
begin
  EndCap   := PS_ENDCAP_ROUND;
  JoinType := PS_JOIN_MITER;
  if RadioGroup2.ItemIndex = 0 then JoinType := PS_JOIN_BEVEL;
  if RadioGroup2.ItemIndex = 1 then JoinType := PS_JOIN_MITER;
  if RadioGroup2.ItemIndex = 2 then JoinType := PS_JOIN_ROUND;

  SetLength(PointArray, 3);

  P1 := Point(20, 20);
  PointArray[0] := Point(P1.X,       P1.Y);
  PointArray[1] := Point(P1.X + 200, P1.Y + 40);
  PointArray[2] := Point(P1.X,       P1.Y + 40);

  Image1.Picture.Assign(nil);
  DrawShapeByPenhandle(Image1.Canvas, PointArray, $0000AA55, 16,
                       EndCap, JoinType, True);
  Image1.Canvas.Brush.Style := bsClear;
  DrawShapeByPenhandle(Image1.Canvas, PointArray, clWhite, 1,
                       EndCap, JoinType, True);


  P1 := Point(20, 100);
  PointArray[0] := Point(P1.X,       P1.Y);
  PointArray[1] := Point(P1.X + 200, P1.Y + 30);
  PointArray[2] := Point(P1.X,       P1.Y + 30);

  DrawShapeByPenhandle(Image1.Canvas, PointArray, $0000AA55, 16,
                       EndCap, JoinType, True);
  Image1.Canvas.Brush.Style := bsClear;
  DrawShapeByPenhandle(Image1.Canvas, PointArray, clWhite, 1,
                       EndCap, JoinType, True);

  Finalize(PointArray);
end;


このマイター結合の長さは，接合する線の内側の交点から外側の交点までの距離ですが，この長さは以下のように，GetMiterLimit 関数を使用して設定することができます．制限値は，マイター接合の長さと線幅の比率で設定します．既定のマイター制限値は 10.0 となっています．
マイター接合の制限値の値は GetMiterLimit 関数で取得します．


上のリストで使用した DrawShapeByPenhandle 関数内で，マイター接合の長さを制限する
NewLimit と Limit は Single 型の変数 
      NewLimit := 2.0;
      SetMiterLimit(Image1.Canvas.Handle, NewLimit, PSingle(Limit));
      ACanvas.Polygon(Slice(Points, Length(Points)));


マイター結合の制限値を取得する．Limit は Single 型の変数 
  GetMiterLimit(Image1.Canvas.Handle, Limit);
  ShowMessage(FloatToStr(Limit));



04_閉じた図形と開いた図形 - 四角形


上のサンプルと同じく，図形を描画して接合スタイルを確認するテストですが，端点を 1 つ増やして四角形にしています．
メソッド DrawShapeByPenhandle は，上のサンプルのコードと全く同じで，閉じた図形にはPolygon メソッドを，開いた図形には Polyline メソッドを使用しています．したがって，端点の数に関係なく利用可能なメソッドとなっています．
四角形の描画には，Rectangle というメソッドもあります．


図10
設計時画面
  • 破線は TImage
図11
ラウンド接合の場合
  • 左は閉じた図形なので，線の端点の設定は無効
  • 右は開いた図形．開いた部分(端点)では端点の設定になる．結合部分は接合スタイルの設定になる
  • 白線は，太さ 1 の実線
図12
ベベル接合の場合
  • 端点は，PS_ENDCAP_ROUND
図13
マイター接合の場合
  • 端点は，PS_ENDCAP_FLAT

リスト5
閉じた図形と開いた図形 - 四角形 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    RadioGroup1: TRadioGroup;
    RadioGroup2: TRadioGroup;
    Image2: TImage;
    procedure Button1Click(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    procedure DrawShapeByPenhandle(ACanvas: TCanvas; Points: array of TPoint;
      AColor: Cardinal; AWidth: Cardinal; EndCap : Cardinal; JoinType: Cardinal;
      ClosedFlag: Boolean);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption := 'ExtCreatePen  閉じた図形と開いた図形 四角形';

  //GDIによる描画の際のデフォルトの設定
  RadioGroup1.ItemIndex := 1;
  RadioGroup2.ItemIndex := 2;
end;

//=============================================================================
//  指定した設定内容で図形を描画
//  PolygonとPolylineによる四角形の描画
//  各々の線が結合されるので，線の接合スタイルの設定が有効となる
//
//  [注意]
//  本サンプルには，実際にはTButtonは配置していない．メソッド代わりに使用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  P1         : TPoint;
  EndCap     : Cardinal;
  JoinType   : Cardinal;
  PointArray : array of TPoint;
begin
  //描画する図形よりも少し大きめに設定
  Image1.Width  := 150;
  Image1.Height := 150;
  Image2.Width  := Image1.Width;
  Image2.Height := Image1.Height;

  //端点の形と結合スティルを設定
  EndCap   := PS_ENDCAP_ROUND;
  JoinType := PS_JOIN_ROUND;
  if RadioGroup1.ItemIndex = 0 then EndCap := PS_ENDCAP_FLAT;
  if RadioGroup1.ItemIndex = 1 then EndCap := PS_ENDCAP_ROUND;
  if RadioGroup1.ItemIndex = 2 then EndCap := PS_ENDCAP_SQUARE;

  if RadioGroup2.ItemIndex = 0 then JoinType := PS_JOIN_BEVEL;
  if RadioGroup2.ItemIndex = 1 then JoinType := PS_JOIN_MITER;
  if RadioGroup2.ItemIndex = 2 then JoinType := PS_JOIN_ROUND;

  //動的配列のサイズ設定
  SetLength(PointArray, 4);
  //動的配列に点の座標値を代入
  P1 := Point(30, 30);
  PointArray[0] := Point(P1.X,       P1.Y);
  PointArray[1] := Point(P1.X + 100, P1.Y);
  PointArray[2] := Point(P1.X + 100, P1.Y + 80);
  PointArray[3] := Point(P1.X,       P1.Y + 80);


  //閉じた図形を描画
  Image1.Picture.Assign(nil);
  DrawShapeByPenhandle(Image1.Canvas, PointArray, $0000AA55, 16,
                       EndCap, JoinType, True);
  //前に描画した内容を消去しないで，点を結ぶ線を太さ1の線で描画
  Image1.Canvas.Brush.Style := bsClear;
  DrawShapeByPenhandle(Image1.Canvas, PointArray, clWhite, 1,
                       EndCap, JoinType, True);


  //開いた図形を描画
  Image2.Picture.Assign(nil);
  DrawShapeByPenhandle(Image2.Canvas, PointArray, $0000AA55, 16,
                       EndCap, JoinType, False);
  //前に描画した内容を消去しないで，点を結ぶ線を太さ1の線で描画
  Image2.Canvas.Brush.Style := bsClear;
  DrawShapeByPenhandle(Image2.Canvas, PointArray, clWhite, 1,
                       EndCap, JoinType, True);


  //動的配列の明示的解放
  //実際には不要(本サンプルでは続けて実行するために，初期化の意味で実行)
  Finalize(PointArray);
end;

//=============================================================================
//  RadioGroup1とRadioGroup2共有のOnClickイベント
//=============================================================================
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  //Button1をクリックした時と同じコードを実行
  Button1Click(nil);
end;

//=============================================================================
//  引数で指定するスタイルで点と点を結ぶ図形を描画するメソッド
//  このメソッドでは，線は実線に固定している
//  閉じた図形と開いた図形の端点と結合スタイルの確認用
//  図形は，基本的に図形描画用の関数類を使用する
//
//  ACanvas   : 描画先のTCanvas
//  Points    : 点の座標値を格納した配列
//  AColor    : 線の色
//  AWidth    : 線の太さ
//  EndCap    : 線の端の形状
//  JoinType  : 線の結合タイプ
//  CloseFlag : 始点と終点を結んだ閉じた図形とするかのフラグ
//
//  [備考]
//  本サンプルの配列Pointsの定義方法では，この関数内で配列サイズの変更は不可
//=============================================================================
procedure TForm1.DrawShapeByPenhandle(ACanvas: TCanvas; Points: array of TPoint;
  AColor, AWidth, EndCap, JoinType: Cardinal; ClosedFlag: Boolean);
var
  PenStyle  : Cardinal;
  PenHandle : HPEN;
  LogBrush  : TLogBrush;
begin
  LogBrush.lbStyle := BS_SOLID;
  LogBrush.lbColor := AColor;
  LogBrush.lbHatch := 0;
  PenStyle         := PS_GEOMETRIC or PS_SOLID or EndCap or JoinType;
  PenHandle        := ExtCreatePen(PenStyle, AWidth, LogBrush, 0, nil);
  try
    ACanvas.Pen.Handle := PenHandle;
    if ClosedFlag then begin
      //閉じた図形
      //四角形であれば，以下でも可
      //ACanvas.Rectangle(Points[0].X, Points[0].Y, Points[2].X, Points[2].Y);
      ACanvas.Polygon(Slice(Points, Length(Points)));
    end else begin
      //開いた図形
      ACanvas.Polyline(Points);
    end;
  finally
    DeleteObject(PenHandle);
  end;
end;

end.



05_PS_INSIDEFRAME フラグの効果


図形描画用のメソッドの中には，Arc，Ellipse，Pie，Rectangle，RoundRect のように，描画領域の指定座標値に矩形範囲を引数に使用するものがあります．
このようなメソッドで，TCanvas のサイズと同じ矩形範囲に描画すると，太い線の時に線のサイズの半分が描画されないことがあります．この場合，線のスタイルに PS_INSIDEFRAME を含めると図形のサイズを自動的に縮小して，矩形領域に収まるように描画することができます．そのテストです．


図14
設計時画面
  • 破線は TImage
  • サイズは描画領域と同じにしている
図15
実行結果
  • 左が PS_INSIDEFRAME を指定した場合
    領域内に縮小描画されている
  • 右が指定しない場合
    上下左右の描画が欠落している

リスト6
PS_INSIDEFRAME フラグの効果 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    procedure DrawShapeByPenhandle(ACanvas: TCanvas; X1, Y1, X2, Y2: Integer;
      AColor: Cardinal; AWidth: Cardinal; Inside: Boolean);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption := 'ExtCreatePen  PS_INSIDEFRAMEの効果';

  //描画する図形と同じサイズに設定(線の太さを含まないサイズ)
  Image1.Width  := 150;
  Image1.Height := 100;
  Image2.Width  := Image1.Width;
  Image2.Height := Image1.Height;

  //PS_INSIDEFRAMEを指定しで描画
  Image1.Picture.Assign(nil);
  DrawShapeByPenhandle(Image1.Canvas, 0, 0, Image1.Width, Image1.Height,
                       $0000AA55, 10, True);

  //PS_INSIDEFRAMEを指定しないで描画
  Image2.Picture.Assign(nil);
  DrawShapeByPenhandle(Image2.Canvas, 0, 0, Image2.Width, Image2.Height,
                       $0000AA55, 10, False);
end;

//=============================================================================
//  引数で指定するスタイルで楕円を描画するメソッド
//  PS_INSIDEFRAMEフラグの効果の確認用
//  PS_INSIDEFRAMEフラグが有効となるのは，矩形領域の座標を使用する図形描画
//  PS_INSIDEFRAMEを指定した場合は，常に実線となる
//
//  ACanvas   : 描画先のTCanvas
//  X1        : 描画矩形領域の左端X座標値
//  Y1        : 描画矩形領域の左端Y座標値
//  X2        : 描画矩形領域の右端X座標値
//  Y2        : 描画矩形領域の右端Y座標値
//  AColor    : 線の色
//  AWidth    : 線の太さ
//  Inside    : PS_INSIDEFRAMEフラグを含める時はTureにする
//=============================================================================
procedure TForm1.DrawShapeByPenhandle(ACanvas: TCanvas;
  X1, Y1, X2, Y2: Integer; AColor, AWidth: Cardinal; Inside: Boolean);
var
  PenStyle  : Cardinal;
  PenHandle : HPEN;
  LogBrush  : TLogBrush;
begin
  LogBrush.lbStyle := BS_SOLID;
  LogBrush.lbColor := AColor;
  LogBrush.lbHatch := 0;
  if Inside then begin
    PenStyle := PS_GEOMETRIC or PS_INSIDEFRAME;
  end else begin
    PenStyle := PS_GEOMETRIC or PS_SOLID;
  end;
  PenHandle := ExtCreatePen(PenStyle, AWidth, LogBrush, 0, nil);
  try
    ACanvas.Pen.Handle := PenHandle;
    ACanvas.Ellipse(X1, Y1, X2, Y2);
  finally
    DeleteObject(PenHandle);
  end;
end;

end.