１６番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル
"図形の移動"
この発言に対し以下のコメントが寄せられています
#00785 TORA さん RE:図形の移動（続き）
簡易ＣＡＤのようなソフトを作りたくて凛さんに教えていただいたことを まとめました。 複数の図形（直線と長方形）の状態をTListで保持しておいてマウスで図形 を移動させます。 ここまでの経過は、 nifty:FDELPHI/MES/09/3604 のツリーをご覧ください。 一度アップしたけど発言が途中で切れたので削除しました。 前回の発言を見た人はごめんなさい。 発言の文字数に上限があるのだろうか？ とりあえず二つに分けました。（続きも見てね） フォームにTButtonを二つ配置します。 Button1を押すたびにランダムに直線を描きます。 Button2を押すたびにランダムに長方形を描きます。 表示中の図形をマウスで移動することができます。 ここから ------------------------------------------------------------- unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TPenZokusei = record // 線の属性 Color : TColor; // 色 Style : TPenStyle; // 描画スタイル Width : Integer; // 幅 end; type TBrushZokusei = record // 塗りつぶし属性 Color : TColor; // 色 Style : TBrushStyle; // 塗りつぶしスタイル end; type TToraShape = Class // 図形の基本クラス Public procedure draw(PenMode : TPenMode; Canvas : TCanvas); virtual; abstract; procedure move(Canvas : TCanvas; dx,dy : integer); virtual; abstract; function isOnShape(X,Y : integer) : boolean; virtual; abstract; end; type TCyokusen = Class(TToraShape) // 直線のクラス SX : integer; // 開始Ｘ座標 SY : integer; // 開始Ｙ座標 EX : integer; // 終了Ｘ座標 EY : integer; // 終了Ｙ座標 Pen : TPenZokusei; // 線属性 Public procedure draw(PenMode : TPenMode; Canvas : TCanvas); OverRide; procedure move(Canvas : TCanvas; dx,dy : integer); OverRide; function isOnShape(X,Y : integer) : boolean; OverRide; Constructor Create; Destructor destroy; OverRide; end; type TSikaku = Class(TToraShape) // 長方形 SX : Integer; // 左位置 SY : Integer; // 上位置 EX : Integer; // 右位置 EY : Integer; // 下位置 Pen : TPenZokusei; // 線属性 Brush : TBrushZokusei; // 塗りつぶし属性 Public procedure draw(PenMode : TPenMode; Canvas : TCanvas); OverRide; procedure move(Canvas : TCanvas; dx,dy : integer); OverRide; function isOnShape(X,Y : integer) : boolean; OverRide; Constructor Create; Destructor destroy; OverRide; end; type TForm1 = class(TForm) Button1: TButton; Label1: TLabel; Button2: TButton; procedure Button1Click(Sender: TObject); procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure Button2Click(Sender: TObject); private { Private 宣言 } SentakuZukei : TToraShape; // 選択中の図形 DragFlag : boolean; // True=ドラグ中 prevPoint : TPoint; // MouseDown,MouseMoveの座標 ShapeList : TList; // 図形のリスト public { Public 宣言 } end; var Form1: TForm1; implementation {$R *.DFM} // 直線の描画 procedure TCyokusen.draw(PenMode : TPenMode; // ペン描画モード Canvas : TCanvas); // ﾀｰｹﾞｯﾄｷｬﾝﾊﾞｽ begin Canvas.Pen.Color := Pen.Color; Canvas.Pen.Style := Pen.Style; Canvas.Pen.Width := Pen.Width; Canvas.Pen.Mode := PenMode; Canvas.MoveTo(SX ,SY); Canvas.LineTo(EX ,EY); end; // 直線の移動 procedure TCyokusen.move(Canvas : TCanvas; // ﾀｰｹﾞｯﾄｷｬﾝﾊﾞｽ dx,dy : integer); //ﾏｳｽﾎﾟｲﾝﾀの移動量 begin // 前回の仮直線を消去 Draw(pmNotXor ,Canvas); // 新しい仮直線を表示 SX := SX + dx; SY := SY + dy; EX := EX + dx; EY := EY + dy; Draw(pmNotXor ,Canvas); end; // X,Yが直線上かどうかの判断 // 手抜きです（垂直・水平線の線幅を考慮していない） // nifty:FDELPHI/MES/16/00256 凛さんの「線のリスト」より function TCyokusen.isOnShape(X,Y : integer) : boolean; var r,a,b,c,d,kx,ky,dx,dy:Extended; s,e : integer; begin isOnShape := false; dx := EX - SX; dy := EY - SY; if dx = 0 then begin if SY < EY then begin s := SY; e := EY; end else begin s := EY; e := SY; end; if (Y >= s) and (Y <= e) then if abs(SX - X) <= 1 then isOnShape := True; exit; end; if dy = 0 then begin if SX < EX then begin s := SX; e := EX; end else begin s := EX; e := SX; end; if (X >= s) and (X <= e) then if abs(SY - Y) <= 1 then isOnShape:=True; exit; end; if ((sx+ex)-abs(dx)-Pen.Width)/2 > x then exit; if ((sx+ex)+abs(dx)+Pen.Width)/2 < x then exit; if ((sy+ey)-abs(dy)-Pen.Width)/2 > y then exit; if ((sy+ey)+abs(dy)+Pen.Width)/2 < y then exit; a:=dy/dx; b:=sy-a*sx; c:=-1/a; d:=y-c*x; kx:=(d-b)/(a-c); ky:=a*kx+b; r:=(x-kx)*(x-kx)+(y-ky)*(y-ky); if 4*r<= (Pen.Width+1)*(Pen.Width+1) then isOnShape:=True; end; Constructor TCyokusen.Create; begin end; Destructor TCyokusen.destroy; begin end; // 長方形の描画 procedure TSikaku.draw(PenMode : TPenMode; // ペン描画モード Canvas : TCanvas); // ﾀｰｹﾞｯﾄｷｬﾝﾊﾞｽ begin Canvas.Pen.Color := Pen.Color; Canvas.Pen.Style := Pen.Style; Canvas.Pen.Width := Pen.Width; Canvas.Pen.Mode := PenMode; Canvas.Brush.Color := Brush.Color; Canvas.Brush.Style := Brush.Style; Canvas.Rectangle(SX ,SY ,EX ,EY); end; // 長方形の移動 procedure TSikaku.move(Canvas : TCanvas; // ﾀｰｹﾞｯﾄｷｬﾝﾊﾞｽ dx,dy : integer); //ﾏｳｽﾎﾟｲﾝﾀの移動量 begin // 前回の仮長方形を消去 Draw(pmNotXor ,Canvas); // 新しい仮長方形を表示 SX := SX + dx; SY := SY + dy; EX := EX + dx; EY := EY + dy; Draw(pmNotXor ,Canvas); end; // X,Yが長方形上かどうかの判断 function TSikaku.isOnShape(X,Y : integer) : boolean; var dx,dy:Extended; begin isOnShape := false; dx := EX - SX; dy := EY - SY; if ((sx+ex)-abs(dx)-Pen.Width)/2 > x then exit; if ((sx+ex)+abs(dx)+Pen.Width)/2 < x then exit; if ((sy+ey)-abs(dy)-Pen.Width)/2 > y then exit; if ((sy+ey)+abs(dy)+Pen.Width)/2 < y then exit; isOnShape:=True; end; Constructor TSikaku.Create; begin end; Destructor TSikaku.destroy; begin end; ------------------------------------------------------------- 続く 99/01/04 (月) 14:50 ＴＯＲＡ(HHD00760) Original document by TORA 氏 ID:(HHD00760)
ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。