|
Delphi Programming / Object Pascal
[掲載 2012年12月03日] [更新 2017年06月09日] GDI+ 関係サンプル |
GDI+ 関係サンプル
G050_描画オブジェクトのマウスによる移動とリサイズ |
動作確認等 |
Windows 7 U64(SP1) + Delphi XE(UP1) Pro |
|
G050_GDIPlus_MoveResize.zip [1,171 KB] 2017年06月09日版 (EXE 同梱) |
- 2017年06月09日
- 操作対象を画像にしていたが,画像の上下左右の反転表示が正常にできると解釈される可能性があるので,対象を直線の描画に変更
|
描画オブジェクトのマウスによる移動リサイズのサンプルです.
キー操作のコードはありません.TGraphicControl はキーメッセージを受け取ることができません.したがって,キーフックを使用するか,親コントロール側で制御することになります.TGraphicControl の親コントロールは常に TWinControl です.
なお,GDI+ では,TCanvas の TPen.Mode のような設定はありません.基本的に Paint メソッド等で描画するために必要ありません.
このようなラバーバンドとグラブハンドルの表示は,表示中の一部の領域に何かの操作をしたい時に,領域を設定するのに利用できます.
|
グラブハンドルを描画するために,その位置を格納しておく配列を用意します.ここでは四隅だけとします.選択状態の時にラバーバンドとグラブハンドルを表示し,非選択状態を判別するための変数を用意します.また,ラバーバンドの矩形内をマウスで掴んだのか,グラブハンドルを掴んだのかの区別も必要です.
作成したコードを実行してみると,座標が反転すると,描画した図形も上下または左右に反転表示しますが,この時,ラバーバンドが表示されなくなり,マウスで描画したオブジェクトを掴めなくなってしまいます. |
|
図1
設計時画面 |
|
図2
実行画面 |
|
図3
画像が反転した場合
- ラバーバンドが表示されない
- マウスで描画オブジェクトを掴めない
- グラブハンドルは掴める
|
リスト1
TMyPanel に描画したオブジェクトを移動リサイズ |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ComCtrls, StdCtrls, GDIPOBJ, GDIPAPI, ExtDlgs;
type
TMyPanel = class(TPanel)
private
FGrabPoints : array[0..3] of TPoint;
FGrabIndex : Integer;
FIsInObjectRect : Boolean;
FObjectRect : TRect;
FCurrentX : Integer;
FCurrentY : Integer;
FGrabSize : Integer;
FSelected : Boolean;
procedure RectToPoints(ARect: TRect);
procedure SetObjectRect(const Value: TRect);
procedure SetSelected(const Value: Boolean);
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;
public
constructor Create(AOwner: TComponent); override;
property ObjectRect : TRect read FObjectRect write SetObjectRect;
property Selected : Boolean read FSelected write SetSelected;
end;
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
MyPanel : TMyPanel;
protected
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//=============================================================================
// フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
Self.Caption := 'GDI+ 描画オブジェクトの移動リサイズ';
//TMyPanelを生成して配置
MyPanel := TMyPanel.Create(Self);
with MyPanel do begin
Parent := Self;
Left := 5;
Top := 35;
Width := Self.ClientWidth - 10;
Height := Self.ClientHeight - Top - 5;
Anchors := [akLeft, akTop, akRight, akBottom];
Color := clWhite;
//初期描画サイズ
ObjectRect := Rect(20, 20, 150, 150);
ParentBackground := False;
DoubleBuffered := True;
end;
end;
//=============================================================================
// [選択]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
if not Assigned(MyPanel) then exit;
MyPanel.Selected := not MyPanel.Selected;
end;
{ TMyPanel }
//-----------------------------------------------------------------------------
// コンストラクタのCreate処理
//-----------------------------------------------------------------------------
constructor TMyPanel.Create(AOwner: TComponent);
begin
inherited;
FGrabSize := 3;
FSelected := False;
FObjectRect := Rect(0, 0, 0, 0);
FGrabIndex := -1;
FIsInObjectRect := False;
end;
//-----------------------------------------------------------------------------
// FObjectRectプロパティの設定メソッド
// 表示する位置とサイズの設定
//-----------------------------------------------------------------------------
procedure TMyPanel.SetObjectRect(const Value: TRect);
begin
if not EqualRect(FObjectRect, Value) then begin
FObjectRect := Value;
//グラブハンドルの位置座標を計算
RectToPoints(FObjectRect);
Invalidate;
end;
end;
//-----------------------------------------------------------------------------
// Selectedプロパティの設定メソッド
// 選択プロパティをTrueにしたラバーバンドとグラブハンドルを表示する
// 非選択にしたらそれらを非表示にする
//-----------------------------------------------------------------------------
procedure TMyPanel.SetSelected(const Value: Boolean);
begin
if FSelected <> Value then begin
FSelected := Value;
if FSelected = False then begin
FGrabIndex := -1;
FIsInObjectRect := False;
end;
//再描画
Invalidate;
end;
end;
//-----------------------------------------------------------------------------
// オブジェクトの矩形領域からグラブハンドルの表示座標を計算
//-----------------------------------------------------------------------------
procedure TMyPanel.RectToPoints(ARect: TRect);
begin
FGrabPoints[0] := ARect.TopLeft;
FGrabPoints[1] := Point(ARect.Left, ARect.Bottom);
FGrabPoints[2] := ARect.BottomRight;
FGrabPoints[3] := Point(ARect.Right, ARect.Top);;
end;
//-----------------------------------------------------------------------------
// MouseDouwn処理
// マウスの位置がグラブハンドル座標内のどこかであれば,その配列番号を取得
// そうでなければ,オブジェクトの矩形領域内かを調査
// どちらかであればFSelectedをTrueにして,マウス移動範囲をこのTMyPanel内とする
//-----------------------------------------------------------------------------
procedure TMyPanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
var
LRect : TRect;
i : Integer;
begin
inherited;
//-1の時はグラブハンドルが選択されていない状態
FGrabIndex := -1;
//マウスカーソルがグラブハンドル内にあるか調査
for i := 0 to Length(FGrabPoints) - 1 do begin
if PtInRect(Bounds(FGrabPoints[i].X - FGrabSize,
FGrabPoints[i].Y - FGrabSize,
FGrabSize * 2,
FGrabSize * 2),
Point(X, Y)) then begin
FCurrentX := X;
FCurrentY := Y;
FGrabIndex := i;
Break;
end;
end;
//マウスカーソルがグラブハンドル内でなければオブジェクト領域内か調査
if FGrabIndex = -1 then begin
FIsInObjectRect := PtInRect(FObjectRect, Point(X,Y));
if FIsInObjectRect then begin
FCurrentX := X;
FCurrentY := Y;
end;
end;
//選択状態になったらマウスの移動範囲を,このTMyPanel内とする
//外部からSelectedを設定できるが,その時はFGrabIndex, FIsInObjectRectは変化なし
//ただしMouseUpで-1とFalseになるので問題なし
FSelected := (FGrabIndex >=0) or FIsInObjectRect;
if FSelected then begin
LRect := Self.ClientRect;
LRect.TopLeft := ClientToScreen(Self.ClientRect.TopLeft);
LRect.BottomRight := ClientToScreen(Self.ClientRect.BottomRight);
ClipCursor(@LRect);
end;
//再描画
Invalidate;
end;
//-----------------------------------------------------------------------------
// MouseMove処理
//-----------------------------------------------------------------------------
procedure TMyPanel.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
//マウスカーソルはグラブハンドル内にない
if FGrabIndex = -1 then begin
//オブジェクト(画像)の矩形内にある場合
if FIsInObjectRect then begin
OffsetRect(FObjectRect, X - FCurrentX, Y - FCurrentY);
end else begin
exit;
end;
end else begin
//マウスカーソルがグラブハンドル内にある場合
case FGrabIndex of
0:
begin
Inc(FObjectRect.Left, X - FCurrentX);
Inc(FObjectRect.Top, Y - FCurrentY)
end;
1:
begin
Inc(FObjectRect.Left, X - FCurrentX);
Inc(FObjectRect.Bottom, Y - FCurrentY);
end;
2:
begin
Inc(FObjectRect.Right, X - FCurrentX);
Inc(FObjectRect.Bottom, Y - FCurrentY);
end;
3:
begin
Inc(FObjectRect.Right, X - FCurrentX);
Inc(FObjectRect.Top, Y - FCurrentY);
end;
end;
end;
FCurrentX := X;
FCurrentY := Y;
//グラブハンドルの位置座標を計算
RectToPoints(FObjectRect);
//再描画
Invalidate;
end;
//-----------------------------------------------------------------------------
// MouseUp処理
// 各種のフラグをセット
//-----------------------------------------------------------------------------
procedure TMyPanel.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
inherited;
ClipCursor(nil); //マウスカーソル移動範囲の制限を解除
RectToPoints(FObjectRect); //グラブハンドルの位置座標を計算
FGrabIndex := -1; //グラブハンドルはどれも掴んでいない
FIsInObjectRect := False; //オブジェクトの矩形内も掴んでいない
end;
//-----------------------------------------------------------------------------
// TMyPanelクラスのPaintメソッド
// 実際の描画コード
//-----------------------------------------------------------------------------
procedure TMyPanel.Paint;
var
LGPGraphic : TGPGraphics;
LGPPen : TGPPen;
LGPBrush : TGPBrush;
LGPRect : TGPRect;
i : Integer;
begin
inherited;
//TGPGraphicsのオブジェクトを生成
LGPGraphic := TGPGraphics.Create(Canvas.Handle);
//ペンを生成
LGPPen := TGPPen.Create(aclLightGreen);
//グラブハンドルの矩形描画用のTGPBrushオブジェクトを生成
LGPBrush := TGPSolidBrush.Create(aclBlack);
//描画
LGPPen.SetWidth(50);
LGPGraphic.DrawLine(LGPPen, FObjectRect.Left, FObjectRect.Top,
FObjectRect.Right, FObjectRect.Bottom);
//選択状態であればラバーバンドとグラブハンドルを描画
//オブジェクトまたはグラブハンドルを掴んでいなくてFSelectedがTrueなら描画
if FSelected then begin
LGPPen.SetColor(aclBlack);
LGPPen.SetWidth(1);
LGPPen.SetDashStyle(DashStyleDash);
//ラバーバンドを描画
LGPGraphic.DrawRectangle(LGPPen, MakeRect(FObjectRect));
//グラブハンドルを描画
for i := 0 to Length(FGrabPoints) - 1 do begin
LGPRect := MakeRect(FGrabPoints[i].X - FGrabSize,
FGrabPoints[i].Y - FGrabSize,
FGrabSize * 2,
FGrabSize * 2);
LGPGraphic.FillRectangle(LGPBrush, LGPRect);
end;
end;
//Createしたオブジェクトは解放処理する
LGPBrush.Free;
LGPPen.Free;
LGPGraphic.Free;
end;
end.
座標が反転するとマウスで掴めなくなるのは,ラバーバンドの矩形の幅または高さが負の値になってしまうためです.
これに対応するには,幅または高さが負の値になったら,ラバーバンドの矩形の座標値を再計算し,描画が反転しないように再描画する方法があります.次のコードは,その対応をしたコードです.グラブハンドルが掴みやすいように,上下左右に 1 ドットづつ認識範囲を広げてみました.
|
|
図4
実行画面
|
|
図5
実行画面
- 座標が反転してもマウスで掴んで移動できるようになる
|
リスト2
TMyPanel に描画したオブジェクトを移動リサイズ
上下左右の座標が反転してもマウスで掴めるように改良したコード |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ComCtrls, StdCtrls, GDIPOBJ, GDIPAPI;
type
TMyPanel = class(TPanel)
private
FGrabPoints : array[0..3] of TPoint;
FGrabIndex : Integer;
FIsInObjectRect : Boolean;
FObjectRect : TRect;
FSubObjRect : TRect;
FCurrentX : Integer;
FCurrentY : Integer;
FGrabSize : Integer;
FSelected : Boolean;
procedure RectToPoints(ARect: TRect);
procedure SetObjectRect(const Value: TRect);
procedure SetSelected(const Value: Boolean);
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;
public
constructor Create(AOwner: TComponent); override;
property ObjectRect : TRect read FObjectRect write SetObjectRect;
property Selected : Boolean read FSelected write SetSelected;
end;
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
MyPanel : TMyPanel;
protected
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//=============================================================================
// フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
Self.Caption := 'GDI+ 描画オブジェクトの移動リサイズ';
//TMyPanelを生成して配置
MyPanel := TMyPanel.Create(Self);
with MyPanel do begin
Parent := Self;
Left := 5;
Top := 35;
Width := Self.ClientWidth - 10;
Height := Self.ClientHeight - Top - 5;
Anchors := [akLeft, akTop, akRight, akBottom];
Color := clWhite;
//初期描画サイズ
ObjectRect := Rect(20, 20, 150, 150);
ParentBackground := False;
DoubleBuffered := True;
end;
end;
//=============================================================================
// [選択]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
if not Assigned(MyPanel) then exit;
MyPanel.Selected := not MyPanel.Selected;
end;
{ TMyPanel }
//-----------------------------------------------------------------------------
// コンストラクタのCreate処理
//-----------------------------------------------------------------------------
constructor TMyPanel.Create(AOwner: TComponent);
begin
inherited;
FGrabSize := 3;
FSelected := False;
FObjectRect := Rect(0, 0, 0, 0);
FSubObjRect := FObjectRect;
FGrabIndex := -1;
FIsInObjectRect := False;
end;
//-----------------------------------------------------------------------------
// FObjectRectプロパティの設定メソッド
// 表示する位置とサイズの設定
//-----------------------------------------------------------------------------
procedure TMyPanel.SetObjectRect(const Value: TRect);
begin
if not EqualRect(FObjectRect, Value) then begin
FObjectRect := Value;
FSubObjRect := Value;
//グラブハンドルの位置座標を計算
RectToPoints(FObjectRect);
Invalidate;
end;
end;
//-----------------------------------------------------------------------------
// Selectedプロパティの設定メソッド
// 選択プロパティをTrueにしたラバーバンドとグラブハンドルを表示する
// 非選択にしたらそれらを非表示にする
//-----------------------------------------------------------------------------
procedure TMyPanel.SetSelected(const Value: Boolean);
begin
if FSelected <> Value then begin
FSelected := Value;
if FSelected = False then begin
FGrabIndex := -1;
FIsInObjectRect := False;
end;
//再描画
Invalidate;
end;
end;
//-----------------------------------------------------------------------------
// オブジェクトの矩形領域からグラブハンドルの表示座標を計算
//-----------------------------------------------------------------------------
procedure TMyPanel.RectToPoints(ARect: TRect);
begin
FGrabPoints[0] := ARect.TopLeft;
FGrabPoints[1] := Point(ARect.Left, ARect.Bottom);
FGrabPoints[2] := ARect.BottomRight;
FGrabPoints[3] := Point(ARect.Right, ARect.Top);;
end;
//-----------------------------------------------------------------------------
// MouseDouwn処理
// マウスの位置がグラブハンドル座標内のどこかであれば,その配列番号を取得
// そうでなければ,オブジェクトの矩形領域内かを調査
// どちらかであればFSelectedをTrueにして,マウス移動範囲をこのTMyPanel内とする
//-----------------------------------------------------------------------------
procedure TMyPanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
var
LRect : TRect;
i : Integer;
begin
inherited;
//-1の時はグラブハンドルが選択されていない状態
FGrabIndex := -1;
//マウスカーソルがグラブハンドル内にあるか調査
for i := 0 to Length(FGrabPoints) - 1 do begin
if PtInRect(Bounds(FGrabPoints[i].X - FGrabSize - 1,
FGrabPoints[i].Y - FGrabSize - 1,
(FGrabSize + 1) * 2,
(FGrabSize + 1) * 2),
Point(X, Y)) then begin
FCurrentX := X;
FCurrentY := Y;
FGrabIndex := i;
Break;
end;
end;
//マウスカーソルがグラブハンドル内でなければオブジェクト領域内か調査
if FGrabIndex = -1 then begin
FIsInObjectRect := PtInRect(FSubObjRect, Point(X,Y));
if FIsInObjectRect then begin
FCurrentX := X;
FCurrentY := Y;
end;
end;
//選択状態になったらマウスの移動範囲を,このTMyPanel内とする
//外部からSelectedを設定できるが,その時はFGrabIndex, FIsInObjectRectは変化なし
//ただしMouseUpで-1とFalseになるので問題なし
FSelected := (FGrabIndex >=0) or FIsInObjectRect;
if FSelected then begin
LRect := Self.ClientRect;
LRect.TopLeft := ClientToScreen(Self.ClientRect.TopLeft);
LRect.BottomRight := ClientToScreen(Self.ClientRect.BottomRight);
ClipCursor(@LRect);
end;
//再描画
Invalidate;
end;
//-----------------------------------------------------------------------------
// MouseMove処理
//-----------------------------------------------------------------------------
procedure TMyPanel.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
//マウスカーソルはグラブハンドル内にない
if FGrabIndex = -1 then begin
//オブジェクト(画像)の矩形内にある場合
if FIsInObjectRect then begin
OffsetRect(FObjectRect, X - FCurrentX, Y - FCurrentY);
end else begin
exit;
end;
end else begin
//マウスカーソルがグラブハンドル内にある場合
case FGrabIndex of
0:
begin
Inc(FObjectRect.Left, X - FCurrentX);
Inc(FObjectRect.Top, Y - FCurrentY)
end;
1:
begin
Inc(FObjectRect.Left, X - FCurrentX);
Inc(FObjectRect.Bottom, Y - FCurrentY);
end;
2:
begin
Inc(FObjectRect.Right, X - FCurrentX);
Inc(FObjectRect.Bottom, Y - FCurrentY);
end;
3:
begin
Inc(FObjectRect.Right, X - FCurrentX);
Inc(FObjectRect.Top, Y - FCurrentY);
end;
end;
end;
FCurrentX := X;
FCurrentY := Y;
//グラブハンドルの位置座標を計算
RectToPoints(FObjectRect);
//再描画
Invalidate;
end;
//-----------------------------------------------------------------------------
// MouseUp処理
// 各種のフラグをセット
//-----------------------------------------------------------------------------
procedure TMyPanel.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
inherited;
ClipCursor(nil); //マウスカーソル移動範囲の制限を解除
RectToPoints(FObjectRect); //グラブハンドルの位置座標を計算
FGrabIndex := -1; //グラブハンドルはどれも掴んでいない
FIsInObjectRect := False; //オブジェクトの矩形内も掴んでいない
end;
//-----------------------------------------------------------------------------
// TMyPanelクラスのPaintメソッド
// 実際の描画コード
//-----------------------------------------------------------------------------
procedure TMyPanel.Paint;
var
LGPGraphic : TGPGraphics;
LGPPen : TGPPen;
LGPBrush : TGPBrush;
LGPRect : TGPRect;
LWidth : Integer;
LHeight : Integer;
i : Integer;
begin
inherited;
//TGPGraphicsのオブジェクトを生成
LGPGraphic := TGPGraphics.Create(Canvas.Handle);
//線を属性を設定するためのTGPPenオブジェクトを生成
LGPPen := TGPPen.Create(aclLightGreen);
//グラブハンドルの矩形描画用のTGPBrushオブジェクトを生成
LGPBrush := TGPSolidBrush.Create(aclBlack);
//描画
LGPPen.SetWidth(50);
LGPGraphic.DrawLine(LGPPen, FObjectRect.Left, FObjectRect.Top,
FObjectRect.Right, FObjectRect.Bottom);
//選択状態であればラバーバンドとグラブハンドルを描画
//オブジェクトまたはグラブハンドルを掴んでいなくてFSelectedがTrueなら描画
if FSelected then begin
LGPPen.SetColor(aclBlack);
LGPPen.SetWidth(1);
LGPPen.SetDashStyle(DashStyleDash);
//幅と高さが負だと四角形が描画されず,マウスでも掴めなくなるのでその修正
FSubObjRect := FObjectRect;
LWidth := FSubObjRect.Right - FSubObjRect.Left;
LHeight := FSubObjRect.Bottom - FSubObjRect.Top;
if LWidth <=0 then begin
FSubObjRect.Left := FSubObjRect.Left - Abs(LWidth);
FSubObjRect.Right := FSubObjRect.Left + Abs(LWidth);
end;
if LHeight <=0 then begin
FSubObjRect.Top := FSubObjRect.Top - Abs(LHeight);
FSubObjRect.Bottom := FSubObjRect.Top + Abs(LHeight);
end;
//上で計算した矩形の位置と幅,高さの矩形を描画
LGPGraphic.DrawRectangle(LGPPen, MakeRect(FSubObjRect));
//グラブハンドルを描画
for i := 0 to Length(FGrabPoints) - 1 do begin
LGPRect := MakeRect(FGrabPoints[i].X - FGrabSize,
FGrabPoints[i].Y - FGrabSize,
FGrabSize * 2,
FGrabSize * 2);
LGPGraphic.FillRectangle(LGPBrush, LGPRect);
end;
end;
//Createしたオブジェクトは解放処理する
LGPBrush.Free;
LGPPen.Free;
LGPGraphic.Free;
end;
end.
|