Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2012年11月02日] [更新 2017年05月26日]　Delphi サンプルプログラム集
158_マウス操作による図形の編集
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
158_EditPath_Bezier.zip　[1,074 KB]　2017年05月26日版 (EXE 同梱)






パスで構成した図形やベジェ曲線をマウス操作で編集


図形をパスで構成すると，パスを追加したり削除して図形を変形することができます．また，パスを構成する際に使用した座標値 (端点) の値を変更しても図形の変形が可能です．
ベジェ曲線は，主に複雑な曲線を作成する時に利用されていますが，これも端点の追加や削除，あるいは端点の位置の編集の機能があればより複雑な曲線を作成することができます．

本ページのサンプルはこのことを確認するためのプログラムです．ただし，端点の座標値をマウスで変更するだけの機能となっています．






01_パスで作成した文字列をマウス操作で編集


文字列もパスとして作成できます．パスは座標値とその座標値の種類で構成されています．
本サンプルでは，文字列をパスの文字列として作成します．その語，作成した文字列のパスの情報を取得して，その座標値をマウスで移動して，図形としての文字列を変形します．


図1
設計時画面
図2
[生成] ボタンをクリック
図3
操作中
  • [編集] ボタンをクリック
  • パスの端点の座標値にグラブハンドルが表示される
  • これをマウスで操作する
図4
編集結果例
図5
こんな感じにも...

リスト1
パスデータをマウスで操作して編集する．文字列の例 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private 宣言 }
    FPointArray     : array [0..65535] of TPoint;
    FPointKindArray : array [0..65535] of Byte;
    FPointCount     : Integer;
    FPointNumber    : Integer;
    FGrabSize       : Integer;
    FStartFlag      : Boolean;
    FIsEdit         : Boolean;
    FMoveFlag       : Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := 'パスデータの編集';
  DoubleBuffered := True;

  FGrabSize    := 3;
  FPointNumber := -1;

  FStartFlag := True;
  FIsEdit    := False;
end;

//=============================================================================
//  [生成]ボタン
//  文字列のバスを作成して，その情報を配列(グローバル変数)に格納する
//  ここでは，文字列のパスを作成するだけ
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  //バスの記録開始
  BeginPath(Canvas.Handle);
    Canvas.Brush.Style  := bsClear;
    Canvas.Font.Size    := 100;
    Canvas.Font.Charset := ANSI_CHARSET;
    Canvas.Font.Name    := 'Arial Black';
    Canvas.Textout(40, 40, 'DELPHI');
  //バスの記録終了
  EndPath(Canvas.Handle);

  //パスの座標値の格納に必要な数を取得して配列に格納
  FPointCount := GetPath(Canvas.Handle, FPointArray, FPointKindArray, 0);
  GetPath(Canvas.Handle, FPointArray, FPointKindArray, FPointCount);

  //パス情報が取得できたので，MyPanelを再描画
  FStartFlag := False;

  Invalidate;
end;

//=============================================================================
//  [編集]ボタン
//  パスの座標位置にグラブハンドルを表示
//  トグル操作
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  FIsEdit := not FIsEdit;
  Invalidate;
end;

//=============================================================================
//  MouseDownイベント
//=============================================================================
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  LRect : TRect;
  i     : Integer;
begin
  if FStartFlag then exit;

  if Button = mbLeft then begin
    if FIsEdit then begin
      FPointNumber := -1;
      for i := 0 to FPointCount - 1 do begin
        LRect := Rect(FPointArray[i].X - FGrabSize - 1,
                      FPointArray[i].Y - FGrabSize - 1,
                      FPointArray[i].X + FGrabSize + 1,
                      FPointArray[i].Y + FGrabSize + 1);
        if PtInRect(LRect, Point(X, Y)) then begin
          FPointNumber := i;
          FMoveFlag := True;

          //マウスカーソルの移動範囲を，このTMyPanel内だけとする
          GetWindowRect(Handle, LRect);
          ClipCursor(@LRect);

          break;
        end;
      end;
    end;
  end;
end;

//=============================================================================
//  MouseMoveイベント
//=============================================================================
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if FStartFlag then exit;

  if FMoveFlag then begin
    //マウスボタンが押下状態の時はその端点の位置の値を更新する
    //FPointNumberは押されているパスの描画端点の番号
    if FPointNumber = -1 then exit;

    FPointArray[FPointNumber].X := X;
    FPointArray[FPointNumber].Y := Y;

    Invalidate;
  end;
end;

//=============================================================================
//  MouseUpイベント
//=============================================================================
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FMoveFlag := False;

  //マウスカーソルのクリップを解除
  ClipCursor(nil);
end;

//=============================================================================
//  Paint メソッド
//  ここでPenとBrushを使用して，実際のパスを描画する
//=============================================================================
procedure TForm1.FormPaint(Sender: TObject);
var
  i : Integer;
