Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2012年10月25日] [更新 2012年11月15日] 画像・図形の移動リサイズ関係サンプル
   
画像・図形の移動リサイズ関係サンプル 
R010_直線描画と基本クラスの各種プロパティ
動作確認等 Windows XP(SP3) + Delphi XE Pro
Windows 7 U64(SP1) + Delphi XE Pro
R010_ResizeLine.zip [717 KB] 2013年04月28日版(EXE同梱)







直線描画用コントロールの基本コード


直線は,MoveTo,LineTo メソッドで描画できます.
このテストコードが下のコードです.しかし,このコードで直線を描画すると,下図のように,端点がラバーバンドの境界で欠けてしまいます.また,垂直または水平にすると,線の太さが 0 になってしまいます.

TplDragResize コンポーネントでは,デフォルトの状態では,ラバーバンドと描画コントロールは同じ大きさとなっています.そのためにこの現象が発生します.


図1
実行して直線を選択
  • 端点が欠けている
図2
垂直にした場合
  • 直線の太さが 0 になってしまっている

リスト1
直線描画用のテストコード(改良前)
//-----------------------------------------------------------------------------
//  実際の描画処理を実行するDrawRoutineメソッド
//  引数のACanvasにこのメソッドの描画コードを実行する
//-----------------------------------------------------------------------------
procedure TplResizeLine.DrawRoutine(ACanvas: TCanvas; OffSetX: Integer=0;
  OffSetY: Integer=0);
begin
  inherited;

  ACanvas.Pen := Pen;
  ACanvas.MoveTo(DrawLeft, DrawTop);
  ACanvas.LineTo(DrawLeft + DrawWidth, DrawTop + DrawHeight);
end;




サイズ調整用の PaddingHorz と PaddingVert プロパティ


コントロール移動リサイズコンポーネントに実装されているプロパティですが,同名のプロパティを今回作成した TplReszieBaseControl にも実装しています.

ラバーバンドの幅が狭く,あるいは高さが低くなっても元の線の太さで表示するために導入したのが,この PaddingHorz と PaddingVert プロパティです.
PaddingHorz プロパティは,描画用コントロールの幅を,このプロパティの値だけ左右両方に広げます.また,PaddingVert プロパティは,上下両方に,この値の分だけ高くします.




DrawRect, DrawLeft, DrawTop, DrawWidth, DrawHeight プロパティ


上の PaddingHorz や PaddingVert を設定した場合,描画の時にコントロール位置とサイズの値を用いると,期待通りの結果が得られないことがあります.

また,リサイズの際,例えば,左端のグラブハンドルを操作して,ラバーバンドの右端を越えると,座標が反転し,ラバーバンドの幅の値が負となります.これを「座標の反転」と呼ぶことにします.
この時,コントロールの ClientRect で描画しても,反転表示とはなりません.現在のラバーバンドの
情報から取得することになります.しかし,ラバーバンドから取得するコードを,その都度書くのは面倒です.そこで,これらのプロパティを実装しました.




改良コードをテスト  -  SetRubberBandBounds メソッドの使用


上で述べた PaddingHorz と PaddingVert プロパティを使用して改良した直線描画用コントロールを使用したサンプルです.
ラバーバンドの位置とサイズの値でコントロールの位置とサイズをできる SetRubberBnadBounds というメソッドを実装しています.この動作確認も兼ねています.

直線描画用のコントロール TplResizeLine は実行時に生成して表示しています.


図3
設計時画面
  • 表示位置確認用の TShape を配置
図4
[生成]ボタンクリック
  • SetRubberBandBounds メソッドで位置とサイズを設定している
  • グラブハンドルの座標値は,直線の始点と終点の座標値と同じ


SetBounds メソッドでコントロールの位置とサイズを指定して実行した結果です.SetBounds メソッドの引数に,フォームに配置している Shape1 の位置とサイズを指定していますが,直線の始点である左上と終点である右下の座標が,TShape の左上と右下の座標と一致していません.
PaddingHorz と PaddingVert の値分だけ内側となっています.


図5
[位置サイズ設定 1]クリック
  • SetBounds メソッドで指定
  • Shape1 の端点の座標と,直線の端点の座標が一致しない


下図は,SetRubberBandBounds メソッドを使用して位置とサイズを指定して表示した結果です.
Shape1 の端点の座標と直線の端点の座標値が一致します.


図6
[位置サイズ設定 2]クリック
  • SetRubberBandBounds メソッドで指定
  • Shape1 の端点の座標と,直線の端点の座標が一致する


下の図は,直線を水平にした時の状態です.このページの最初に示した図と違い,直線の太さが 0 とはなりません.
この直線の例のように,継承クラスを作成する時に,この PaddingHorz と PaddingVert,あるいは位置とサイズを設定する SetRubberBandBounds メソッドを有効に利用してください.
PaddingHorz と PaddingVert の値は,大きめの値にすれば無難ですが,この図形をビットマップ等の画像として取り出す際,この分も含まれます.


図7
水平にした直線

リスト2
直線描画用コントロールのテストコード
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    Button2: TButton;
    Shape1: TShape;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    plResizeLine : TplResizeLine;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//  フォームに配置しているTShapeは,stRectangleで,赤い点線にしている
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption        := '移動リサイズ可能な直線';
  Panel1.Caption := '';

  Shape1.Visible := False;

  //チラつき防止対策
  Panel1.DoubleBuffered := True;
  Panel1.ControlStyle   := Panel1.ControlStyle + [csOpaque];
