Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2012年10月26日] [更新 2012年11月16日] 画像・図形の移動リサイズ関係サンプル
   
画像・図形の移動リサイズ関係サンプル 
R120_四角形の描画用クラスの例
動作確認等 Windows XP(SP3) + Delphi XE Pro
Windows 7 U64(SP1) + Delphi XE Pro
R120_ResizeRectangle.zip [714 KB] 2013年04月28日版(EXE同梱)







四角形の描画用クラスのテストコード


単に四角形を描画するだけのクラスのコード例と,そのテストコードです.


図1
実行時画面例

リスト1
四角形の描画用クラスのテストコード
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    ControlList : TList;
  end;

var
  Form1: TForm1;

implementation

uses
  plResizeBaseControl,
  plResizeRectangle;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption        := '四角形';
  Panel1.Caption := '';

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

  //リサイズコントロールを格納する配列を生成
  ControlList := TList.Create;
end;

//=============================================================================
//  フォームが破棄される時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(ControlList);
end;

//=============================================================================
//  [生成]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  i      : Integer;
  Compo  : TplResizeBaseControl;
  AIndex : Integer;
begin
  //現在表示中のコントロールを全て削除
  for i := ControlList.Count - 1 downto 0 do begin
    Compo := TplResizeBaseControl(ControlList[i]);
    FreeAndNil(Compo);
    ControlList.Delete(i);
  end;

  //四角形を描画
  AIndex := ControlList.Add(TplResizeRectangle.Create(Self));
  with TplResizeRectangle(ControlList[AIndex]) do begin
    Parent     := Panel1;
    Pen.Width   := 2;
    Pen.Color   := clGreen;
    Brush.Style := bsFDiagonal;
    Brush.Color := clGray;

    DragResize.RubberBand.LineWidth := 1;
    DragResize.RubberBand.Style     := psDot;

    SetRubberBandBounds(20, 20, 100, 120);
  end;
end;

//=============================================================================
//  Panel1のOnMouseDownイベント処理
//  選択を解除
//=============================================================================
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i : Integer;
begin
  if Button = mbLeft then begin
    for i := 0 to ControlList.Count - 1 do begin
      TplResizeBaseControl(ControlList[i]).Selected := False;
    end;
  end;
end;

end.




四角形の描画用クラスのコード


四角形描画用コントロールのクラスのコードです.

このコードでは,左端と上端の位置から幅と高さの座標値を決定していますが,以下のサンプルプログラム集のサンプルのように,ExtCreatePen の引数に PS_INSIDEFRAME を指定して,範囲内に描画する方法もあります.

上のサンプルでは,四角形の内部を塗り潰すブラシを設定しています.必要に応じて,これらをクラスのプロパティとして実装することも考えられます.




リスト2
四角形の描画用クラスのコード例
unit plResizeRectangle;

interface

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

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

implementation

{ TplResizeRectangle }

//-----------------------------------------------------------------------------
//  Create処理
//  ペンの色とサイズ初期値を設定
//-----------------------------------------------------------------------------
constructor TplResizeRectangle.Create(AOwner: TComponent);
begin
  inherited;

  Pen.Width := 5;
  Pen.Color := clBlack;
end;

//-----------------------------------------------------------------------------
//  実際の描画処理を実行するRoutineメソッド
//-----------------------------------------------------------------------------
procedure TplResizeRectangle.DrawRoutine(ACanvas: TCanvas; OffSetX: Integer=0;
  OffSetY: Integer=0);
var
  ALeft   : Integer;
  ATop    : Integer;
  AWidth  : Integer;
  AHeight : Integer;
begin
  inherited;

  //描画用の各座標値を計算
  ALeft   := Pen.Width div 2 + OffSetX;
  ATop    := Pen.Width div 2 + OffSetY;
  AWidth  := Width  - Pen.Width + 1;
  AHeight := Height - Pen.Width + 1;

  ACanvas.Pen   := Pen;
  ACanvas.Brush := Brush;
  ACanvas.Rectangle(ALeft, ATop, ALeft + AWidth, ATop + AHeight);
end;

end.