（ 50 設問のマークシート 40 枚を１秒程度で読んでくれます！）
僕にはずっと以前から、どうしてもやりたかったことが１つあって、それは Delphi 用の OpenCV ラッパー（OpenCV の C/C++ API を Delphi から呼び出すための橋渡しするプログラム）を使って、軽量かつ超高速なマークシートリーダーを作ること。
初めてマークシートリーダーのプログラムを書いた時は、もうそれが動いただけで本当にうれしかった。マークシート 40 枚を読み取るのにたとえ数分！かかっても大満足だった。
でも、だんだん、もう少し、早くできないかな･･･って思うようになって、PythonForDelphi を使ってバックグラウンドで Python 用の OpenCV を動かして、最初に作ったものよりは･･･かなり高速に動作するバージョンアップ版（？）をなんとか完成させた。
あの頃はもちろん AI なんてなかったし、Google 先生だけが頼りで、わからないことを解決して前へ進むのに今の何倍も時間が必要だったけれど、むちゃくちゃうれしかった。ただ、OpenCV をはじめとして、どうしても必要なライブラリをインストールした Embeddable Python は 158 MB くらいになっちゃって（泣）。
Zip ファイルを展開するにも時間がかかるし、それより何より、初回起動時に Windows による DLL のチェックが走って、マシンによっては数分間フリーズ状態が発生して･･･
いちばんイイのは、Delphi 用の OpenCV ラッパーを使ってプログラムを書けばいいんだって、頭ではわかっていたんだけれど、どうしてもそれが出来なかった。なぜかって言うと、答えは簡単。僕には Delphi 用の OpenCV ラッパーを PC に導入して動かすことが、どうしても出来なかったんだ。
エラーが、たくさん、出て。そして、それを自力で解決することができなかった･･･。
先日、ふと思い立って、マークシートリーダーを作るために必要な必要最低限の OpenCV ラッパーの構成を AI に訊いてみた。少し苦労したけど、なんとか、最小構成の OpenCV ラッパーを僕の PC に導入することに成功。夢の実現にやっと一歩、近づけた。
そこで、新しいマークシートリーダーを作り始める前に準備しておこうと思ったのが、今回紹介する PaintBox で作ったラバーバンド。マークシートのマーク欄のブロックの座標を取得する際に、これがどうしても必要なんだけれど、夢に描いたような･･･１ピクセル単位で大きさの微調整が可能で、その内部をドラッグすれば、なめらかに移動も出来るラバーバンドはまだ未実装･･･。ずっと、ずっと、長い間、微調整が可能な、思った通りに動いてくれるラバーバンドが作りたかった。
今回、あくまでも自分的には･･･ですが、かなり満足できるものができたので、どなた様かの参考になればと思い、自分自身の備忘録も兼ねて、ここに書いておくことにしました。
【もくじ】
１．機能
ラバーバンドに持たせたい機能は次の通り。
・マウスで TImage 上をドラッグして、ラバーバンド描画（赤の細い点線を使用）
・四隅＋縦横中央の 8 ハンドル（グラブハンドル）でサイズ変更可能
・ラバーバンド内をクリックで「そのままの大きさ」でドラッグ移動
・ドラッグ中に自動スクロール（ドラッグ中にスクロール領域の端に来たらスクロール）
・描画終了（MouseUp）でラバーバンドの画像座標を出力
・ラバーバンド内クリックでフォーカスを取得
・矢印キーで、その向きに 1px 移動、Shift+矢印で辺ごとに 1px 拡大/縮小
・ラバーバンド外クリックで消去
２．実装
構造ペインで親子関係も確認
Delphi を起動して、「ファイル」→「新規作成」→「Windows VCL アプリケーション」
Form1 上に、ScrollBox1 を置いて、その上に Image1 と PaintBox1 を置く。
あと Button1 と Memo1 も用意（見た目にこだわるなら、Memo1の lines プロパティを開いて、Memo1 というデフォルトで入っている文字列を消去しておいた方がいいかも？）。
Align の設定は、特にこだわりがなければ、Memo1 は alBottom に、続けて Button1 も alBottom に設定、ScrollBox1 は alClient に設定する。
Form を常に最大化して表示したければ、Form1 の WindowState プロパティを wsMaximized にする。
ここで１回実行（F9）して exe を作り、exe と同じ場所に任意のBMP（ビットマップ）画像を置いておく。
interface 部のコードは次の通り。
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;
//ラバーバンド用に宣言
type
THandlePos = (hpNone, hpLeftTop, hpTop, hpRightTop, hpRight,
hpRightBottom, hpBottom, hpLeftBottom, hpLeft);
type
TForm1 = class(TForm)変数は次のように準備する。
private
{ Private 宣言 }
FBitmap: TBitmap;
//Rubber band
FRubberBandActive: Boolean;
FHasRubber: Boolean;
FRubberRect: TRect;
FDragging: Boolean;
FModeMoveSize: Boolean;
FDragHandle: THandlePos;
FStartPointImg: TPoint;
//Zoom
FZoom: Double; //将来の拡張に備えて準備したもの
//Scroll
FAutoScrollMargin: Integer;
FAutoScrollStep: Integer;
まずは、FormCreate 手続きを作成。
次の内容を記述する。
procedure TForm1.FormCreate(Sender: TObject);
begin
//フォームがキーを受け取る
Form1.KeyPreview := True;
FBitmap := TBitmap.Create;
Image1.Stretch := False;
Image1.AutoSize := False;
Image1.Center := False;
//初期設定
Image1.Align := AlNone;
Image1.Stretch := False;
Image1.AutoSize := False;
Image1.Center := False;
FRubberBandActive := False;
FHasRubber := False;
FDragging := False;
FDragHandle := hpNone;
FModeMoveSize := False;
FZoom := 1.0; //拡大表示が将来必要になった時への備え
FAutoScrollMargin := 16; //適宜変更してください
FAutoScrollStep := 10;
//PaintBox を Image1 上に重ねる
PaintBox1.Parent := ScrollBox1;
PaintBox1.Left := Image1.Left;
PaintBox1.Top := Image1.Top;
PaintBox1.Width := Image1.Width;
PaintBox1.Height := Image1.Height;
PaintBox1.BringToFront;
//透明に見せる設定
PaintBox1.ControlStyle := PaintBox1.ControlStyle - [csOpaque];
//PaintBox を Image1 上に重ねる
PaintBox1.Parent := ScrollBox1;
PaintBox1.Left := Image1.Left;
PaintBox1.Top := Image1.Top;
PaintBox1.Width := Image1.Width;
PaintBox1.Height := Image1.Height;
end;
続いて、Create と同様にして FormDestroy 手続きを準備。ビットマップを解放し忘れたらたいへんだ。
procedure TForm1.FormDestroy(Sender: TObject);
begin
if assigned(FBitmap) then
begin
FBitmap.Free;
end;
end;
次に、Button1 をダブルクリックして、Button1Click 手続きを作成。
procedure TForm1.Button1Click(Sender: TObject);
begin
//読み込み（ビットマップ）
FBitmap.LoadFromFile('Sheet-001.bmp');
//ScrollBox のスクロール位置をリセット
ScrollBox1.HorzScrollBar.Position := 0;
ScrollBox1.VertScrollBar.Position := 0;
Image1.Align := AlNone;
//画像をクリア
Image1.Picture.Graphic := nil;
Image1.Stretch := False;
Image1.AutoSize := False; //UpdateImageDisplaySize に任せる
Image1.Center := False;
Image1.Left := 0; //ScrollBox 左上に合わせる
Image1.Top := 0;
//画像を表示
Image1.Picture.Bitmap.Assign(FBitmap);
UpdateImageDisplaySize;
Image1.Invalidate;
Memo1.Lines.Add('Loaded: ' + 'Sheet-001.bmp');
FRubberBandActive := not FRubberBandActive;
if not FRubberBandActive then
begin
FHasRubber := False;
PaintBox1.Invalidate;
end;
PaintBox1.BringToFront;
end;UpdateImageDisplaySize が「未定義の識別子エラー」になるので、private 宣言部に UpdateImageDisplaySize 手続きを宣言。
private
{ Private 宣言 }
・・・（省略）・・・
procedure UpdateImageDisplaySize;Shift＋Ctrl＋C して、次のように記述する。
procedure TForm1.UpdateImageDisplaySize;
var
W, H: Integer;
begin
if not Assigned(FBitmap) then Exit;
//拡大後サイズ
W := Round(FBitmap.Width * FZoom);
H := Round(FBitmap.Height * FZoom);
//Image
Image1.Align := alNone;
Image1.AutoSize := False;
Image1.Stretch := False;
Image1.SetBounds(0, 0, W, H);
//PaintBox（完全同期）
PaintBox1.Align := alNone;
PaintBox1.SetBounds(0, 0, W, H);
PaintBox1.Invalidate;
end;実行（F9）して、動作確認。フォームが表示されたら、Button1 をクリックして、exe と同じ場所に置いたビットマップ画像が表示されることを確認。右上の閉じるボタンをクリックして、終了。
いよいよラバーバンド作成本番へ。
Form1 上の PaintBox をクリックして選択し、OnMouseDown 手続きを作成。
コードは、次の通り。「未定義の識別子エラー」が複数出るが、未作成の手続きや関数があるためなので、その手続きや関数を続けて作成する。
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
imgP: TPoint;
begin
if not FRubberBandActive then Exit;
imgP := ScreenToImagePoint(X, Y);
if FHasRubber then
begin
//ラバーバンド内クリック
if PointInRectInclusive(FRubberRect, imgP) then
begin
FDragHandle := GetHandleAtPosImg(imgP);
FModeMoveSize := (FDragHandle = hpNone);
FDragging := True;
FStartPointImg := imgP;
//追加：掴んだハンドルに応じてカーソルを確定
if FDragHandle <> hpNone then
PaintBox1.Cursor := CursorFromHandle(FDragHandle)
else
PaintBox1.Cursor := crSizeAll; //内部クリック＝移動
ScrollBox1.SetFocus;
Exit;
end
else
begin
//外クリック → 削除
FHasRubber := False;
PaintBox1.Invalidate;
UpdateRubberCursor; //カーソルを戻す
Exit;
end;
end;
//新規作成
FDragging := True;
FModeMoveSize := False;
FDragHandle := hpNone;
FStartPointImg := imgP;
FRubberRect := Rect(imgP.X, imgP.Y, imgP.X, imgP.Y);
//新規作成中は十字カーソル固定
PaintBox1.Cursor := crCross;
PaintBox1.Invalidate;
end;
エラーをひとつずつ潰す。最初に、private 宣言部に ScreenToImagePoint 関数を宣言して、Shift＋Ctrl＋C を押し下げ。
この後、何度も private 宣言部に戻る必要があるので、変数宣言の最後の方（手続き・関数宣言の最初）あたりをクリックして、Shift＋Ctrl＋1 を実行しておけば、Ctrl+1 ですぐに private 宣言部に戻ってこれるのでとても便利。
private
{ Private 宣言 }
FBitmap: TBitmap;
// Rubber band
FRubberBandActive: Boolean;
・・・（省略）・・・
function ScreenToImagePoint(X, Y: Integer): TPoint;
で、次のように記述。
function TForm1.ScreenToImagePoint(X, Y: Integer): TPoint;
begin
Result.X := Round(X / FZoom);
Result.Y := Round(Y / FZoom);
end;
次は、PointInRectInclusive 関数を作成。まず宣言して、
private
{ Private 宣言 }
・・・（省略）・・・
function ScreenToImagePoint(X, Y: Integer): TPoint;
function PointInRectInclusive(const R: TRect; const P: TPoint): Boolean;
Shift＋Ctrl＋C して、次のように記述する。
function TForm1.PointInRectInclusive(const R: TRect; const P: TPoint): Boolean;
begin
Result :=
(P.X >= R.Left) and (P.X <= R.Right) and
(P.Y >= R.Top) and (P.Y <= R.Bottom);
end;
次は、GetHandleAtPosImg 関数を宣言。
private
{ Private 宣言 }
・・・（省略）・・・
function GetHandleAtPosImg(const P: TPoint): THandlePos;
こちらも Shift＋Ctrl＋C して、次のように記述する。
function TForm1.GetHandleAtPosImg(const P: TPoint): THandlePos;
const
HSIZE = 8;
var
cx: Integer;
begin
Result := hpNone;
// Top
cx := (FRubberRect.Left + FRubberRect.Right) div 2;
if Abs(P.Y - FRubberRect.Top) <= HSIZE then
begin
if Abs(P.X - FRubberRect.Left) <= HSIZE then Exit(hpLeftTop);
if Abs(P.X - FRubberRect.Right) <= HSIZE then Exit(hpRightTop);
if Abs(P.X - cx) <= HSIZE then Exit(hpTop);
end;
// Bottom
if Abs(P.Y - FRubberRect.Bottom) <= HSIZE then
begin
if Abs(P.X - FRubberRect.Left) <= HSIZE then Exit(hpLeftBottom);
if Abs(P.X - FRubberRect.Right) <= HSIZE then Exit(hpRightBottom);
if Abs(P.X - cx) <= HSIZE then Exit(hpBottom);
end;
//Left /Right
if Abs(P.X - FRubberRect.Left) <= HSIZE then Exit(hpLeft);
if Abs(P.X - FRubberRect.Right) <= HSIZE then Exit(hpRight);
end;
次は、CursorFromHandle 関数を宣言。
private
{ Private 宣言 }
・・・（省略）・・・
function CursorFromHandle(H: THandlePos): TCursor;こちらも Shift＋Ctrl＋C して、次のように記述する。
function TForm1.CursorFromHandle(H: THandlePos): TCursor;
begin
case H of
hpLeft, hpRight:
Result := crSizeWE;
hpTop, hpBottom:
Result := crSizeNS;
hpLeftTop, hpRightBottom:
Result := crSizeNWSE;
hpRightTop, hpLeftBottom:
Result := crSizeNESW;
else
Result := crDefault;
end;
end;
残りのエラーはあとひとつ。UpdateRubberCursor;
private
{ Private 宣言 }
・・・（省略）・・・
procedure UpdateRubberCursor;Shift＋Ctrl＋C して、次のように記述する。
procedure TForm1.UpdateRubberCursor;
begin
if FRubberBandActive then
PaintBox1.Cursor := crCross
else
PaintBox1.Cursor := crDefault;
end;
次は、PaintBox の OnMouseMove 手続きを作成。
こちらは、次のように記述する。
procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
curImg: TPoint;
screenPt: TPoint;
dx, dy: Integer;
H: THandlePos;
begin
if not FRubberBandActive then Exit;
curImg := ScreenToImagePoint(X, Y);
//ドラッグ中のみ自動スクロール
if FDragging then
begin
screenPt := PaintBox1.ClientToScreen(Point(X, Y));
AutoScrollIfNeededFromScreen(screenPt);
end;
//矢印キーの形状をより適切に
if not FDragging then
begin
if FHasRubber and PointInRectInclusive(FRubberRect, curImg) then
begin
H := GetHandleAtPosImg(curImg);
if H <> hpNone then
PaintBox1.Cursor := CursorFromHandle(H)
else
PaintBox1.Cursor := crSizeAll; //内部＝移動
end
else
PaintBox1.Cursor := crCross; //ラバーバンド描画モード
Exit;
end;
dx := curImg.X - FStartPointImg.X;
dy := curImg.Y - FStartPointImg.Y;
if FModeMoveSize then
begin
FRubberRect.Offset(dx, dy);
end
else
begin
case FDragHandle of
hpLeftTop:
begin
FRubberRect.Left := curImg.X;
FRubberRect.Top := curImg.Y;
end;
hpTop:
FRubberRect.Top := curImg.Y;
hpRightTop:
begin
FRubberRect.Right := curImg.X;
FRubberRect.Top := curImg.Y;
end;
hpRight:
FRubberRect.Right := curImg.X;
hpRightBottom:
begin
FRubberRect.Right := curImg.X;
FRubberRect.Bottom := curImg.Y;
end;
hpBottom:
FRubberRect.Bottom := curImg.Y;
hpLeftBottom:
begin
FRubberRect.Left := curImg.X;
FRubberRect.Bottom := curImg.Y;
end;
hpLeft:
FRubberRect.Left := curImg.X;
hpNone:
begin
FRubberRect.Right := curImg.X;
FRubberRect.Bottom := curImg.Y;
end;
end;
end;
FStartPointImg := curImg;
NormalizeRect(FRubberRect);
//画像エリアを超えないよう制限
if FRubberRect.Left < 0 then FRubberRect.Left := 0;
if FRubberRect.Top < 0 then FRubberRect.Top := 0;
if FRubberRect.Right > FBitmap.Width then FRubberRect.Right := FBitmap.Width;
if FRubberRect.Bottom > FBitmap.Height then FRubberRect.Bottom := FBitmap.Height;
PaintBox1.Invalidate;
end;
AutoScrollIfNeededFromScreen と、NormalizeRect が「未定義の識別子エラー」になるので、こちらもprivate 宣言部に手続きを宣言して、
private
{ Private 宣言 }
・・・（省略）・・・
procedure AutoScrollIfNeededFromScreen(const ScreenPt: TPoint);
procedure NormalizeRect(var R: TRect);
Shift＋Ctrl＋C して、それぞれ次のように記述する。
procedure TForm1.AutoScrollIfNeededFromScreen(const ScreenPt: TPoint);
var
pt: TPoint;
begin
pt := ScreenToClient(ScreenPt);
if pt.X < FAutoScrollMargin then
ScrollBox1.HorzScrollBar.Position :=
ScrollBox1.HorzScrollBar.Position - FAutoScrollStep
else if pt.X > ScrollBox1.ClientWidth - FAutoScrollMargin then
ScrollBox1.HorzScrollBar.Position :=
ScrollBox1.HorzScrollBar.Position + FAutoScrollStep;
if pt.Y < FAutoScrollMargin then
ScrollBox1.VertScrollBar.Position :=
ScrollBox1.VertScrollBar.Position - FAutoScrollStep
else if pt.Y > ScrollBox1.ClientHeight - FAutoScrollMargin then
ScrollBox1.VertScrollBar.Position :=
ScrollBox1.VertScrollBar.Position + FAutoScrollStep;
end;procedure TForm1.NormalizeRect(var R: TRect);
var
Ll, Lt, Lr, Lb: Integer;
begin
Ll := R.Left; Lt := R.Top;
Lr := R.Right; Lb := R.Bottom;
R.Left := Min(Ll, Lr);
R.Top := Min(Lt, Lb);
R.Right := Max(Ll, Lr);
R.Bottom := Max(Lt, Lb);
end;ここで、今度は Min と Max が「未定義の識別子エラー」になるので、uses に System.Math を追加する。
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.ExtCtrls, Vcl.StdCtrls, System.Math;
次は、PaintBox の OnMouseUp 手続きを作成。
次の内容を記述。
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if not FRubberBandActive then Exit;
if not FDragging then Exit;
FDragging := False;
NormalizeRect(FRubberRect);
FHasRubber := True;
//ドラッグ終了後は状態に応じてカーソルを戻す
UpdateRubberCursor;
//矢印キー操作を有効にする
ActiveControl := nil;
EnsureRubberVisible;
PaintBox1.Invalidate;
//ラバーバンドの座標を取得
UpdateRubberInfo('Mouse ');
end;
ここでは、EnsureRubberVisible と、 UpdateRubberInfo が「未定義の識別子エラー」になるので、private 宣言部で、EnsureRubberVisible 手続きと UpdateRubberInfo 手続きを宣言。
private
{ Private 宣言 }
・・・（省略）・・・
procedure EnsureRubberVisible;
procedure UpdateRubberInfo(const Prefix: string = '');次のように、それぞれの手続きを記述する。
procedure TForm1.EnsureRubberVisible;
var
R: TRect;
p: TPoint;
begin
R := ImageToScreenRect(FRubberRect);
p := PaintBox1.ClientToScreen(Point(R.Left, R.Top));
AutoScrollIfNeededFromScreen(p);
end;procedure TForm1.UpdateRubberInfo(const Prefix: string);
var
R: TRect;
begin
if not FHasRubber then Exit;
R := FRubberRect;
if Memo1.Lines.Count = 0 then
Memo1.Lines.Add('')
else
Memo1.Lines[Memo1.Lines.Count - 1] := ''; //最終行を書き換える
Memo1.Lines[Memo1.Lines.Count - 1] :=
Format('%sL:%d T:%d W:%d H:%d',
[Prefix, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top]);
end;
すると、EnsureRubberVisible 手続きの ImageToScreenRect が「未定義の識別子エラー」になるので、これも潰す。
private
{ Private 宣言 }
・・・（省略）・・・
function ImageToScreenRect(const R: TRect): TRect;Shift＋Ctrl＋C して、次のように記述する。
function TForm1.ImageToScreenRect(const R: TRect): TRect;
begin
Result.Left := Round(R.Left * FZoom);
Result.Top := Round(R.Top * FZoom);
Result.Right := Round(R.Right * FZoom);
Result.Bottom := Round(R.Bottom * FZoom);
end;
次は、Form1 の OnKeyDown 手続きを作成。まず、Form1 のタイトルバー付近をクリックして、Form1 をアクティブにしておき、
次のように記述する。
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if not (FRubberBandActive and FHasRubber) then Exit;
case Key of
VK_LEFT:
if ssShift in Shift then Dec(FRubberRect.Right)
else FRubberRect.Offset(-1, 0);
VK_RIGHT:
if ssShift in Shift then Inc(FRubberRect.Right)
else FRubberRect.Offset(1, 0);
VK_UP:
if ssShift in Shift then Dec(FRubberRect.Bottom)
else FRubberRect.Offset(0, -1);
VK_DOWN:
if ssShift in Shift then Inc(FRubberRect.Bottom)
else FRubberRect.Offset(0, 1);
end;
NormalizeRect(FRubberRect);
PaintBox1.Invalidate;
//ラバーバンドの座標を取得
UpdateRubberInfo('Key ');
end;
次は、PaintBox1Paint 手続きを作成。こちらは PaintBox1 をクリックしてアクティブにしておいて、
次の内容を記述。
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
C: TCanvas;
rS: TRect;
pLT, pRT, pRB, pLB, pT, pB, pL, pR: TPoint;
procedure DrawHandle(const P: TPoint);
var
R: TRect;
S: Integer;
begin
S := 5;
R := Rect(P.X - S, P.Y - S, P.X + S, P.Y + S);
C.Brush.Color := clWhite;
C.Pen.Color := clRed;
C.Rectangle(R);
end;
begin
C := PaintBox1.Canvas;
C.Brush.Style := bsClear;
//初回ドラッグ中、ラバーバンドが描画されない
//if not (FRubberBandActive and FHasRubber) then Exit;
//初回ドラッグ中でもラバーバンドが描画される
if not FRubberBandActive then Exit;
if not (FDragging or FHasRubber) then Exit;
rS := ImageToScreenRect(FRubberRect);
//枠
C.Pen.Style := psDot;
C.Pen.Color := clRed;
C.Rectangle(rS);
//ハンドル位置
pLT := ImageToScreenPoint(FRubberRect.Left, FRubberRect.Top);
pRT := ImageToScreenPoint(FRubberRect.Right, FRubberRect.Top);
pRB := ImageToScreenPoint(FRubberRect.Right, FRubberRect.Bottom);
pLB := ImageToScreenPoint(FRubberRect.Left, FRubberRect.Bottom);
pT := Point((pLT.X + pRT.X) div 2, pLT.Y);
pB := Point((pLB.X + pRB.X) div 2, pLB.Y);
pL := Point(pLT.X, (pLT.Y + pLB.Y) div 2);
pR := Point(pRT.X, (pRT.Y + pRB.Y) div 2);
DrawHandle(pLT);
DrawHandle(pRT);
DrawHandle(pRB);
DrawHandle(pLB);
DrawHandle(pT);
DrawHandle(pB);
DrawHandle(pL);
DrawHandle(pR);
end;
ImageToScreenPoint が「未定義の識別子エラー」になるので、これを潰す。private 宣言部に戻って、ImageToScreenPoint 関数を宣言し、
private
{ Private 宣言 }
・・・（省略）・・・
function ImageToScreenPoint(Ix, Iy: Integer): TPoint;Shift＋Ctrl＋C して、次のように記述する。
function TForm1.ImageToScreenPoint(Ix, Iy: Integer): TPoint;
begin
Result.X := Round(Ix * FZoom);
Result.Y := Round(Iy * FZoom);
end;
実行（F9）すると、「[dcc32 ヒント] Unit1.pas(529): H2443 インライン関数 ‘Point’ はユニット ‘System.Types’ が USES リストで指定されていないため展開されません」というヒントが表示されるので、uses に System.Types を追加する。
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.ExtCtrls, Vcl.StdCtrls, System.Math, System.Types;【マウスホイールでスクロールさせるには？】
ちなみに、マウスのホイールを回転させて画像をスクロールさせたい場合は、
次のコードを記述する。Shift キーを押したまま、ホイールを回転させると、ホイールを手前に回転させた場合は右へ（逆なら左へ）画像はスクロールする。
procedure TForm1.ScrollBox1MouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
const
ScrollStep = 40; //ホイール1回の移動量
begin
if ssShift in Shift then
begin
//横スクロール（Shift + ホイール）
ScrollBox1.HorzScrollBar.Position :=
ScrollBox1.HorzScrollBar.Position - (WheelDelta div 120) * ScrollStep;
end
else
begin
//縦スクロール（通常）
ScrollBox1.VertScrollBar.Position :=
ScrollBox1.VertScrollBar.Position - (WheelDelta div 120) * ScrollStep;
end;
//処理済み
Handled := True;
end;３．まとめ
Button1 をクリックして、Image1 に画像を表示し、その上をマウスでドラッグすると伸縮・移動が自由自在なラバーバンドが表示される。
４．お願いとお断り
このサイトの内容を利用される場合は、自己責任でお願いします。記載した内容（プログラムを含む）を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。