Creating MS Paint-like Application with Lazarus
lazarus / 10-Designer

----------------------------------------------------------------------
Leledumbo · 2007-09-20 06:40

Hello everyone, I would like to create an application that emulates MS
Paint but with some extensions. I'm using the TPantBox. The problem
is, I have no idea how to redraw ONLY the object that's on focus.
Maybe it's not very understandable, let's see the code:
Code: [Select]
unit FormMain;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
ExtCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    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);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

var
  Down: Boolean;
  pX,pY: Integer;

{ TForm1 }

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button:
TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if not Down then begin
    pX:=X;
    pY:=Y;
    Down:=true;
  end;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift:
TShiftState; X,
  Y: Integer);
begin
  if Down then begin
    PaintBox1.Canvas.Clear;
    PaintBox1.Canvas.Line(pX,pY,X,Y);
  end;
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button:
TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Down:=false;
end;

initialization
  {$I FormMain.lrs}

end.

If I drag from a point to another, the paintbox clears the previous
lines then draw a new line until the mouse is up. But the next time I
do the same thing, the previous drawn line is gone too. How can I
solve this?

----------------------------------------------------------------------
theo · 2007-09-20 08:40

Code: [Select]procedure TForm1.FormCreate(Sender: TObject);
begin
  fBuffer:=TBitmap.create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  fBuffer.free;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  fBuffer.Width:=Width;
  fBuffer.Height:=Height;
  fBuffer.Canvas.Brush.Color:=clwhite;
  fBuffer.Canvas.FillRect(0,0,Width,Height);
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button:
TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if not Down then begin
    pX:=X;
    pY:=Y;
    Down:=true;
  end;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift:
TShiftState; X,
  Y: Integer);
begin
  if Down then begin
    PaintBox1.Canvas.Draw(0,0,fBuffer);
    PaintBox1.Canvas.Line(pX,pY,X,Y);
  end;
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button:
TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  fBuffer.Canvas.Line(pX,pY,X,Y);
  Down:=false;
end;

----------------------------------------------------------------------
Leledumbo · 2007-09-20 09:00

Thank you very much!!!!