[SOLVED] BGRABitmap Rotation image
lazarus / 39-Graphics

----------------------------------------------------------------------
Pe3s · 2024-12-29 19:40

Hello, I would like to get a hint what I did wrong that the image
rotation does not work ?
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, ComCtrls, ExtCtrls,  ExtDlgs, BGRABitmap,
BGRABitmapTypes, BGRAGraphicControl, Math; type   { TForm1 }   TForm1
= class(TForm)    OpenPictureDialog1: TOpenPictureDialog;    Panel1:
TPanel;    StatusBar1: TStatusBar;    ToolBar1: TToolBar;   
ToolButton1: TToolButton;    ToolButton2: TToolButton;    ToolButton3:
TToolButton;    ToolButton4: TToolButton;    procedure
FormCreate(Sender: TObject);    procedure FormDestroy(Sender:
TObject);    procedure Panel1Paint(Sender: TObject);    procedure
ToolButton1Click(Sender: TObject);    procedure
ToolButton4Click(Sender: TObject);  private    FImage: TBGRABitmap;  
 procedure FitImage;   public   end; var  Form1:
TForm1; implementation {$R *.lfm} { TForm1 } procedure
TForm1.FormCreate(Sender: TObject);begin  FImage :=
TBGRABitmap.Create;end; procedure TForm1.FormDestroy(Sender:
TObject);begin  FImage.Free;end; procedure TForm1.Panel1Paint(Sender:
TObject);var  ImagePos: TPoint;begin  ImagePos :=
Point(Max((Panel1.ClientWidth - FImage.Width) div 2, 0),
Max((Panel1.ClientHeight - FImage.Height) div 2, 0)); 
FImage.Draw(Panel1.Canvas, ImagePos.X, ImagePos.Y,
True);end; procedure TForm1.ToolButton1Click(Sender: TObject);begin 
if OpenPictureDialog1.Execute then  begin   
FImage.LoadFromFile(OpenPictureDialog1.FileName);    FitImage;   
Panel1.Invalidate;  end;end; procedure TForm1.ToolButton4Click(Sender:
TObject);begin  FImage.RotateCCW();  Panel1.Repaint;end; procedure
TForm1.FitImage;var  FitWidth, FitHeight: Integer;  ScaleFactor:
Double;begin  if Assigned(FImage) and not FImage.Empty then  begin   
ScaleFactor := Min(Panel1.Width / FImage.Width, Panel1.Height /
FImage.Height);    FitWidth := Round(FImage.Width * ScaleFactor);   
FitHeight := Round(FImage.Height * ScaleFactor);    FImage :=
FImage.Resample(FitWidth, FitHeight) as TBGRABitmap;    
Panel1.Invalidate;  end;end;   end.

----------------------------------------------------------------------
Roland57 · 2024-12-29 20:25

Hello!

RotateCCW is a function. So:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i  
//FImage.RotateCCW();  BGRAReplace(FImage, FImage.RotateCCW());

----------------------------------------------------------------------
Pe3s · 2024-12-30 06:38

Thanks, but I noticed if I add the FitImage procedure to Form onResize
then when I change the dimensions the image fits to the window but
blurs, how can I fix this ?

Greetings

----------------------------------------------------------------------
Roland57 · 2024-12-30 07:31

Quote from: Pe3s on December 30, 2024, 07:38:29 amThanks, but I
noticed if I add the FitImage procedure to Form onResize then when I
change the dimensions the image fits to the window but blurs, how can
I fix this ?

Maybe it happens because the picture has been resampled to a smaller
size and then to a bigger size? I would keep the original image
separately, and use another TBGRABitmap for the resampled image.

----------------------------------------------------------------------
Roland57 · 2024-12-30 07:36

By the way, it is possible to resize the picture using only integer
numbers. The trick was given to me by a contributor of the french
Pascal forum.

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i procedure
TForm1.FitImage;var  FitWidth, FitHeight: Integer;  (*  ScaleFactor:
Double;  *)begin  if Assigned(FImage) and not FImage.Empty then 
begin    (*    ScaleFactor := Min(Panel1.Width / FImage.Width,
Panel1.Height / FImage.Height);    FitWidth := Round(FImage.Width *
ScaleFactor);    FitHeight := Round(FImage.Height * ScaleFactor);   
*)     if FImage.Width * Panel1.ClientHeight > FImage.Height *
Panel1.ClientWidth then    begin      FitWidth := Panel1.ClientWidth; 
    FitHeight := FImage.Height * Panel1.ClientWidth div FImage.Width; 
  end    else begin      FitHeight := Panel1.ClientHeight;     
FitWidth := FImage.Width * Panel1.ClientHeight div FImage.Height;   
end;        (*    Image := FImage.Resample(FitWidth, FitHeight) as
TBGRABitmap;    *)    BGRAReplace(FImage, FImage.Resample(FitWidth,
FitHeight));        Panel1.Invalidate;  end;end;

----------------------------------------------------------------------
Pe3s · 2024-12-30 08:53

Unfortunately the same blurs the image, the image is large 3000x2000px

----------------------------------------------------------------------
circular · 2024-12-31 15:55

Indeed, resample will blur the image most of the time. You may get
less blur by using rmSimpleStretch parameter to the Resample function:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i
BGRAReplace(FImage, FImage.Resample(FitWidth, FitHeight,
rmSimpleStretch));Alternatively, you can set the ResampleFilter
property of FImage before resampling.

----------------------------------------------------------------------
Pe3s · 2025-01-02 10:52

using this command degrades image quality