Recent

Author Topic: Creating MS Paint-like Application with Lazarus  (Read 7071 times)

Leledumbo

  • Hero Member
  • *****
  • Posts: 8836
  • Programming + Glam Metal + Tae Kwon Do = Me
Creating MS Paint-like Application with Lazarus
« on: September 20, 2007, 08:40:39 am »
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

  • Global Moderator
  • Hero Member
  • *****
  • Posts: 1946
RE: Creating MS Paint-like Application with Lazarus
« Reply #1 on: September 20, 2007, 10:40:29 am »
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

  • Hero Member
  • *****
  • Posts: 8836
  • Programming + Glam Metal + Tae Kwon Do = Me
Creating MS Paint-like Application with Lazarus
« Reply #2 on: September 20, 2007, 11:00:42 am »
Thank you very much!!!!

 

TinyPortal © 2005-2018