?
Solved

Rubber band program problem

Posted on 2003-03-05
11
Medium Priority
?
347 Views
Last Modified: 2010-04-04
Hi,

I am trying to rubberband a scanned document. I have problem trying to rubberband it while on mouseMove event.

This is the code I wrote:
Image.Canvas.Pen.Style := PsDash;
Image.Canvas.Brush.Style := bsClear;
Image.Canvas.Rectangle(StartX, StartY, X, Y);

When I run this program, there is alot of rectangles forming on the image. However, if i use

Image.Canvas.Brush.Color := ClNone;

I could not see the text that is being rubberbanded. So can any body help me?

The rubberbanded area will be used for other function. The main aim is the select the required portion of the document. However, If I zoom in the document (to make it look bigger) I could not successfully crop out the required portion. So can anybody help me in this?

thanx!
Karrilyn
0
Comment
Question by:yanlay
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 7
  • 4
11 Comments
 
LVL 1

Expert Comment

by:SimesA
ID: 8110416
The trick is to use Pen.Mode := pmXor. This allows you to draw a rectangle once to see it, then simply draw it again to erase it. Here's an example:


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  private
    StartX: integer;
    StartY: integer;
    LastX: integer;
    LastY: integer;
    procedure DrawRect(const x1, y1, x2, y2: integer);
  public
  end;

var
  Form1: TForm1;

implementation


