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;
Related
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;
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.
All of the GDIPlus demo code I can find draws without invalidation. So how do you invalidate a rectangle in GDIPlus API when drawing with MouseMove with TImage on a TScrollbox?
function NormalizeRect ( R: TRect ): TRect;
begin
// This routine normalizes a rectangle. It makes sure that the Left,Top
// coords are always above and to the left of the Bottom,Right coords.
with R do
begin
if Left > Right then
if Top > Bottom then
Result := Rect ( Right, Bottom, Left, Top )
else
Result := Rect ( Right, Top, Left, Bottom )
else if Top > Bottom then
Result := Rect ( Left, Bottom, Right, Top )
else
Result := Rect ( Left, Top, Right, Bottom );
end;
end;
procedure TFormMain.Image1MouseDown ( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
begin
if Line1.Down then
begin
GPPointStart := MakePoint ( X, Y );
end;
end;
procedure TFormMain.Image1MouseMove ( Sender: TObject; Shift: TShiftState; X, Y: Integer );
var
graphics: TGPGraphics;
pen: TGPPen;
SolidBrush: TGPSolidBrush;
rgbTriple: windows.RGBTRIPLE;
iRect: TRect;
begin
if Line1.Down then
begin
if ssLeft in Shift then
begin
iRect := NormalizeRect ( Rect ( X, Y, Image1.Picture.Bitmap.Width, Image1.Picture.Bitmap.Height ) );
InvalidateRect ( ScrollBox1.Handle, #iRect, TRUE );
graphics := TGPGraphics.Create ( Image1.Picture.Bitmap.Canvas.Handle );
graphics.Flush ( FlushIntentionFlush );
GPPointEnd := MakePoint ( X, Y );
rgbTriple := ColorToRGBTriple ( ColorBox1.Selected );
pen := TGPPen.Create ( MakeColor ( StrToInt ( Alpha1.Text ), rgbTriple.rgbtRed, rgbTriple.rgbtGreen, rgbTriple.rgbtBlue )
);
pen.SetWidth ( StrToInt ( Size1.Text ) );
graphics.DrawLine ( pen, GPPointStart.X, GPPointStart.Y, GPPointEnd.X, GPPointEnd.Y );
graphics.Free;
Image1.Refresh;
end;
end;
end;
This is what it looks like:
Using GDIPlus Library from http://www.progdigy.com with Delphi 2010.
The InvalidateRect command has nothing to do with GDI+. It's a command that tells the OS that a certain portion of a window is invalid and should be repainted. When the OS next decides to repaint that window, the program can ask the OS how much of the window needs painting.
Your code is calling InvalidateRect, and then it's painting over that same portion of the window. The window is still invalidated, though, so the OS will ask your program to repaint that area later, when you next process a wm_Paint message.
I don't know why you would expect your image to look any different, and it has nothing to do with invalidating the scroll box. It looks like you clicked on the character's eye, and the dragged the mouse down and the the right, clockwise.
At each mouse movement, you draw a new line from the original pint to the current mouse position. You draw the line directly on the currently displayed bitmap, and then you ask the image control to redraw itself. It obeys and draws the bitmap — that bitmap that you just added another line to.
I suspect what you intended to happen was for each mouse movement to result in one black line to appear over an otherwise unsullied image. InvalidateRect won't help with that. You need to redraw the original image over the previous line position, and the draw the new line. InvalidateRect does not help you "undo" a previous graphic operation. It just tells the OS that a certain portion of a window should be repainted sometime. It doesn't say what colors those invalidated pixels should be repainted with. That's what wm_Paint is for.
Using the following code in Delphi 2007:
procedure TfrmTest.PaintBox1Paint(Sender: TObject);
const
Rect_Size = 10;
begin
PaintBox1.Canvas.Brush.Color := clYellow;
PaintBox1.Canvas.FillRect(Rect(0, 0, PaintBox1.width, PaintBox1.height));
PaintBox1.Canvas.Brush.Color := clRed;
DrawARect(PaintBox1.Canvas, 0, 0, Rect_Size, Rect_Size);
end;
procedure TfrmTest.DrawARect(ACanvas: TCanvas; iLeft, iTop, iWidth, iHeight: Integer);
var
rgnMain: HRGN;
begin
rgnMain := CreateRectRgn(iLeft, iTop, iLeft + iWidth, iTop + iHeight);
try
SelectClipRgn(ACanvas.handle, rgnMain);
ACanvas.FillRect(ACanvas.ClipRect);
SelectClipRgn(ACanvas.handle, 0);
finally
DeleteObject(rgnMain);
end;
end;
I get this:
(Yellow area shows boundaries of PaintBox1).
alt text http://www.freeimagehosting.net/uploads/62cf687d29.jpg
(Image shows a form with a yellow box [PaintBox1] in the center. However my red rectange [rgnMain] has been drawn at pos 0,0 on the form)
My expectation was that the red rectangle would be at the top left of the PaintBox1 canvas, not the form's canvas. Why is it not? Can regions only be used with controls that have a Windows handle?
Thanks
Device Contexts require a window handle. What VCL does for non-windowed controls is to offset the view port of the DC acquired for the TWinControl they are on, by using SetWindowOrgEx in TWinControl.PaintControls. The new view port is in logical units. So for 'TGraphicControl's, which does not descend from TWinControl, you can use GDI functions which work on logical coordinates. See the remarks section for SelectClipRgn, which says the coordinates should be specified in device units. You'd offset the region or the coordinates.
How do I tile an image in a TImage in Delphi?
Why I need it: Instead of creating more TImages at runtime, I could create one and store my image there knowing that it will be 'fit' until it reaches TImage's height and width.
Please suggest any ideas to do this.
Thank you!
EDIT: Please note, I'm not asking for streching the image, but filling the canvas by repeating the image.
Assuming your image is a bitmap and loaded into the TImage you can use the following
procedure TmyForm.Button1Click(Sender: TObject);
var mybmp:TBitmap;
begin
mybmp:= TBitmap.Create();
try
mybmp.Assign(Image1.Picture.Bitmap);
Image1.Picture.Bitmap.SetSize(Image1.Width,Image1.Height);
Image1.Canvas.Brush.Bitmap := mybmp;
Image1.Canvas.FillRect(Image1.BoundsRect);
mybmp.FreeImage;
finally
FreeandNil(mybmp)
end;
end;
Some notes:
If you save the image after titling it you will save the titled version not the original.
Image1.Canvas and Image1.Picture.Bitmap.Canvas are one and the same, that's why you need to resize the bitmap before painting on the canvas.
If you try and assign the bitmap in the TImage to the brush without assigning it to another bitmap object first like so Image1.Canvas.Brush.Bitmap := Image1.Picture.Bitmap you get an exception "not enough storage".
The following is the function that I have used, taking an existing TImage component and tiling it over a target canvas:
procedure TileImage(const Source:tImage;
Target: TCanvas;
TargetHeight,TargetWidth:integer);
// Tiles the source image over the given target canvas
var
X, Y: Integer;
dX, dY: Integer;
begin
dX := Source.Width;
dY := Source.Height;
Y := 0;
while Y < TargetHeight do
begin
X := 0;
while X < TargetWidth do
begin
Target.Draw(X, Y, Source.Picture.graphic);
Inc(X, dX);
end;
Inc(Y, dY);
end;
end;
Because a tLabel exposes a canvas, you can do tricks like the following:
TileImage(Image1,Label1.Canvas,Label1.Height,Label1.Width);
You could set the canvas.brush.bitmap := to the image of the tile. then canvas.fillrect(canvas.cliprect) to tile the whole canvas with the selected tile image. I haven't done it in a long time and I am not able to check if this is really how it's done in Delphi right now, but I am pretty sure this is what you're after.
Delphi installation comes with a Demo named 'Bitmap' (you can find the project in Help dir.).
It uses the following method to draw a tiled image:
procedure TBmpForm.FormPaint(Sender: TObject);
var
x, y: Integer;
begin
y := 0;
while y < Height do
begin
x := 0;
while x < Width do
begin
// Bitmap is a TBitmap.
// form's OnCreate looks like this:
// Bitmap := TBitmap.Create;
// Bitmap.LoadFromFile('bor6.bmp');
// or you can use Canvas.Draw(x, y, Image1.Picture.Bitmap),
// instead of Canvas.Draw(x, y, Bitmap);
//
Canvas.Draw(x, y, Bitmap); //Bitmap is a TBitmap.
x := x + Bitmap.Width; // Image1.Picture.Bitmap.Width;
end;
y := y + Bitmap.Height; // Image1.Picture.Bitmap.Height;
end;
end;
Hope that helps!
By "fitting" do you mean "tiling"?
As far as I know, TImage does not support this out of the box. You'd have to manually draw your picture on the TImage's Canvas in a repeating pattern.