落書き帳
マウスを使ってウィンドウに落書きをする簡単なアプリケーションを作ってみます。Visual C++の「チュートリアル」にScribble(落書き)という例題があり、これがチュートリアルにしては難しすぎて「チュートリアル」にならないとの評判です。Delphiでは、PaintBoxを使って簡単に作れます。
ここで紹介する落書き帳は、複雑にしてわかりづらくなるのを避けるために、まだ不完全なものです。この後、「続・落書き帳」を追加します。この落書き帳には、つぎの問題点があります。
メニューは次のようになっています。
ファイル/新規作成
落書きを消して最初から描けるようにします。
ファイル/閉じる
落書き帳を閉じます。
ペン/細いペン
ペンの太さを細くします。細いペンが選ばれているときは、このメニューの先頭にチェックマークが付きます。
ペン/太いペン
ペンの太さを太くします。太いペンが選ばれているときは、このメニューの先頭にチェックマークが付きます。
ペン/カラー
カラーダイアログを表示して、ペンの色を選択します。
線の引き方
PaintBoxのOnMouseDownイベントで、最初のマウス位置へペンを移動します(MoveToメソッド)。このとき、ペンがおろされたことを記憶しておきます。OnMouseMoveイベントで、線を描画します(LineToメソッド)。OnMouseUpイベントで最後の線を描画して、ペンが上がったことを記憶します。
ソース(青色の部分が実際に記述したプログラムです)
unit Main; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus, ExtCtrls; type TForm1 = class(TForm) PaintBox1: TPaintBox; MainMenu1: TMainMenu; FileNew: TMenuItem; Exit: TMenuItem; ThinPen: TMenuItem; FatPen: TMenuItem; PenColor: TMenuItem; ColorDialog1: TColorDialog; procedure FormCreate(Sender: TObject); procedure ExitClick(Sender: TObject); procedure FileNewClick(Sender: TObject); procedure PenColorClick(Sender: TObject); procedure ThinPenClick(Sender: TObject); procedure FatPenClick(Sender: TObject); procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); private { Private 宣言 } FMouseDown: Boolean; // マウスボタンの状態 public { Public 宣言 } end; var Form1: TForm1; implementation {$R *.DFM} { フォームが作成されたとき } procedure TForm1.FormCreate(Sender: TObject); begin // フォームの大きさにあわせる PaintBox1.Align := alClient; // バックを白にする Color := clWhite; // ペンの太さを設定 ThinPen.Checked := True; FatPen.Checked := not ThinPen.Checked; PaintBox1.Canvas.Pen.Width := 1; // ペンの色を設定(赤) PaintBox1.Canvas.Pen.Color := clRed; // マウスボタンの状態 FMouseDown := False; // 押されていない end; { フォームを閉じる } procedure TForm1.ExitClick(Sender: TObject); begin Close; end; { 新規作成 } procedure TForm1.FileNewClick(Sender: TObject); var r: TRect; begin // PainrBox全体を白で塗りつぶす with PaintBox1 do begin r.Left := 0; r.Top := 0; r.Right := Width - 1; r.Bottom := Height - 1; Canvas.FillRect(r); end; end; { ペンの色を変更 } procedure TForm1.PenColorClick(Sender: TObject); begin // OKボタンが押されたかチェック if ColorDialog1.Execute = True then begin PaintBox1.Canvas.Pen.Color := ColorDialog1.Color; end; end; { 「細いペン」がクリックされたとき } procedure TForm1.ThinPenClick(Sender: TObject); begin ThinPen.Checked := True; FatPen.Checked := False; PaintBox1.Canvas.Pen.Width := 1; end; { 「太いペン」がクリックされたとき } procedure TForm1.FatPenClick(Sender: TObject); begin ThinPen.Checked := False; FatPen.Checked := True; PaintBox1.Canvas.Pen.Width := 5; end; { 線の描画開始 } procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin // 左ボタンかチェック if Button = mbLeft then begin // クリックされた位置へペンを移動 PaintBox1.Canvas.MoveTo(X, Y); // マウスボタンが押されたことを記憶しておく FMouseDown := True; end; end; { 線の描画終了 } procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin // 左ボタンかチェック if Button = mbLeft then begin PaintBox1.Canvas.LineTo(X, Y); // マウスボタンが離された FMouseDown := False; end; end; { 線の描画中 } procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin // マウスボタンが押されているかチェック if FMouseDown = True then begin PaintBox1.Canvas.LineTo(X, Y); end; end; end.