Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

Rubber band program problem

Posted on 2003-03-05
11
Medium Priority
?
354 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
  • 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
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!

 

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

Independent Software Vendors: 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

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
this video summaries big data hadoop online training demo (http://onlineitguru.com/big-data-hadoop-online-training-placement.html) , and covers basics in big data hadoop .
Despite its rising prevalence in the business world, "the cloud" is still misunderstood. Some companies still believe common misconceptions about lack of security in cloud solutions and many misuses of cloud storage options still occur every day. …
Suggested Courses
Course of the Month13 days, 15 hours left to enroll

580 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