Draw Shapes on Images when Mouse moves (BGRA?)

[bembulak]

Hi all!

This is my very first question here, after quite some time of being "quiet" and just reading the forums to learn.
I used the search function but none of the results could help me. If I've overlooked anything: sorry for that!

Now for my question:
For a small project of mine I'll need to draw rectangles on photos and save their coordinates in some kind of list. The rectangles should be drawn with the mouse and must not be permanent. The information with the coordinates needs to be saved in some kind of file (maybe a flat csv file).

So my steps would be:
[list type=decimal

• Open the program. It has some kind of "drawing" or "working" area. (Would be TBGRAVirtualScreen or TBGRAGraphicsControl a good choice for this?)
• Via a standard "OpenPictureDialog" I choose an image and load it.
• The image needs to appear on the "drawing" area in original size.
• I select "a drawing tool" and draw rectangles with the mouse onto the image.
• I can repeat drawing rectangles if desired.
• I save the information of the rectangles (x, y, width, height) in some file.

My main focus at the moment is step 4: the live drawing. I can't figure out which steps I have to take to have a rectangle wich changes it's size as long as the left mouse button is pressed. When the mouse button is released the final rect should be drawn.

I have not done any (graphics) programming in Lazarus/FPC yet, but have some experience in other Basic dialects and Python. So I hope my problems just have to do with "getting in touch" with the standard library.

Could a kind soul point me into the right direction which controls and events I have to use?

Thank you.

[Blaazen]

I have no experience with TBGRABitmap, but in general:

You need events OnMouseDown, OnMouseMove and OnMouseUp.

OnMouseDown: Here you get the initial pair coordinates of rectangle. (for example TRect.TopLeft)

OnMouseMove: Here you get the second pair of coordinates (TRect.BottomRight)
 You will also paint rectangle here BUT you must first delete the previous rectangle (i.e. replace previous rectangle with original image)

OnMouseUp: finish action, save all coordinates to some variable, to file ...

[jixian.yang]

If there is XOR drawing on mouse moving event, it can do drawing and erasing simply.

On mouse up event there should be solid drawing.

LazImageEditor is a good example for the step 4.

[bembulak]

I have no experience with TBGRABitmap, but in general:
You need events OnMouseDown, OnMouseMove and OnMouseUp.
OnMouseDown: Here you get the initial pair coordinates of rectangle. (for example TRect.TopLeft)
OnMouseMove: Here you get the second pair of coordinates (TRect.BottomRight)
 You will also paint rectangle here BUT you must first delete the previous rectangle (i.e. replace previous rectangle with original image)

If there is XOR drawing on mouse moving event, it can do drawing and erasing simply.
On mouse up event there should be solid drawing.
LazImageEditor is a good example for the step 4.

Thanks you both! It seems to be just as I thought, but also I recognize, that I have much more to learn about the standard behavour and function of the FCL and LCL.
It's even hard to set up the whole scenery, like setting a size for the components on startup, or resizing the canvas, when I load a picture.

[Ask]

You can also look at http://imcs.dvgu.ru/works/data/2011/216_Postevoy_paint.7z

It is a vector graphics editor written in Lazarus by one of my students
during the "Programming 101" course I teach.

[bembulak]

You can also look at http://imcs.dvgu.ru/works/data/2011/216_Postevoy_paint.7z

It is a vector graphics editor written in Lazarus by one of my students
during the "Programming 101" course I teach.

Thanks a lot. I'll dig through the code. It's quite a lot of information for me, but I hope I'll find what I need.

[lainz]

Maybe this can help:
http://wiki.lazarus.freepascal.org/BGRABitmap_tutorial_3

[benohb]

I did not understand
You want to extract the image from the rectangle or only the coordinates


Try this

http://benor.eu5.org/test.7z


I have developed in Linux with GTK .. I think it will work for you


You can use TBGRABitmap for this ,But it may slow down the speed of the process

[bembulak]

Sorry for the late reply and thanks for the help.
I have not solved it yet, but I guess I'm on the right way.
I'll post the solution here hence I'm done. It will explain better what I mean - my english is not able to do so...

[bembulak]

Hi,

finally I've got a working example, that does what I want. It gave me a hard time, since I'm quite new to FPC/Lazarus, so there have been other issues that adressed other topics.
Nevertheless:
Here's what I have now. This works quite fine for me, though I guess an experience programmer would solve it differntly.

What do I have:
- I can draw my rects on the "canvas". The original image is not changed, as it is demanded.
- I store the rects in a TObjectList. So I can select/move/delete them (not implemented yet).

I'd like to thank you all for your suggestions and help. Thank you!

Code: [Select]

unit MainForm;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
  ExtCtrls, ExtDlgs, BGRAGraphicControl, BGRABitmap, contnrs;

type

  { ThwndMain }

  ThwndMain = class(TForm)
    DrawingArea: TBGRAGraphicControl;
    openImageDlg: TOpenPictureDialog;
    panelList: TListView;
    tb2ImageList: TImageList;
    LeftPanel: TPanel;
    DrawingScrollbox: TScrollBox;
    tbImageList: TImageList;
    ToolBar1: TToolBar;
    tbbNew: TToolButton;
    tbbOpen: TToolButton;
    tbbSave: TToolButton;
    tbbSep1: TToolButton;
    tbbLoadImage: TToolButton;
    tbbSep2: TToolButton;
    tbbExport: TToolButton;
    panelBar: TToolBar;
    ToolButton1: TToolButton;
    tbbHelp: TToolButton;
    tbbMoveUp: TToolButton;
    tbbMoveDown: TToolButton;
    tbbDelete: TToolButton;
    tbbSep3: TToolButton;
    tbbAddSound: TToolButton;
    tbbRemoveSound: TToolButton;
    procedure DrawingAreaMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: integer);
    procedure DrawingAreaMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: integer);
    procedure DrawingAreaMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: integer);
    procedure DrawingAreaPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure tbbLoadImageClick(Sender: TObject);
    procedure DrawAction(x: integer; y: integer);
    procedure DrawAllRects();
  private
    { private declarations }
  public
    { public declarations }
  end;

  TmyRect = class(TObject)
    rect: TRect;

    constructor Create(x, y, x2, y2: integer);
    function getCoords(): string;
  end;

