Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2012年11月02日] [更新 2012年11月17日] 画像・図形の移動リサイズ関係サンプル
 
画像・図形の移動リサイズ関係サンプル 
R190_単純なベジェ曲線の操作例
動作確認等 Windows XP(SP3) + Delphi XE Pro
Windows 7 U64(SP1) + Delphi XE Pro
R190_DrawBezierTest.zip [578 KB] 2012年11月17日版(EXE同梱)







単純なベジェ曲線の操作例


前のページで,フローチャート等で使用されている「文書」あるいは「帳票」と呼ばれている図形を描画するクラスを作成しました.
このクラスではベジェ曲線を使用しています.Asuyu さんのサイトに,ベジェ曲線の説明記事があります.この記事を参考にして,実際にマウスで曲線を操作するコードを作成してみました.
直線,曲線を組み合わせると,いろいろな図形を作成することができます.しかし,Draw 系 (ドロー系) のアプリケーションでもそうですが,実際に思い通りの図形にするのは結構面倒であることが理解できると思います.

このテストプログラムでは,TPanel の Canvas に描画しますが,この TPanel を実行時に生成しています.図形の描画には,Paint メソッドに描画コードを書く必要がありますが,この Paint メソッドを実装するために,TPanel の継承クラスを作成して,それを実行時に生成します.
フォームに直接描画する場合は,フォームの OnPaint イベント内に描画コードを書きます.実際のアプリケーションでは,フォームに直接描画することないと思われます.そこで,意図的にこのようにしています.
チラつき防止のコードも,フォームに直接描画した場合と違っていることに注意してください.チラつきの防止方法は,アプリケーションの実装方法によっても違ってくるという例です.


図1
設計時画面
図2
実行開始画面
  • グラブハンドル (小さな四角形) をマウスでドラッグ操作する
図3
操作結果の例

リスト1
単純なベジェ曲線を操作するテストコード
unit Unit1;

interface

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

type
  TMyPanle = class(TPanel)

  protected
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    MyPanle : TMyPanle;
  end;

var
  Form1: TForm1;

implementation

uses GDIPOBJ,GDIPAPI;

{$R *.DFM}

var
  PointArray : array[0..3] of TGPPoint = ((X:30;  Y:100),
                                          (X:120; Y:10),
                                          (X:170; Y:150),
                                          (X:220; Y:100));
  PointNumber : Integer = -1;
  MoveFlag    : Boolean;
  GrabSize    : Integer = 3;

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := '単純なベジェ曲線の例';

  //TMyPanelを生成して配置
  MyPanle := TMyPanle.Create(Self);
  with MyPanle do begin
    Parent  := Self;
    Left    := 5;
    Top     := 5;
    Width   := Self.ClientWidth  - 10;
    Height  := Self.ClientHeight - 10;
    Anchors := [akLeft, akTop, akRight, akBottom];
  end;
end;

{ TMyPanle }

//-----------------------------------------------------------------------------
//  MouseDown メソッド
//-----------------------------------------------------------------------------
procedure TMyPanle.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;

  if Button = mbLeft then begin
    MoveFlag := True;
  end;
end;

//-----------------------------------------------------------------------------
//  MouseMove メソッド
//-----------------------------------------------------------------------------
procedure TMyPanle.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  ARect : TRect;
  i     : Integer;
begin
  inherited;

  if MoveFlag then begin
    if PointNumber = -1 then exit;
    PointArray[PointNumber].X := X;
    PointArray[PointNumber].Y := Y;
    Repaint;
  end else begin
    PointNumber := -1;
    for i := 0 to 3 do begin
      ARect := Rect(PointArray[i].X - GrabSize - 1,
                    PointArray[i].Y - GrabSize - 1,
                    PointArray[i].X + GrabSize + 1,
                    PointArray[i].Y + GrabSize + 1);
      if PtInRect(ARect, Point(X, Y)) then PointNumber := i;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  MouseUp メソッド
//-----------------------------------------------------------------------------
procedure TMyPanle.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;

  MoveFlag := False;
end;

//-----------------------------------------------------------------------------
//  TMyPanelのPaint メソッド
//  グラブハンドルの座標に基づいてベジェ曲線を描画する
//-----------------------------------------------------------------------------
procedure TMyPanle.Paint;
var
  GPGraphic : TGPGraphics;
  GPPen     : TGPPen;
  i         : Integer;
  GPPenLine : TGPPen;
begin
  inherited;

  GPGraphic := TGPGraphics.Create(Canvas.Handle);
  GPPen := TGPPen.Create(aclRed, 2);
  GPGraphic.Clear(aclWhite);

  GPGraphic.DrawBezier(GPPen, PointArray[0],
                              PointArray[1],
                              PointArray[2],
                              PointArray[3]);

  GPPen.SetColor(aclBlue);
  for i := 0 to 3 do begin
    GPGraphic.DrawRectangle(GPPen,
      MakeRect(Rect(PointArray[i].X - GrabSize,
                    PointArray[i].Y - GrabSize,
                    PointArray[i].X + GrabSize,
                    PointArray[i].Y + GrabSize)));
  end;

  //VCLで端点と制御点を点線で結ぶ
  //GDI+ のDotの線はあまりきれいではないので...
  with Canvas do begin
    Pen.Style := psDot;
    Pen.Color := clBlack;
    MoveTo(PointArray[0].X, PointArray[0].Y);
    LineTo(PointArray[1].X, PointArray[1].Y);
    MoveTo(PointArray[2].X, PointArray[2].Y);
    LineTo(PointArray[3].X, PointArray[3].Y);
  end;

  //GDI+を使用するならばこちらのコード
  GPPenLine := TGPPen.Create(aclBlack, 1);
//  GPPenLine.SetDashStyle(DashStyleDot);
//  GPGraphic.DrawLine(GPPenLine, PointArray[0].X,
//                                PointArray[0].Y,
//                                PointArray[1].X,
//                                PointArray[1].Y);
//  GPGraphic.DrawLine(GPPenLine, PointArray[2].X,
//                                PointArray[2].Y,
//                                PointArray[3].X,
//                                PointArray[3].Y);

  GPGraphic.Free;
  GPPen.Free;
  GPPenLine.Free;
end;

//-----------------------------------------------------------------------------
//  WM_ERASEBKGNDメッセージ処理
//  チラつき防止対策.何もしない
//-----------------------------------------------------------------------------
procedure TMyPanle.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
//
end;

end.