{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  StartX := -1;
  LastX := -1;
end;

procedure TForm1.DrawRect(const x1, y1, x2, y2: integer);
begin
  with Image1.Canvas do begin
    Pen.Style := PsDash;
    Pen.Mode := pmXor;
    Brush.Style := bsClear;
    Rectangle(x1, y1, x2, y2);
  end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if LastX <> -1 then
    DrawRect(StartX, StartY, LastX, LastY);
  if StartX <> -1 then begin
    DrawRect(StartX, StartY, X, Y);
    LastX := x;
    LastY := y;
  end;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  StartX := x;
  StartY := y;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if LastX <> -1 then
    DrawRect(StartX, StartY, LastX, LastY);
  StartX := -1;
  LastX := -1;
end;

end.
0
 

Author Comment

by:yanlay
ID: 8125503
Thanx alot!

But how Do I resize the rubber band?
If I want more than One rubberband in the image, how should I go about doing it?

And the main concern: Like stated above if I zoom in the Document, I could not crop the image properly. So How Should I go about it?
0
 
LVL 1

Expert Comment

by:SimesA
ID: 8126548
I'm not sure what you mean by resize the rubber band - you simply drag the mouse.

If you want more than one rubber band then don't erase the rectangle in the MouseUp routine.

To zoom into the image, use:

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 if LastX <> -1 then begin
   DrawRect(StartX, StartY, LastX, LastY);
   Image1.Canvas.CopyRect(Image1.ClientRect,Image1.Canvas,Rect(StartX, StartY, LastX, LastY));
 end;
 StartX := -1;
 LastX := -1;
end;

Although you will probably want to adjust the rects to maintain the aspect ratio.

0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 

Author Comment

by:yanlay
ID: 8133488
Ok, maybe I should explain more clearly.

Basically, I am trying to Cropcopy or OCR a image. Say, Given a scanned document, I want to OCR certain areas of the document. Thus there is where the rubberbands come in. To select the portion of the document.

Then, You must think that sometimes there are mistake in the croping, so how to erase the previous rubberband?

When I say resize, I mean that if I have drawn the rubber, but I realise that I need to expand the area of the rubberband to include some other portion. so how should I go about doing that?

yanlay
0
 
LVL 1

Expert Comment

by:SimesA
ID: 8134911
OK, scratch the CopyRect and DrawRect in MouseUp. In their place, you need to store the coordinates of the rectangle in a list, along with any other rectangles already drawn.

In mouse down, you need to check whether the mouse position is near a corner (Or side?) of an existing rectangle. If it is, set the StartX & StartY to the opposite corner and LastX and LastY to the selected corner - and it should then be dragged. When the drag finishes, update the rectangle already in the list rather than add a new one.

If the mouse isn't clicked on an existing rectangle, then you're creating a new one. When it's finished, add it to the list.

Deletion could be by right-clicking on an existing rectangle - give a pop-up menu.
0
 
LVL 1

Accepted Solution

by:
SimesA earned 150 total points
ID: 8135012
Try this. Create a pop-up menu with a "Delete" option called mnDelete.



unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    PopupMenu1: TPopupMenu;
    mnDelete: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure mnDeleteClick(Sender: TObject);
  private
    StartX: integer;
    StartY: integer;
    LastX: integer;
    LastY: integer;
    FRects: array of TRect;
    FSelectedRect: integer;
    procedure DrawRect(const x1, y1, x2, y2: integer); overload;
    procedure DrawRect(const rct: TRect); overload;
    function AddRect(const x1, y1, x2, y2: integer): TRect; overload;
    function AddRect(const rct: TRect): TRect; overload;
    function FindRect(const x, y: integer): integer;
  public
  end;

var
  Form1: TForm1;

implementation


{$R *.DFM}

const
  // click within this number of of pixels to a corner to select a rect
  SelectionTolerance = 3;

procedure TForm1.FormCreate(Sender: TObject);
begin
  StartX := -1;
  LastX := -1;
  FSelectedRect := -1;
end;

function TForm1.AddRect(const x1, y1, x2, y2: integer): TRect;
begin
  result := AddRect(Rect(x1, y1, x2, y2));
end;

function TForm1.AddRect(const rct: TRect): TRect;
var
  len: integer;
begin
  len := Length(FRects);
  SetLength(FRects, len + 1);
  FRects[len] := rct;
  result := rct;
end;

function TForm1.FindRect(const x, y: integer): integer;
begin
  for result := 0 to Length(FRects) - 1 do
    if ((abs(FRects[result].Left - x) <= SelectionTolerance) or (abs(FRects[result].Right - x) <= SelectionTolerance)) and
      ((abs(FRects[result].Top - y) <= SelectionTolerance) or (abs(FRects[result].Bottom - y) <= SelectionTolerance)) then
      exit;
  result := -1;
end;

procedure TForm1.DrawRect(const rct: TRect);
begin
  with Image1.Canvas do begin
    Pen.Style := psSolid;
    Pen.Mode := pmNot;
    Brush.Style := bsClear;
    Rectangle(rct);
  end;
end;

procedure TForm1.DrawRect(const x1, y1, x2, y2: integer);
begin
  DrawRect(Rect(x1, y1, x2, y2));
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if LastX <> -1 then
    DrawRect(StartX, StartY, LastX, LastY);
  if StartX <> -1 then begin
    DrawRect(StartX, StartY, X, Y);
    LastX := x;
    LastY := y;
  end;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i: integer;
  rct: TRect;
begin
  i := FindRect(x, y);
  if button = mbLeft then begin
    if i = -1 then begin
      StartX := x;
      StartY := y;
      LastX := -1;
    end else begin
      rct := FRects[i];
      if abs(x - rct.Left) < abs(x - rct.Right) then begin
        StartX := rct.Right;
        LastX := rct.Left;
      end else begin
        StartX := rct.Left;
        LastX := rct.Right;
      end;
      if abs(Y - rct.Top) < abs(Y - rct.Bottom) then begin
        StartY := rct.Bottom;
        LastY := rct.Top;
      end else begin
        StartY := rct.Top;
        LastY := rct.Bottom;
      end;
    end;
  end else if button = mbRight then begin
    FSelectedRect := i;
    if FSelectedRect <> -1 then
      Image1.PopupMenu := PopupMenu1
    else
      Image1.PopupMenu := nil;
  end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if LastX <> -1 then
    AddRect(StartX, StartY, LastX, LastY);
  StartX := -1;
  LastX := -1;
end;


procedure TForm1.mnDeleteClick(Sender: TObject);
var
  len, i: integer;
begin
  if FSelectedRect <> -1 then begin
    len := Length(FRects);
    DrawRect(FRects[FSelectedRect]);
    for i := FSelectedRect to len - 2 do
      FRects[i] := FRects[i + 1];
    SetLength(FRects, len - 1);
    FSelectedRect := -1;
  end;
end;

end.
0
 
LVL 1

Expert Comment

by:SimesA
ID: 8135018
btw, Pen.Mode := pmNot; works better than XOR!
0
 

Author Comment

by:yanlay
ID: 8155938
Sorry for the late comment and Thanx! it works well except for the delete part.
Can't seems to delete it very well. Think your code will only pop out the menu if it is at a corner. So maybe you should give more allowance.

Will this code detect overlapping rectangles? Think that would be very good if it does.
0
 
LVL 1

Expert Comment

by:SimesA
ID: 8157485
Yes, you have to right-click near a corner. You can change the FindRect to allow clicking near any line.
0
 

Author Comment

by:yanlay
ID: 8167111
Thank you! Sorry for dragging this so long.... =)
0
 
LVL 1

Expert Comment

by:SimesA
ID: 8167520
Gee. That makes it all worthwhile.

If you have any other work that needs doing, please be sure to let me know.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Monitoring a network: how to monitor network services and why? Michael Kulchisky, MCSE, MCSA, MCP, VTSP, VSP, CCSP outlines the philosophy behind service monitoring and why a handshake validation is critical in network monitoring. Software utilized …
In this video you will find out how to export Office 365 mailboxes using the built in eDiscovery tool. Bear in mind that although this method might be useful in some cases, using PST files as Office 365 backup is troublesome in a long run (more on t…
Suggested Courses
Course of the Month8 days, 16 hours left to enroll

764 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question