end;

//=============================================================================
//  [生成]ボタン
//  移動リサイズ可能な直線描画用コントロール,TplResizeLineを生成する
//
//  EnableLeftTopTo   初期状態で,左上と右下にグラブハンドルを表示する
//  EnableRightTopTo  初期状態で,左下と右上にグラブハンドルを表示する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if Assigned(plResizeLine) then begin
    FreeAndNil(plResizeLine);
    Shape1.Visible := False;
  end;

  plResizeLine := TplResizeLine.Create(Self);
  with plResizeLine do begin
    Parent      := Panel1;
    Pen.Color   := $00DED39A;
    Pen.Width   := 20;
    SetRubberBandBounds(50,20, 80, 80);

    //TplResizeLineコントロールのDragResizeプロパティの設定
    //このDragResizeプロパティが組み込んだTplDragResizeコンポーネント
    //ここではラバーバンドの線を設定
    DragResize.RubberBand.LineWidth := 1;      //線の太さ
    DragResize.RubberBand.Style     := psDot;  //線の種類は点線
    DragResize.EnableLeftTopTo      := True;   //初期状態では左上と右下に
  end;
end;

//=============================================================================
//  [位置サイズ設定 1]ボタン
//  直線描画のコントロールの位置とサイズをShape1と同じにする
//  直線の始点と終点の位置がShape1の左上と右下になるわけではない
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if Assigned(plResizeLine) then begin
    Shape1.Visible := True;
    Shape1.Left    := 50;
    plResizeLine.Selected := True;
    plResizeLine.SetBounds(Shape1.Left,
                           Shape1.Top,
                           Shape1.Width,
                           Shape1.Height);
  end;
end;

//=============================================================================
//  [位置サイズ設定 3]ボタン
//  直線の描画開始点と,終点の位置をShape1の左上と右下に設定
//  plResizeBaseControl.pas内の関数,SetRubberBandBoundsを使用する
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  if Assigned(plResizeLine) then begin
    Shape1.Visible := True;
    Shape1.Left    := 50;
    plResizeLine.Selected := True;
    plResizeLine.SetRubberBandBounds(Shape1.Left,
                                     Shape1.Top,
                                     Shape1.Width,
                                     Shape1.Height);
  end;
end;

//=============================================================================
//  Panel1のOnMouseDownイベント処理
//  選択を解除
//=============================================================================
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then begin
    if Assigned(plResizeLine) then begin
      Shape1.Visible        := False;
      plResizeLine.Selected := False;
    end;
  end;
end;

end.




改良した直線描画用コントロールのコード


テストに使用した直線描画用コントロールのクラスのコードです.
直線の場合,左右の座標が反転した場合,左端の点が右端の点になった方が自然です.そこでそのようになるように工夫しています.

リスト3
直線描画用コントロールのコード
unit plResizeLine;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  plResizeBaseControl;

type
  TplResizeLine = class(TplResizeBaseControl)
  public
    constructor Create(AOwner: TComponent); override;
    procedure DrawRoutine(ACanvas: TCanvas; OffSetX: Integer=0;
      OffSetY: Integer=0); override;
    procedure PenStyleChanged(Sender: TObject); override;
  end;

implementation

{ TplResizeLine }

//-----------------------------------------------------------------------------
//  Create処理
//  InverseDisp := Trueとして,反転表示可能とする
//-----------------------------------------------------------------------------
constructor TplResizeLine.Create(AOwner: TComponent);
begin
  inherited;
  InverseDisp := True;
end;

//-----------------------------------------------------------------------------
//  TPenのOnChangedeイベント処理
//  TPenの各メンバーのプロパティが変更になった場合に実行される
//  この時,直線を描画するCanvasの矩形領域のサイズ調整用の値も変更する
//
//  移動リサイズコンポーネントTplDragResizeでは,ラバーバンドの矩形領域が画像や
//  図形の描画の矩形領域となっている
//  直線の場合,この状態では,端の部分が欠けてしまう.そこで,このクラスとのコ
//  ントロールのサイズをラバーバンドよりも少し大きめにする
//  この設定に使用するのが以下のプロパティ
//    PaddingHorz  横方向
//    PaddingVert  縦方向
//  この値を使用することによって,直線の端点の座標位置にグラブハンドルを表示す
//  るようになる
//-----------------------------------------------------------------------------
procedure TplResizeLine.PenStyleChanged(Sender: TObject);
begin
  inherited;
  if not Assigned(Parent) then exit;

  PaddingHorz := Pen.Width div 2;
  PaddingVert := Pen.Width div 2;
end;

//-----------------------------------------------------------------------------
//  実際の描画処理を実行するDrawRoutineメソッド
//  引数のACanvasにこのメソッドの描画コードを実行する
//-----------------------------------------------------------------------------
procedure TplResizeLine.DrawRoutine(ACanvas: TCanvas; OffSetX: Integer=0;
  OffSetY: Integer=0);
begin
  inherited;

  ACanvas.Pen := Pen;
  if DragResize.EnableRightTopTo then begin
    ACanvas.MoveTo(DrawLeft + DrawWidth, DrawTop);
    ACanvas.LineTo(DrawLeft, DrawTop + DrawHeight);
  end else begin
    ACanvas.MoveTo(DrawLeft, DrawTop);
    ACanvas.LineTo(DrawLeft + DrawWidth, DrawTop + DrawHeight);
  end;
end;

end.