簡単なお絵かきソフトを作ろう

簡単なお絵かきソフトを作成してみましょう。ここで作るお絵かきソフトでは、以下の機能を持つ事になります。

線の太さを変更できる。
線の色を変更できる。
直線、円、四角を描く事ができる。

注意すべき点は、描画面上(TPaintBox)で、マウスボタンを押し下げた位置に始点（ペン先）をもっていき、マウスボタンを離した位置を終点に設定することです。

たとえば、ライン（直線）を引く場合には、マウスボタン押下位置を始点にして、マウスボタンが離された位置を終点にセットし、始点から終点の位置までラインを引くようになっています。円や四角を描く場合も同様の操作を行います。

サンプルプログラムは、以下のようになります。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Spin;

type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    ColorDialog1: TColorDialog;
    GroupBox1: TGroupBox;
    Button1: TButton;
    SpinEdit1: TSpinEdit;
    Label1: TLabel;
    Button2: TButton;
    RadioGroup1: TRadioGroup;
    procedure Button1Click(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


type
  TDrawMode = (dmFreeCurve, dmLine, dmCircle, dmSquare);

var                   
  Drawing: Boolean;
  DrawMode: TDrawMode;
  OldPos: TPoint;
  StartPos: TPoint;


procedure TForm1.Button1Click(Sender: TObject);
begin
  PaintBox1.Canvas.Brush.Color := clWhite;
  PaintBox1.Canvas.FillRect(PaintBox1.ClientRect);
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if not (Button = mbLeft) then exit;
  Drawing := true;
  PaintBox1.Canvas.MoveTo(X, Y);

  StartPos := Point(X, Y);
  OldPos := Point(X, Y);

  case DrawMode of
    dmLine:
      begin
        PaintBox1.Canvas.MoveTo(X, Y);
        PaintBox1.Canvas.LineTo(X, Y); // 視点の塗りつぶし
        PaintBox1.Canvas.Pen.Mode := pmNotXor;
      end;
    dmCircle, dmSquare:
      begin
        PaintBox1.Canvas.Pen.Mode := pmNotXor;
      end
  end;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Drawing then
  begin
    case DrawMode of
      dmFreeCurve: PaintBox1.Canvas.LineTo(X, Y);
      dmLine:
        begin
          PaintBox1.Canvas.MoveTo(StartPos.X, StartPos.Y);
          PaintBox1.Canvas.LineTo(OldPos.X, OldPos.Y);
          PaintBox1.Canvas.MoveTo(StartPos.X, StartPos.Y);
          PaintBox1.Canvas.LineTo(X, Y);
        end;
      dmCircle:
        begin
          PaintBox1.Canvas.Brush.Style := bsClear;
          PaintBox1.Canvas.Ellipse(StartPos.X, StartPos.Y, OldPos.X, OldPos.Y);
          PaintBox1.Canvas.Ellipse(StartPos.X, StartPos.Y, X, Y);
        end;
      dmSquare:
        begin
          PaintBox1.Canvas.Brush.Style := bsClear;
          PaintBox1.Canvas.Rectangle(StartPos.X, StartPos.Y, OldPos.X, OldPos.Y);
          PaintBox1.Canvas.Rectangle(StartPos.X, StartPos.Y, X, Y);
        end;
    end;
    OldPos := Point(X, Y);
  end;
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Drawing := false;
  case DrawMode of
    dmLine:
      begin
        PaintBox1.Canvas.Pen.Mode := pmCopy;
        PaintBox1.Canvas.MoveTo(StartPos.X, StartPos.Y);
        PaintBox1.Canvas.LineTo(X, Y);
      end;
    dmCircle:
      begin
        PaintBox1.Canvas.Pen.Mode := pmCopy;
        PaintBox1.Canvas.Ellipse(StartPos.X, StartPos.Y, X, Y);
      end;
    dmSquare:
      begin
        PaintBox1.Canvas.Pen.Mode := pmCopy;
        PaintBox1.Canvas.Rectangle(StartPos.X, StartPos.Y, X, Y);
      end;
  end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // FormCreate に記述されている全ての設定は、
  // オブジェクトインスペクタで設定可能です。
  SpinEdit1.MinValue := 1;
  SpinEdit1.MaxValue := 9;
  SpinEdit1.Value := 1;

  Button1.Caption := 'クリア';
  Button2.Caption := '色選択';
  Label1.Caption := 'ペンの色';
  Label1.Font.Color := PaintBox1.Canvas.Pen.Color;

  RadioGroup1.Items.Add('自由曲線');
  RadioGroup1.Items.Add('直線');
  RadioGroup1.Items.Add('円');
  RadioGroup1.Items.Add('四角');
  RadioGroup1.ItemIndex := 0;
end;

procedure TForm1.SpinEdit1Change(Sender: TObject);
begin
  PaintBox1.Canvas.Pen.Width := SpinEdit1.Value
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if ColorDialog1.Execute then
  begin
    PaintBox1.Canvas.Pen.Color := ColorDialog1.Color;
    Label1.Font.Color := ColorDialog1.Color;
  end;
end;

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  case RadioGroup1.ItemIndex of
    0: DrawMode := dmFreeCurve;
    1: DrawMode := dmLine;
    2: DrawMode := dmCircle;
    3: DrawMode := dmSquare;
  end;
end;

end.

up next
Last update: 2003/5/19