Sign in Join

Live chat for Free Pascal, Lazarus, Delphi and every Pascal programmer.

Mailing lists / lazarus / 2009-02

Weird behaviour of copyrect.

1 message · 1 person ·

Reply by email Subscribe to this list Your subscription

Read-only archive. Use j and k to move between messages.

Dave Coventry

I have a program which contains the following elements:

I have loaded a jpeg onto a TBitmap with the dimensions of 2772x2246 pixels. I have a TImage on a form upon which I've copied a section of the original bitmap (the Image height is 800 and the width is 1000 pixels).

I am using Image1.Canvas.CopyRect(Dest,JPegPic.Canvas,Source) to copy a section of the Bitmap onto the smaller TImage.

What I'm trying to do is get the Bitmap to scroll over the Image area as the Mouse cursor approaches the edge of the Image thus:

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var pagewid, pageht: integer;
begin
    pagewid:=Image1.Width-x;
    while pagewid<10 do
    begin
      PanImage(200,0);
      if Pic.Width-(Image1.Width+LeftB)=0 then break
    end;
end;
procedure TForm1.panImage(X, Y: integer);
var Source,Dest: TRect;
  TX,TY: integer;
begin
  TopB+=Y;
  LeftB+=X;
  Source.Left:=LeftB;
  Source.Top:=TopB;
  Source.Bottom:=TopB+Image1.Height;
  Source.Right:=LeftB+Image1.Width;
  Dest.Top:=0;
  Dest.Left:=0;
  dest.Right:=Image1.Width;
  Dest.Bottom:=Image1.Height;
  Image1.Canvas.CopyRect(Dest,Pic.Canvas,Source);
end;

The interesting thing is that when the cursor approaches the right hand edge of the Image the Bitmap does scroll over as expected but when the cursor goes back towards the centre of the Image, the Bitmap reverts and scrolls back.

It's no big deal; I'll probably just make the Image the same size as the Bitmap and use the scroll bars, but I was hoping to avoid using them. Still, I've wasted a day and a half trying to get around this problem.

Details are as follows:

v0.9.27 r i386-win32-win32/win64

(Actually I'm a little bemused: I used tortoise svn yesterday to update my Lazarus revision, but it doesn't seem to have taken. I'll have to look into it).

Reply by email