begin
  //このサンプルではButton1をクリックするまではパスは作成されていない
  //したがって，これ以降のコードは実行するとエラーになる
  //StartFlagは，その判定用フラグ
  if FStartFlag then exit;

  //計算結果のパス情報で図形を描画
  BeginPath(Canvas.Handle);
     PolyDraw(Canvas.Handle, FPointArray, FPointKindArray, FPointCount);
  EndPath(Canvas.Handle);

  //現在のブラシでバスの内部を塗りつぶし，現在のペンで輪郭線を描画する
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := clWebPapayaWhip;
  Canvas.Pen.Color := clBlack;
  Canvas.Pen.Width := 2;
  StrokeAndFillPath(Canvas.Handle);

  if FIsEdit then begin
    Canvas.Brush.Color := clBlack;
    for i := 0 to FPointCount - 1 do begin
      Canvas.FillRect(Rect(FPointArray[i].X - FGrabSize,
                           FPointArray[i].Y - FGrabSize,
                           FPointArray[i].X + FGrabSize,
                           FPointArray[i].Y + FGrabSize));
    end;
  end;
end;

end.




02_マウス操作でベジェ曲線の形状を編集


Asuyu さんのサイトに，ベジェ曲線の説明記事があります．この記事を参考にして，実際にマウスで曲線を操作するサンプルです．
曲線を組み合わせると，いろいろな図形を作成することができます．しかし，Draw 系 (ドロー系) のアプリケーションでもそうですが，実際に思い通りの図形にするのは結構面倒であることが理解できると思います．

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


図6
設計時画面
図7
実行開始画面
  • グラブハンドル (小さな四角形) をマウスでドラッグ操作する
  • これは最小限 (3 次) のベジェ曲線
  • 端点 (始点と終点) と制御店 (方向点) を結ぶ制御線 (方向泉) が曲線の接線となるように曲線が描画される
  • 端点はアンカーポイントともいう
図8
操作結果の例

リスト2
単純なベジェ曲線をマウスで操作して変形する		 
unit Unit1;

interface

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

type
  TMyPanel = 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 宣言 }
    MyPanel : TMyPanel;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

var
  FPointArray : array[0..3] of TPoint = ((X:30;  Y:100),
                                         (X:120; Y:10),
                                         (X:170; Y:150),
                                         (X:220; Y:100));
  FPointNumber : Integer = -1;
  FMoveFlag    : Boolean;
  FGrabSize    : Integer = 3;

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

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

{ TMyPanel }

//-----------------------------------------------------------------------------
//  MouseDown メソッド
//-----------------------------------------------------------------------------
procedure TMyPanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  LRect : TRect;
  i     : Integer;
begin
  inherited;

  if Button = mbLeft then begin
    FPointNumber := -1;
    for i := 0 to Length(FPointArray) - 1 do begin
      LRect := Rect(FPointArray[i].X - FGrabSize - 1,
                    FPointArray[i].Y - FGrabSize - 1,
                    FPointArray[i].X + FGrabSize + 1,
                    FPointArray[i].Y + FGrabSize + 1);
      if PtInRect(LRect, Point(X, Y)) then begin
        FPointNumber := i;
        FMoveFlag    := True;

        //マウスカーソルの移動範囲を，このTMyPanel内だけとする
        GetWindowRect(Handle, LRect);
        ClipCursor(@LRect);

        break;
      end;
    end;

    FMoveFlag := True;
  end;
end;

//-----------------------------------------------------------------------------
//  MouseMove メソッド
//-----------------------------------------------------------------------------
procedure TMyPanel.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited;

  if FMoveFlag then begin
    //マウスボタンが押下状態の時はその端点の位置の値を更新する
    //FPointNumberは押されている端点の番号
    if FPointNumber = -1 then exit;

    FPointArray[FPointNumber].X := X;
    FPointArray[FPointNumber].Y := Y;

    Invalidate;
  end;
end;

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

  //マウスカーソルのクリップを解除
  ClipCursor(nil);
end;

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

  //WM_ERASEBKGNDで背景の再描画をしなくしたのでその対策
  Canvas.Brush.Color := clWhite;
  Canvas.FillRect(ClientRect);

  //ベジェ曲線の描画
  Canvas.Pen.Color := clRed;
  Canvas.Pen.Width := 2;
  Canvas.PolyBezier(FPointArray);

  //端点にグラブハンドルを描画
  Canvas.Pen.Color := clBlue;
  for i := 0 to Length(FPointArray) - 1 do begin
    Canvas.Rectangle(FPointArray[i].X - FGrabSize,
　                   FPointArray[i].Y - FGrabSize,
                     FPointArray[i].X + FGrabSize,
                     FPointArray[i].Y + FGrabSize);
  end;

  //端点と制御点を点線で結ぶ
  with Canvas do begin
    Pen.Width := 1;
    Pen.Style := psDot;
    Pen.Color := clBlack;
    MoveTo(FPointArray[0].X, FPointArray[0].Y);
    LineTo(FPointArray[1].X, FPointArray[1].Y);
    MoveTo(FPointArray[2].X, FPointArray[2].Y);
    LineTo(FPointArray[3].X, FPointArray[3].Y);
  end;
end;

//-----------------------------------------------------------------------------
//  WM_ERASEBKGNDメッセージ処理
//  チラつき防止対策．何もしない
//  Windows Vista以降ではあまり効果がない?
//-----------------------------------------------------------------------------
procedure TMyPanel.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
//
end;

end.