var
  hwndMain: ThwndMain;
  recA, recB: TRect;
  orig, recim: TBGRABitmap;
  mouseEv: boolean;
  startX, startY, nowX, nowY: integer;
  rectList: TObjectList;
  currentRect: TmyRect;

implementation

{$R *.lfm}

constructor TmyRect.Create(x, y, x2, y2: integer);
begin
  self.rect.Left := X;
  self.rect.Top := Y;
  self.rect.Right := X2;
  self.rect.Bottom := Y2;
end;

function TmyRect.getCoords(): string;
begin
  getCoords := IntToStr(self.rect.Left) + ' : ' + IntToStr(self.rect.Top) +
    ' | ' + IntToStr(self.rect.Right) + ' : ' + IntToStr(self.rect.Bottom);
end;

{ ThwndMain }

procedure ThwndMain.FormCreate(Sender: TObject);
begin
  rectList := TObjectList.Create(True);
  currentRect := TmyRect.Create(0, 0, 0, 0);

  DrawingArea.Canvas.Pen.Color := clRed;
  DrawingArea.Canvas.Pen.Width := 3;
  DrawingArea.Canvas.Pen.Style := psDash;
  DrawingArea.Canvas.Brush.Style := bsClear;
  DrawingArea.Enabled := False;

  orig := TBGRABitmap.Create();
  recim := TBGRABitmap.Create();

  mouseEv := False;
  startX := 0;
  startY := 0;
  nowX := 0;
  nowY := 0;
