I am trying to build a seemingly simple GUI in which a Timage can be panned, zoomed, and rotated. The zooming and rotating should be done at/around a defined zoom and rotation center position.
I am first trying this on Windows. All is working fine now, except that when the image has a rotation, the zoom at a specific zoom center does not work (the zoom center moves around). It does work fine when the rotationangle=0. I can indulge again in the math to get correct image position equations, but first wanted to ask here if someone has maybe tackled this problem before.
For the code below to work do the following:
start a new blank fmx multidevice project
Add a TPanel aligned to client
Add a TImage, fill its MultiResBitmap property with any image
Set the hittest property of the image to false (panel input used for zoom)
In the minimum code sample below the image is rotated in the form's FormCreate procedure (or not to see how the zooming at a certain point is supposed to work). Zooming is done at the mouse position when scrolling the wheel on the mouse in the Panel1MouseWheel procedure.
So what would need to be adjusted are only the two lines below the comment
// correction for image position when scaling
procedure TForm1.FormCreate(Sender: TObject);
begin
// Image1.RotationAngle := 0;
Image1.RotationAngle := 30;
end;
procedure TForm1.Panel1MouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; var Handled: Boolean);
var zoom_center: TPointF;
new_scale,old_scale: single;
P1,P2: TPointF;
begin
// Scaling (mousewheel)
if shift = [] then
begin
zoom_center := screen.MousePos - ClienttoScreen(Image1.LocalToAbsolute(PointF(0,0)));
old_scale := Image1.Scale.X;
if WheelDelta>=0 then new_scale := old_scale * (1 + (WheelDelta / 120)/5)
else new_scale := old_scale / (1 - (WheelDelta / 120)/5);
Image1.Scale.X := new_scale;
Image1.Scale.Y := new_scale;
// correction for image position when scaling
Image1.Position.X := Image1.Position.X + zoom_center.x * (1-new_scale/old_scale);
Image1.Position.Y := Image1.Position.Y + zoom_center.y * (1-new_scale/old_scale);
end;
end;
I'm assuming that you want to zoom to the cursor such that the image pixel at the cursor doesn't move. Your code didn't do that for me even when angle was 0. There are a couple of problems with your code. Firstly how you compute the zoom_center and secondly how you correct for image position. Here's the corrected code with your code commented out. It seems to work when rotation angle is 0 or 30.
procedure TForm1.Panel1MouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; var Handled: Boolean);
var zoom_center: TPointF;
new_scale,old_scale: single;
P1,P2: TPointF;
begin
// Scaling (mousewheel)
if shift = [] then
begin
//zoom_center := screen.MousePos - ClienttoScreen(Image1.LocalToAbsolute(PointF(0,0)));
zoom_center := ScreenToClient(Screen.MousePos) - Panel1.Position.Point;
old_scale := Image1.Scale.X;
if WheelDelta>=0 then new_scale := old_scale * (1 + (WheelDelta / 120)/5)
else new_scale := old_scale / (1 - (WheelDelta / 120)/5);
Image1.Scale.X := new_scale;
Image1.Scale.Y := new_scale;
// correction for image position when scaling
//Image1.Position.X := Image1.Position.X + zoom_center.x * (1-new_scale/old_scale);
//Image1.Position.Y := Image1.Position.Y + zoom_center.y * (1-new_scale/old_scale);
Image1.Position.Point := zoom_center - (new_scale * (zoom_center - Image1.Position.Point) / old_scale);
end;
end;
Related
In my android app i want the VKBoard not to overlap the edit control so i use the FormVirtualKeyboardShown event (from Embarcadero's example) to find the upper edge of VKboard.
procedure TTabbedForm.FormVirtualKeyboardShown(Sender: TObject; KeyboardVisible: Boolean; const Bounds: TRect);
var h,dh : single;
begin
FKBBounds := TRectF.Create(Bounds);
FKBBounds.TopLeft := ScreenToClient(FKBBounds.TopLeft); // topLeft isn't right
h := PanelEdit.AbsoluteRect.Top; // h is right
if h > FKBBounds.Top - PanelEdit.Height then movePanelEdit;
end;
but FKBBounds.TopLeft.Y takes a value near the bottom of the screen.
What i'm missing ?
I want know how detect to what side i'm moving mouse: to left, right, top, bottom inside TImage component on mousemove event?
Thank you.
Here's an example to be used in an FMX project. For a VCL project, you would use integer variables.
First, declare two variables Xold, Yold: single; for example in the private section of the form.
private
Xold, Yold: Single;
Initialize these variables e.g. in the forms OnCreate() event. Using NaN requires System.Math in the uses clause.
procedure TForm5.FormCreate(Sender: TObject);
begin
Xold := NaN;
Yold := NaN;
end;
Then, in the OnMouseMove() event, calculate the movement horizontally and vertically, negative value indicate moving left or up, positive right or down.
procedure TForm5.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Single);
var
horz, vert: Single;
begin
if not IsNan(Xold) then horz := X - Xold else horz := 0;
if not IsNan(Yold) then vert := Y - Yold else vert := 0;
Xold := X; // save new values
Yold := Y; //
// use horz and vert as needed
Label1.Text := Format('h: %f, v: %f',[horz, vert]);
end;
You may also want to reset the Xold and Yold variables to NaN when the mouse leaves the image.
procedure TForm5.Image1MouseLeave(Sender: TObject);
begin
Xold := NaN;
Yold := NaN;
end;
It was asked in comments, why initialize to NaN instead of just zero? Xold := 0; Yold := 0 is the top-left corner. If the mouse entry to the image happens at e.g. right side, the first move would be a jump from 0 to image width. Using NaN we can omit the first entry as a move and just store the entry point in Xold and Yold for use with next move.
I developed an application in Delphi using graphics32 library. It involves adding layers to a ImgView32 control. It does all I want now, except that when the user adds more that 25-30 layers to the ImgView, the selected layer starts behaving badly. I mean,
- when there are 30+ layers on the ImgView32 and I click on a layer, it takes about 2.5-2 seconds to actually select it.
- Also when I try to move the layer, it moves abruptly
It appears that ImgViewChange is called way too many times when there are more layers. Same goes to PaintLayer. It gets called way too many times.
How can I stop that from happening? How can I make the layers move graciously even when there are more that 30 layers added?
My code is as follows:
procedure TMainForm.LayerMouseDown(Sender: TObject; Buttons: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
cronstart:=now;
if Sender <> nil then
begin
Selection := TPositionedLayer(Sender);
end
else
begin
end;
cronstop:=now;
Memo1.Lines.Add('LayerMouseDown:'+FloatToStr((cronstop-cronstart)*secsperDay)+'sec');
end;
procedure TMainForm.AddSpecialLineLayer(tip:string);
var
B: TBitmapLayer;
P: TPoint;
W, H: Single;
begin
B := TBitmapLayer.Create(ImgView.Layers);
with B do
try
Bitmap.SetSize(100,100);
Bitmap.DrawMode := dmBlend;
with ImgView.GetViewportRect do
P := ImgView.ControlToBitmap(GR32.Point((Right + Left) div 2, (Top + Bottom) div 2));
W := Bitmap.Width * 0.5;
H := Bitmap.Height * 0.5;
with ImgView.Bitmap do
Location := GR32.FloatRect(P.X - W, P.Y - H, P.X + W, P.Y + H);
Scaled := True;
OnMouseDown := LayerMouseDown;
B.OnPaint := PaintGeamOrizHandler
except
Free;
raise;
end;
Selection := B;
end;
procedure TMainForm.PaintGeamOrizHandler(Sender: TObject;Buffer: TBitmap32);
var
bmp32:TBitmap32;
R:TRect;
usa2:single;
latime,inaltime,usa:Single;
inaltime2, latime2:single;
begin
cronstart:=now;
if Sender is TBitmapLayer then
with TBitmapLayer(Sender).GetAdjustedLocation do
begin
bmp32:=TBitmap32.Create;
try
R := MakeRect(TBitmapLayer(Sender).GetAdjustedLocation);
bmp32.DrawMode:=dmblend;
bmp32.SetSize(Round(Right-Left), Round(Bottom-Top));
latime:=Round((Right-Left));
inaltime:=Round((Bottom-Top));
usa:=60;
usa2:=usa / 2;
with TLine32.Create do
try
EndStyle := esClosed;
JoinStyle := jsMitered;
inaltime2:=inaltime / 2;
latime2:=latime / 2;
SetPoints([FixedPoint(latime2-usa2,inaltime2), FixedPoint(latime2+usa2,inaltime2)]);
Draw(bmp32, 13, clWhite32);
SetPoints(GetOuterEdge);
Draw(bmp32, 1.5, clBlack32);
SetPoints([FixedPoint(latime2-usa2-3,inaltime2), FixedPoint(latime2-usa2,inaltime2)]);
Draw(bmp32, 5, clBlack32);
SetPoints([FixedPoint(latime2-usa2-3-7,inaltime2), FixedPoint(latime2-usa2-3,inaltime2)]);
Draw(bmp32, 7, clWhite32);
SetPoints(GetOuterEdge);
Draw(bmp32, 1.5, clBlack32);
SetPoints([FixedPoint(latime2+usa2,inaltime2), FixedPoint(latime2+usa2+3,inaltime2)]);
Draw(bmp32, 5, clBlack32);
SetPoints([FixedPoint(latime2+usa2+3+7,inaltime2), FixedPoint(latime2+usa2+3,inaltime2)]);
Draw(bmp32, 7, clWhite32);
SetPoints(GetOuterEdge);
Draw(bmp32, 1.5, clBlack32);
finally
Free;
end;
(Sender as TBitmapLayer).Bitmap.Assign(bmp32);
finally
bmp32.Free;
end;
end;
cronstop:=now;
Memo1.Lines.Add('PaintLayer:'+FloatToStr((cronstop-cronstart)*secsperDay)+'sec');
end;
procedure TMainForm.SetSelection(Value: TPositionedLayer);
begin
if Value<>nil then
begin
if Value <> FSelection then
begin
if RBLayer <> nil then
begin
RBLayer.ChildLayer := nil;
RBLayer.LayerOptions := LOB_NO_UPDATE;
end;
FSelection := Value;
if Value <> nil then
begin
if RBLayer = nil then
begin
RBLayer := TRubberBandLayer.Create(ImgView.Layers);
RBLayer.MinHeight := 1;
RBLayer.MinWidth := 1;
end
else
RBLayer.BringToFront;
RBLayer.ChildLayer := Value;
RBLayer.LayerOptions := LOB_VISIBLE or LOB_MOUSE_EVENTS or LOB_NO_UPDATE;
RBLayer.OnResizing := RBResizing;
end;
end;
end;
end;
procedure TMainForm.RBResizing(Sender: TObject;
const OldLocation: TFloatRect; var NewLocation: TFloatRect;
DragState: TRBDragState; Shift: TShiftState);
var
w, h, cx, cy: Single;
nw, nh: Single;
begin
cronstart:=now;
if DragState = dsMove then Exit; // we are interested only in scale operations
if Shift = [] then Exit; // special processing is not required
if ssCtrl in Shift then
begin
{ make changes symmetrical }
with OldLocation do
begin
cx := (Left + Right) / 2;
cy := (Top + Bottom) / 2;
w := Right - Left;
h := Bottom - Top;
end;
with NewLocation do
begin
nw := w / 2;
nh := h / 2;
case DragState of
dsSizeL: nw := cx - Left;
dsSizeT: nh := cy - Top;
dsSizeR: nw := Right - cx;
dsSizeB: nh := Bottom - cy;
dsSizeTL: begin nw := cx - Left; nh := cy - Top; end;
dsSizeTR: begin nw := Right - cx; nh := cy - Top; end;
dsSizeBL: begin nw := cx - Left; nh := Bottom - cy; end;
dsSizeBR: begin nw := Right - cx; nh := Bottom - cy; end;
end;
if nw < 2 then nw := 2;
if nh < 2 then nh := 2;
Left := cx - nw;
Right := cx + nw;
Top := cy - nh;
Bottom := cy + nh;
end;
end;
cronstop:=now;
Memo1.Lines.Add('RBResizing:'+FloatToStr((cronstop-cronstart)*secsperDay)+'sec');
end;
procedure TMainForm.ImgViewChange(Sender: TObject);
var
wid,hei:Integer;
begin
Edit1.Text:=IntToStr(StrToInt(Edit1.Text)+1);
cronstart:=now;
if Selection = nil then
begin
end
else
begin
wid:=Round(Selection.Location.Right-Selection.Location.Left);
hei:=Round(Selection.Location.Bottom-Selection.Location.Top);
// SelectLayerPan(Selection.Index);
end;
cronstop:=now;
Memo1.Lines.Add('ImgViewChange:'+FloatToStr((cronstop-cronstart)*secsperDay)+'sec');
end;
procedure TMainForm.ImgViewMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
begin
Edit1.Text:='0';
cronstart:=now;
if Layer = nil then
begin
if Assigned(FSelection) then
begin
Selection := nil;
RBLayer.Visible:=false;
end;
end
else
begin
// SelectLayerPan(layer.Index);
end;
cronstop:=now;
Memo1.Lines.Add('imgViewMouseDown:'+FloatToStr((cronstop-cronstart)*secsperDay)+'sec');
end;
procedure TMainForm.ImgViewPaintStage(Sender: TObject; Buffer: TBitmap32;
StageNum: Cardinal);
const //0..1
Colors: array [Boolean] of TColor32 = ($FFFFFFFF, $FFB0B0B0);
var
R: TRect;
I, J: Integer;
OddY: Integer;
TilesHorz, TilesVert: Integer;
TileX, TileY: Integer;
TileHeight, TileWidth: Integer;
begin
TileHeight := 13;
TileWidth := 13;
TilesHorz := Buffer.Width div TileWidth;
TilesVert := Buffer.Height div TileHeight;
TileY := 0;
for J := 0 to TilesVert do
begin
TileX := 0;
OddY := J and $1;
for I := 0 to TilesHorz do
begin
R.Left := TileX;
R.Top := TileY;
R.Right := TileX + TileWidth;
R.Bottom := TileY + TileHeight;
Buffer.FillRectS(R, Colors[I and $1 = OddY]);
Inc(TileX, TileWidth);
end;
Inc(TileY, TileHeight);
end;
end;
procedure TMainForm.Button1Click(Sender: TObject);
begin
Edit1.Text:='0';
MainForm.AddSpecialLineLayer('geams'); //orizontal
end;
So just click the button multiple times (30 times) and you will notice the eratic behaviour once you get to have 25-30 layers added.
(Of course use the base code from the layers example of the library and add the above procedures)
Maybe a solution would be to disable somewhere the ImgViewChange event from firing. But I do not know where to do that... Or maybe I'm wrong.
Please give me a solution for this problem... because I can't think of anything...
EDIT
Here is a screenshot that will explain better:
As you can see in the right side of the imgView, there are 3 editboxes. The first tells us that there are 25 layers added already. The other two are also self-explanatory.
In the left side of the picture you can see the layers drawn there. They are all the same, drawn with the paintHandler from the code. So all the layers are identical
Now consider this scenario: no layer is selected, then I start clicking layers, the first 3 clicks, show me ImgViewChange=52 and Paint=26, for each of them. Then on my fourth click on a layer the values are those in the image displayed here. This does not make any sense.
So ImgViewChanged is called 1952 times and the PaintHandler is called 976 times. There must be a bug somewhere...
Please help me figure this out. take into consideration that those editboxes get filled in the code above. Also in this test project there is no other code that might do this crazy behavior. I wrote this test project with only the code that was neccessary to make it work. So the code is above, the behavior is in the picture.
EDIT
After I added bmp32.BeginUpdate and bmp32.EndUpdate in the PaintHandler method, the number of repaints and imgViewChanges seem to have decreased, but not by much. Now I get ImgViewChange=1552 and PaintHandler=776.
I'm not even sure that it's because my change, because these numbers seem almost random. I mean I have no idea why it happens, who triggers those events for regular number of times, and what happens when they are triggered so many more times?
When I add the layers to the imgView, all 25 of them, I leave them where they are added: in the center of the View. After they are all added, I start click-in on each and I drag them away from the center so they would all be visible.
Now, the first 15-20 layers that I click on and drag from the center, the 2 numbers that I monitor (number of times those two events get fired) is a lot lower that the numbers I get after the 20th layer that I want to drag from the center. And after they are all dispersed in the view, it begins: some layers are click-able in real-time, others take a while to get selected and my count of event-fires are through the roof.
EDIT
I found my problem.
With this I reduced the number of events that get fired to the normal amount. So the solution was to add BeginUpdate and EndUpdate for the Assignment of the layer's bitmap...
So in the PaintHandler I changed the code to:
(Sender as TBitmapLayer).BeginUpdate;
(Sender as TBitmapLayer).Bitmap.Assign(bmp32);
(Sender as TBitmapLayer).EndUpdate;
And now my layers behave like they should. Thank you SilverWarrior for pointing me into the right direction. Please convert your comment into an answer so I can accept it.
The BeginUpdate/EndUpdate are beneficial to reduce the number of ImgViewChange events as documented here
OnChange is an abstract change notification event, which is called by
some of the descendants of TCustomPaintBox32 immediately after changes
have been made to their contents. In TCustomImage32, for example, this
includes redirection of change notification events from the contained
bitmap and from layers. This event, however, is not called by
TCustomPaintBox32 control itself, unless you call the Changed method
explicitly. Change notification may be disabled with BeginUpdate call
and re-enabled with EndUpdate call.
However, there are other problems in your code:
In AddSpecialLineLayer() you create a new TBitmapLayer, set the size and location of its Bitmap and set its OnPaint handler to PaintGeamOrizHandler(). This is not a problem in itself, but it's the first step towards the real problem.
In PaintGeamOrizHandler() the main idea seems to be to draw some shapes, but the way it is done is very time consuming for no benefit.
First you create a new TBitmap32. Then you draw the shapes on this bitmap. Then you assign it to the layers bitmap. Finally you free the bitmap just created.
All of the shape drawing could instead have been done directly to the layers bitmap. The "temporary" bitmap is just a waist of CPU resources.
But another question is, why are the shapes drawn every time the layer needs to be painted? The bitmap of the TBitmapLayer is perfectly capable of retaining the shapes until you specifically need to change them. Instead you could have drawn the shapes in a separate procedure as a one time effort when you created the layer (and/or when you need to change the shapes).
You may also want to explore the documentation for paint stages and perhaps repaint optimizer
I'm making a simple control based on a TScrollingWinControl (and code copied from a TScrollBox) with a TImage control. I somewhat got the zooming to work, but it doesn't necessarily zoom to a focused point - the scrollbars don't change accordingly to keep the center point in focus.
I would like to be able to tell this control ZoomTo(const X, Y, ZoomBy: Integer); to tell it where to zoom the focus to. So when it zooms, the coordinates I passed will stay 'centered'. At the same time, I also need to have a ZoomBy(const ZoomBy: Integer); which tells it to keep it centered in the current view.
For example, there will be one scenario where the mouse is pointed at a particular point of the image, and when holding control and scrolling the mouse up, it should zoom in focused on the mouse pointer. On the other hand, another scenario would be sliding a control to adjust the zoom level, in which case it just needs to keep the center of the current view (not necessarily center of the image) focused.
The problem is my math gets lost at this point, and I can't figure out the right formula to adjust these scroll bars. I've tried a few different ways of calculating, nothing seems to work right.
Here's a stripped version of my control. I removed most to only the relevant stuff, original unit is over 600 lines of code. The most important procedure below is SetZoom(const Value: Integer);
unit JD.Imaging;
interface
uses
Windows, Classes, SysUtils, Graphics, Jpeg, PngImage, Controls, Forms,
ExtCtrls, Messages;
type
TJDImageBox = class;
TJDImageZoomEvent = procedure(Sender: TObject; const Zoom: Integer) of object;
TJDImageBox = class(TScrollingWinControl)
private
FZoom: Integer; //level of zoom by percentage
FPicture: TImage; //displays image within scroll box
FOnZoom: TJDImageZoomEvent; //called when zoom occurs
FZoomBy: Integer; //amount to zoom by (in pixels)
procedure MouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
procedure SetZoom(const Value: Integer);
procedure SetZoomBy(const Value: Integer);
public
constructor Create(AOwner: TComponent); override;
published
property Zoom: Integer read FZoom write SetZoom;
property ZoomBy: Integer read FZoomBy write SetZoomBy;
property OnZoom: TJDImageZoomEvent read FOnZoom write FOnZoom;
end;
implementation
{ TJDImageBox }
constructor TJDImageBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
OnMouseWheel:= MouseWheel;
ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
csSetCaption, csDoubleClicks, csPannable, csGestures];
AutoScroll := True;
TabStop:= True;
VertScrollBar.Tracking:= True;
HorzScrollBar.Tracking:= True;
Width:= 100;
Height:= 100;
FPicture:= TImage.Create(nil);
FPicture.Parent:= Self;
FPicture.AutoSize:= False;
FPicture.Stretch:= True;
FPicture.Proportional:= True;
FPicture.Left:= 0;
FPicture.Top:= 0;
FPicture.Width:= 1;
FPicture.Height:= 1;
FPicture.Visible:= False;
FZoom:= 100;
FZoomBy:= 10;
end;
destructor TJDImageBox.Destroy;
begin
FImage.Free;
FPicture.Free;
inherited;
end;
procedure TJDImageBox.MouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
NewScrollPos: Integer;
begin
if ssCtrl in Shift then begin
if WheelDelta > 0 then
NewScrollPos := Zoom + 5
else
NewScrollPos:= Zoom - 5;
if NewScrollPos >= 5 then
Zoom:= NewScrollPos;
end else
if ssShift in Shift then begin
NewScrollPos := HorzScrollBar.Position - WheelDelta;
HorzScrollBar.Position := NewScrollPos;
end else begin
NewScrollPos := VertScrollBar.Position - WheelDelta;
VertScrollBar.Position := NewScrollPos;
end;
Handled := True;
end;
procedure TJDImageBox.SetZoom(const Value: Integer);
var
Perc: Single;
begin
FZoom := Value;
if FZoom < FZoomBy then
FZoom:= FZoomBy;
Perc:= FZoom / 100;
//Resize picture to new zoom level
FPicture.Width:= Trunc(FImage.Width * Perc);
FPicture.Height:= Trunc(FImage.Height * Perc);
//Move scroll bars to properly position the center of the view
//This is where I don't know how to calculate the 'center'
//or by how much I need to move the scroll bars.
HorzScrollBar.Position:= HorzScrollBar.Position - (FZoomBy div 2);
VertScrollBar.Position:= VertScrollBar.Position - (FZoomBy div 2);
if assigned(FOnZoom) then
FOnZoom(Self, FZoom);
end;
procedure TJDImageBox.SetZoomBy(const Value: Integer);
begin
if FZoomBy <> Value then begin
FZoomBy := EnsureRange(Value, 1, 100);
Paint;
end;
end;
end.
It's not clear what would you like to refer for X, Y when passing to 'ZoomBy()'. I'll assume you've put an 'OnMouseDown' handler for the image and the coordinates refer to where you click on the image, i.e. they're not relative to scrollbox coordinates. If this is not so, you can tweak it yourself.
Let's forget about zooming for a minute, let our task be centering the point that we click on the image in the scrollbox. Easy, we know that the center of the scrollbox is at (ScrollBox.ClientWidth/2, ScrollBox.ClientHeight/2). Think horizontal, we want to scroll up to a point so that, if we add ClientWidth/2 to it, it will be our click point:
procedure ScrollTo(CenterX, CenterY: Integer);
begin
ScrollBox.HorzScrollBar.Position := CenterX - Round(ScrollBox.ClientWidth / 2);
ScrollBox.VertScrollBar.Position := CenterY - Round(ScrollBox.ClientHeight / 2);
end;
Now consider zooming. All we have to do is to calculate X, Y positions accordingly, the size of the scrollbox won't change. CenterX := Center.X * ZoomFactor. But be careful, 'ZoomFactor' here is not the effective zoom, it is the zoom that will be applied when we click on the image. I'll use the image's before and after dimensions to determine that:
procedure ZoomTo(CenterX, CenterY, ZoomBy: Integer);
var
OldWidth, OldHeight: Integer;
begin
OldWidth := FImage.Width;
OldHeight := FImage.Height;
// zoom the image, we have new image size and scroll range
CenterX := Round(CenterX * FImage.Width / OldWidth);
ScrollBox.HorzScrollBar.Position := CenterX - Round(ScrollBox.ClientWidth / 2);
CenterY := Round(CenterY * FImage.Height / OldHeight);
ScrollBox.VertScrollBar.Position := CenterY - Round(ScrollBox.ClientHeight / 2);
end;
Of course, you'd refactor them into one line so that you call Round() only once to reduce rounding error.
I'm sure you can workout from here yourself.
I'm trying to make a small game based on the canvas in Delphi. Basically, I'd like to make a fairly large bitmap ( 3000x3000, for example ), then load it into the canvas, and being able to scroll right/left/up/down just like an ordinary image viewer, however I can't seem to find what I'm looking for. Any ideas?
Load the image to an off-screen TBitmap object. Then, OnPaint, or whenever is suitable in your particular application, use BitBlt or Canvas.Draw to draw a rectangular subimage of the TBitmap onto the canvas. The subpart should start at (X, Y) on the TBitmap and have a width and height equal to ClientWidth and ClientHeight of the form, respectively.
Now, respond to keyboard events. Write a FormKeyDown event handler, and listen to Key = VK_LEFT, Key = VK_RIGHT, Key = VK_UP, and Key = VK_DOWN (use a case statement). When you detect such a key being pressed, increase/decrease X or Y, as appropriate, and paint the scene again using this starting point.
You can also respond to the MouseDown, MouseMove, and MouseUp events to scroll using the mouse. Either you can use the middle one only (MouseMove): You can check if the cursor is near an edge of the form, and if so, scroll in this direction smoothly (using a TTimer, for instance). Alternatively, you can set a FMouseDown flag to true in MouseDown, and reset it to false in MouseUp. Then, in MouseMove, scroll the bitmap by a delta X-XOld in the x direction if FMouseDown is true, and a delta Y-YOld in the y direction. (Here, X and Y are parameters of the MouseMove event handler; (X, Y) is the current position of the cursor.) The MouseMove procedure should end with
XOld := X;
YOld := Y;
no matter if FMouseDown is on or off.
I had the same problem. My Bitmap is about 5000x5000 pixel, loaded into an Timage of 500x500 pixels.
I wrote a code to move the bitmap arround in the Timage, and it cant go out of the "borders"
AlteMausPos is declared in Form1 var at the beginning.
Kerzenbitmap is your bitmap that contains the 5000x5000 picture.
MausPosDifferenz contains the absolut amount of pixels(x,y) you have moved your mouse while mousekey down.
Then it checks if everything is in Range of the bitmap before copying it with CopyRect.
It took some time for my brain to find out that the best way to copy the rect ist to use the absolut changed mouseposition.
procedure Form1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var picLimits: Tpoint;
begin
AlteMausPos.X := X;
AlteMausPos.Y := Y;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var SourceRect, DestRect: TRect;
begin
var tempBMP:= Tbitmap.Create;
MausPosDifferenz.X := MausPosDifferenz.X+ (AlteMausPos.X- X);
MausPosDifferenz.Y := MausPosDifferenz.Y+ (AlteMausPos.Y- Y);
if MausPosDifferenz.X >= Kerzenbitmap.Width- Image1.Width then MausPosDifferenz.X := Kerzenbitmap.Width-Image1.Width;
if MausPosDifferenz.X < 0 then MausPosDifferenz.X:=0;
if MausPosDifferenz.Y >= Kerzenbitmap.Height-Image1.Height then MausPosDifferenz.Y := Kerzenbitmap.Height-Image1.Height;
if MausPosDifferenz.Y < 0 then MausPosDifferenz.Y:=0;
SourceRect:= Rect( MausPosDifferenz.X, MausPosDifferenz.Y, Image1.Width+ MausPosDifferenz.X, Image1.Height+ MausPosDifferenz.Y);
DestRect:= Rect( 0,0, Image1.Width, Image1.Height);
tempBMP.Assign(Kerzenbitmap);
TempBMP.Canvas.CopyRect(DestRect, Kerzenbitmap.Canvas, SourceRect);
Image1.Picture.Assign(tempBMP);
tempBMP.Free;
end;