Search code examples
delphitimage

Zoom image using delphi


I am working with delphi. I have TImage, to which I assign a bitmap.

imgmain.Picture.Bitmap := bmpMain;
imgmain.Picture.Bitmap.PixelFormat := pf24bit;

imgmain is object of TImage and bmpMain is object of TBitmap

I want to zoom my image. I have one trackbar on my form and as I click on trackbar the image should get zoom. What should I do?
Thank You.

Edit :
I found some solution at here It works but it cut my image.


Solution

  • The code you refer to sets up a transformation from one coordinate space to another, I didn't notice anything that would cut/crop your image there. However, instead of having an inversely proportional zoom factor I'd rather have, easy to understand, linear scaling. Also, I see no reason switching map modes depending on the scaling factor, I would modify the SetCanvasZoomFactor like this;

    procedure SetCanvasZoomPercent(Canvas: TCanvas; AZoomPercent: Integer);
    begin
      SetMapMode(Canvas.Handle, MM_ISOTROPIC);
      SetWindowExtEx(Canvas.Handle, 100, 100, nil);
      SetViewportExtEx(Canvas.Handle, AZoomPercent, AZoomPercent, nil);
    end;
    

    A simplified (no error checking) working example with a bitmap loaded to a TImage, scaled via a TrackBar could be like the below. Note that the above function is inlined in the TrackBar's OnChange event.

    type
      TForm1 = class(TForm)
        imgmain: TImage;
        TrackBar1: TTrackBar;
        Label1: TLabel;
        procedure FormCreate(Sender: TObject);
        procedure TrackBar1Change(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
      private
        bmpmain: TBitmap;
      [..]
    
    [...]
    procedure TForm1.FormCreate(Sender: TObject);
    begin
      bmpmain := TBitmap.Create;
      bmpmain.LoadFromFile(ExtractFilePath('samplebitmap.bmp');
      bmpmain.PixelFormat := pf32bit; // No significance, just seems faster here than pf24bit
    
      TrackBar1.Min := 10;
      TrackBar1.Max := 200;
      TrackBar1.Frequency := 10;
      TrackBar1.PageSize := 10;
      TrackBar1.Position := 100; // Fires OnChange
    end;
    
    procedure TForm1.FormDestroy(Sender: TObject);
    begin
     bmpmain.Free;
    end;
    
    procedure TForm1.TrackBar1Change(Sender: TObject);
    var
      Zoom, x, y: Integer;
    begin
      Zoom := TrackBar1.Position;
      if not (Visible or (Zoom = 100)) or (Zoom = 0) then
        Exit;
    
      SetMapMode(imgmain.Canvas.Handle, MM_ISOTROPIC);
      SetWindowExtEx(imgmain.Canvas.Handle, 100, 100, nil);
      SetViewportExtEx(imgmain.Canvas.Handle, Zoom, Zoom, nil);
      x := imgmain.Width * 50 div Zoom - bmpmain.Width div 2;
      y := imgmain.Height * 50 div Zoom - bmpmain.Height div 2;
      imgmain.Canvas.Draw(x, y, bmpmain);
      if (x > 0) or (y > 0) then begin
        imgmain.Canvas.Brush.Color := clWhite;
        ExcludeClipRect(imgmain.Canvas.Handle, x, y, x + bmpmain.Width, y + bmpmain.Height);
        imgmain.Canvas.FillRect(imgmain.Canvas.ClipRect);
      end;
    
      Label1.Caption := 'Zoom: ' + IntToStr(TrackBar1.Position) + '%';
    end;
    


    edit: same code with a TImage in a ScrollBox;

    type
      TForm1 = class(TForm)
        TrackBar1: TTrackBar;
        Label1: TLabel;
        ScrollBox1: TScrollBox;
        imgmain: TImage;
        procedure FormCreate(Sender: TObject);
        procedure TrackBar1Change(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
      private
        bmpmain: TBitmap;
      [...]
    [...]
    
    const
      FULLSCALE = 100;
    
    procedure TForm1.FormCreate(Sender: TObject);
    begin
      imgmain.Left := 0;
      imgmain.Top := 0;
    
      bmpmain := TBitmap.Create;
      bmpmain.LoadFromFile(ExtractFilePath(Application.ExeName) + '610x.bmp');
      bmpmain.PixelFormat := pf32bit;
    
      TrackBar1.Min := FULLSCALE div 10;   // %10
      TrackBar1.Max := FULLSCALE * 2;      // %200
      TrackBar1.PageSize := (TrackBar1.Max - TrackBar1.Min) div 19;
      TrackBar1.Frequency := TrackBar1.PageSize;
      TrackBar1.Position := FULLSCALE;
    end;
    
    procedure TForm1.FormDestroy(Sender: TObject);
    begin
      bmpmain.Free;
    end;
    
    procedure TForm1.TrackBar1Change(Sender: TObject);
    var
      Zoom: Integer;
    begin
      Zoom := TrackBar1.Position;
      if not (Visible or (Zoom = FULLSCALE)) or (Zoom = 0) then
        Exit;
    
      SetMapMode(imgmain.Canvas.Handle, MM_ISOTROPIC);
      SetWindowExtEx(imgmain.Canvas.Handle, FULLSCALE, FULLSCALE, nil);
      SetViewportExtEx(imgmain.Canvas.Handle, Zoom, Zoom, nil);
    
      imgmain.Width := Round(bmpmain.Width * Zoom / FULLSCALE);
      imgmain.Height := Round(bmpmain.Height * Zoom / FULLSCALE);
      if Assigned(imgmain.Picture.Graphic) then begin
        imgmain.Picture.Graphic.Width := imgmain.Width;
        imgmain.Picture.Graphic.Height := imgmain.Height;
      end;
      imgmain.Canvas.Draw(0, 0, bmpmain);
    
      Label1.Caption := 'Zoom: ' +
          IntToStr(Round(TrackBar1.Position / FULLSCALE * 100)) + '%';
    end;