end;

procedure ThwndMain.tbbLoadImageClick(Sender: TObject);
begin
  openImageDlg.FileName := '';
  recB := rect(0, 0, 0, 0);

  if openImageDlg.Execute then
  begin
    if fileExists(openImageDlg.FileName) then
    begin
      { TODO : Try:Except: for Loading Images! }
      rectList.Clear();
      orig.LoadFromFile(openImageDlg.FileName);
      recim.LoadFromFile(openImageDlg.Filename);
      DrawingArea.Width := orig.Width;
      DrawingArea.Height := orig.Height;

      with recim do
      begin
        with bitmap do
        begin
          Canvas.Pen.Color := clRed;
          Canvas.Pen.Width := 3;
          Canvas.Pen.Style := psDash;
          Canvas.Brush.Style := bsClear;
        end;
      end;

      orig.Draw(DrawingArea.Canvas, 0, 0, True);
      DrawingArea.Enabled := True;
    end;
  end;

end;

procedure ThwndMain.DrawingAreaMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: integer);
begin
  if Button = mbLeft then
  begin
    mouseEv := True;
    startX := X;
    startY := Y;
    currentRect.rect.Left := X;
    currentRect.rect.Top := Y;
    currentRect.rect.Right := X;
    currentRect.rect.Bottom := Y;
  end;
end;

procedure ThwndMain.DrawingAreaMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: integer);
begin
  if mouseEV then;
  begin
    DrawAction(X, Y);
  end;
end;

procedure ThwndMain.DrawingAreaMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: integer);
var
  msg: string;
begin
  if (mouseEV) and (Button = mbLeft) then
  begin
    DrawAction(X, Y);
    currentRect.rect.Right := X;
    currentRect.rect.Bottom := Y;

    rectList.Add(TmyRect.Create(currentRect.rect.Left, currentRect.rect.Top,
      currentRect.rect.Right, currentRect.rect.Bottom));

    mouseEv := False;
    currentRect.rect.Left := 0;
    currentRect.rect.Top := 0;
    currentRect.rect.Right := 0;
    currentRect.rect.Bottom := 0;
    //DrawingArea.Refresh;
  end;
end;

procedure ThwndMain.DrawingAreaPaint(Sender: TObject);
begin
  // This is the OLD way, I skipped this,
  // since the other way fits my thinking better:
  // DrawingArea.Canvas.Draw(0,0,recim.Bitmap);
  recim.Draw(DrawingArea.Canvas, 0, 0, True);
end;

procedure ThwndMain.FormDestroy(Sender: TObject);
begin
  recim.Free();
  rectList.Free();
end;



procedure ThwndMain.DrawAction(x: integer; y: integer);
begin
  if mouseEv then
  begin
    DrawAllRects();
    DrawingArea.Canvas.Draw(0, 0, recim.Bitmap);
    DrawingArea.Canvas.Rectangle(startX, startY, x, y);
  end;
end;

procedure ThwndMain.DrawAllRects();
var
  i: integer;
  x, y, x2, y2: integer;
begin
  for i := 0 to rectList.Count - 1 do
  begin
    x := TmyRect(rectList.Items[i]).rect.Left;
    y := TmyRect(rectList.Items[i]).rect.Top;
    x2 := TmyRect(rectList.Items[i]).rect.Right;
    y2 := TmyRect(rectList.Items[i]).rect.Bottom;
    recim.canvas.Rectangle(x, y, x2, y2);
  end;
end;

end.


[circular]

Hello bembulak.

There are some errors in the code you've posted.

