落書き帳

マウスを使ってウィンドウに落書きをする簡単なアプリケーションを作ってみます。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.