- in FormDestroy, only recim is freed, orig is not.
- it is useless to draw all rectangles each time if they are stored in recim. Maybe you forgot to copy orig content to recim before drawing these rectangles.
- you don't need to load twice the bitmap. you can do recim := orig.Duplicate as TBGRABitmap.
- if you load a bitmap, you should free the previous one by calling recim.Free and orig.Free
- using Canvas property is slow, you should use CanvasBGRA instead with TBGRABitmap objects
- you should avoid "DrawingArea.Canvas.Draw(0, 0, recim.Bitmap)" and use recim.Draw instead
- you don't need to use the recim variable, because TBGRAGraphicControl already has his own bitmap. To draw on it, you need to use the OnRedraw event instead of OnPaint event.
- When you want to update it, call graphicControl.RedrawBitmap instead of DrawAction, on some system, you cannot draw anything directly on a control, you need to call Invalidate (here RedrawBitmap)

[bembulak]

There are some errors in the code you've posted.

• in FormDestroy, only recim is freed, orig is not.
  
• it is useless to draw all rectangles each time if they are stored in recim. Maybe you forgot to copy orig content to recim before drawing these rectangles.
  
• you don't need to load twice the bitmap. you can do recim := orig.Duplicate as TBGRABitmap.
  
• if you load a bitmap, you should free the previous one by calling recim.Free and orig.Free
  
• using Canvas property is slow, you should use CanvasBGRA instead with TBGRABitmap objects
  
• you should avoid "DrawingArea.Canvas.Draw(0, 0, recim.Bitmap)" and use recim.Draw instead
  
• you don't need to use the recim variable, because TBGRAGraphicControl already has his own bitmap. To draw on it, you need to use the OnRedraw event instead of OnPaint event.
  
• When you want to update it, call graphicControl.RedrawBitmap instead of DrawAction, on some system, you cannot draw anything directly on a control, you need to call Invalidate (here RedrawBitmap)
  

*sighs*
Sorry for the late reply - I' don't forget about your help and suggestions. I'm just very busy at the moment.

Seems like I have done wrong everything I could?
As mentioned above: Lazarus/FPC/LCL is quite new to me, so I'm not familar with all the mechanisms I need.
Maybe I should start over from scratch?

The steps I need to take seem so easy to me:

• Load an image & display it.
• temporarily draw rects (rubberband) on it and save them in a list.
• edit/resize/delete the rects on image & list.

But I really struggle with applying them to Lazarus.

[circular]

Seems like I have done wrong everything I could?

No but you've done some errors. We do errors when we learn, this is normal.

I don't want you to be desperate, but I prefer to say things as I think they are, so you can do better.

As mentioned above: Lazarus/FPC/LCL is quite new to me, so I'm not familar with all the mechanisms I need.

I understand.

Maybe I should start over from scratch?

It's possible, but you will not understand your errors if you never look at it. When we do something wrong, it is generally because the way we represents things in our head is confused.

The steps I need to take seem so easy to me:

I can give you some explanations:

• Load an image & display it.

Loading uses memory, so you must take into account 3 steps :
- allocating with Create
- replacing with Free and then Create again
- freeing with Free

You can of course replace withoung Free/Create if there are functions that replace the content, like LoadFromFile or Assign.

You've done this almost perfectly, you just forgot to free orig. I adviced you to use Duplicate which allocates a copy, that's why I was talking about freeing before loading again. But in fact you can use Assign, thus you can avoid to Free/Create when you replace the bitmap.

Then to display it, you would be right to use a temporary bitmap (recim) if you had to draw it by yourself in the OnPaint event, but in fact, you don't need to, because it is already in TBGRAGraphicControl, so you can use OnRedraw event. In this event, you can draw the original bitmap and the rectangles over it.

edit/resize/delete the rects on image & list.

If you want to do this, you clearly need to store the rectangles in a list exactly like you did. You must also free the rectangles at the end like this :

Code: [Select]

procedure ThwndMain.FormDestroy(Sender: TObject);
var i: integer;
begin
  orig.Free(); //I suppose there is no recim object
  for i := 0 to rectList.Count-1 do
    TObject(rectList[i]).Free;
  rectList.Free();
end;