unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, ExtCtrls,
StdCtrls, SDL2, SDL2_image, Math;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
OpenDialog1: TOpenDialog;
Panel1: TPanel;
Panel2: TPanel;
StatusBar1: TStatusBar;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Panel1Paint(Sender: TObject);
private
SDLWindow: PSDL_Window;
SDLRenderer: PSDL_Renderer;
CurrentTexture: PSDL_Texture;
OffsetX, OffsetY, ZoomLevel, MinZoom, MaxZoom, FRotationAngle: Double;
IsPanning: Boolean;
LastMouseX, LastMouseY, ImgWidth, ImgHeight: Integer;
procedure InitializeSDL;
procedure ShutdownSDL;
procedure LoadAndDisplayImage(const FileName: string);
procedure RenderImage;
procedure CenterImage;
procedure Zoom(Delta: Double; FocusX, FocusY: Integer);
procedure FitImage;
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormShow(Sender: TObject);
begin
InitializeSDL;
ZoomLevel := 1.0;
OffsetX := 0;
OffsetY := 0;
IsPanning := False;
ImgWidth := 0; // No image loaded yet
ImgHeight := 0; // No image loaded yet
CurrentTexture := nil;
end;
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
IsPanning := True;
LastMouseX := X;
LastMouseY := Y;
end;
end;
procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if IsPanning then
begin
OffsetX := OffsetX + (X - LastMouseX);
OffsetY := OffsetY + (Y - LastMouseY);
LastMouseX := X;
LastMouseY := Y;
RenderImage;
end;
end;
procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
IsPanning := False;
end;
procedure TForm1.Panel1Paint(Sender: TObject);
begin
// Draw a red rectangle (example)
SDL_SetRenderDrawColor(sdlRenderer, 0, 0, 0, 255);
SDL_RenderFillRect(sdlRenderer, nil); // Full screen fill
SDL_RenderPresent(sdlRenderer);
RenderImage;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ShutdownSDL;
end;
procedure TForm1.FormResize(Sender: TObject);
var
PanelWidth, PanelHeight: Integer;
begin
PanelWidth := Panel1.Width;
PanelHeight := Panel1.Height;
// Skip fitting or rendering if no image is loaded
if (ImgWidth = 0) or (ImgHeight = 0) then Exit;
// Check for valid dimensions before fitting or rendering
if (PanelWidth > 0) and (PanelHeight > 0) then
begin
FitImage; // Automatically fit the image on resize
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
LoadAndDisplayImage(OpenDialog1.FileName);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Zoom(1, Panel1.Width div 2, Panel1.Height div 2); // Zoom in towards the center
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Zoom(-1, Panel1.Width div 2, Panel1.Height div 2); // Zoom out towards the cente
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
ZoomLevel:= 1.0;
CenterImage;
RenderImage;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
FitImage; // Reset zoom and center the image
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
FRotationAngle := (FRotationAngle -90) mod 360;
RenderImage;
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
FRotationAngle := (FRotationAngle +90) mod 360;
RenderImage;
end;
procedure TForm1.InitializeSDL;
begin
if SDL_Init(SDL_INIT_VIDEO) < 0 then
raise Exception.Create('Nie udało się zainicjować SDL: ' + SDL_GetError);
SDLWindow := SDL_CreateWindowFrom(Pointer(Panel1.Handle));
if SDLWindow = nil then
raise Exception.Create('Nie udało się utworzyć okna SDL: ' + SDL_GetError);
SDLRenderer := SDL_CreateRenderer(sdlWindow, -1, SDL_RENDERER_ACCELERATED or SDL_RENDERER_PRESENTVSYNC);
if SDLRenderer = nil then
raise Exception.Create('Nie można utworzyć renderowania SDL: ' + SDL_GetError);
ZoomLevel := 1.0; // Initialize zoom level
end;
procedure TForm1.ShutdownSDL;
begin
if CurrentTexture <> nil then
SDL_DestroyTexture(CurrentTexture);
if SDLRenderer <> nil then
SDL_DestroyRenderer(SDLRenderer);
if SDLWindow <> nil then
SDL_DestroyWindow(SDLWindow);
IMG_Quit;
SDL_Quit;
end;
procedure TForm1.LoadAndDisplayImage(const FileName: string);
var
PanelWidth, PanelHeight: Integer;
FitZoom: Double;
begin
if CurrentTexture <> nil then
SDL_DestroyTexture(CurrentTexture);
CurrentTexture := IMG_LoadTexture(SDLRenderer, PChar(FileName));
if CurrentTexture = nil then
raise Exception.Create('Nie udało się wczytać tekstury: ' + IMG_GetError);
// Query the texture for its dimensions
SDL_QueryTexture(CurrentTexture, nil, nil, @ImgWidth, @ImgHeight);
// Calculate initial zoom to fit the image in the panel
PanelWidth := Panel1.Width;
PanelHeight := Panel1.Height;
FitZoom := Min(PanelWidth / ImgWidth, PanelHeight / ImgHeight);
// Set zoom level and center offsets
ZoomLevel := FitZoom;
OffsetX := (PanelWidth - Round(ImgWidth * ZoomLevel)) div 2;
OffsetY := (PanelHeight - Round(ImgHeight * ZoomLevel)) div 2;
// Set zoom limits
MinZoom := FitZoom * 0.5; // Allow zooming out to 50% of fit size
MaxZoom := 3.0; // Allow zooming in up to 300%
RenderImage;
FitImage;
end;
procedure TForm1.RenderImage;
var
DstRect: TSDL_Rect;
PanelWidth, PanelHeight: Integer;
begin
if CurrentTexture = nil then Exit; // No texture to render
PanelWidth := Panel1.Width;
PanelHeight := Panel1.Height;
if (PanelWidth <= 0) or (PanelHeight <= 0) then Exit; // Avoid rendering if panel is invalid
// Calculate destination rectangle with zoom and offsets
DstRect.w := Round(ImgWidth * ZoomLevel);
DstRect.h := Round(ImgHeight * ZoomLevel);
// Constrain panning to avoid blank spaces
if DstRect.w <= PanelWidth then
OffsetX := (PanelWidth - DstRect.w) / 2
else
OffsetX := Max(Min(OffsetX, 0), PanelWidth - DstRect.w);
if DstRect.h <= PanelHeight then
OffsetY := (PanelHeight - DstRect.h) / 2
else
OffsetY := Max(Min(OffsetY, 0), PanelHeight - DstRect.h);
DstRect.x := Round(OffsetX);
DstRect.y := Round(OffsetY);
SDL_RenderClear(SDLRenderer);
// Render the image
SDL_RenderCopyEx(SDLRenderer, CurrentTexture, nil, @DstRect, FRotationAngle, nil, SDL_FLIP_NONE);
SDL_RenderPresent(SDLRenderer);
end;
procedure TForm1.CenterImage;
var
PanelWidth, PanelHeight: Integer;
begin
if (ImgWidth = 0) or (ImgHeight = 0) or (CurrentTexture = nil) then Exit;
PanelWidth := Panel1.Width;
PanelHeight := Panel1.Height;
// Reset offsets to center the image
OffsetX := (PanelWidth - ImgWidth * ZoomLevel) / 2;
OffsetY := (PanelHeight - ImgHeight * ZoomLevel) / 2;
RenderImage;
end;
procedure TForm1.Zoom(Delta: Double; FocusX, FocusY: Integer);
var
OldZoom: Double;
PanelWidth, PanelHeight: Integer;
ImageCenterX, ImageCenterY: Double;
begin
if (ImgWidth = 0) or (ImgHeight = 0) or (CurrentTexture = nil) then Exit;
OldZoom := ZoomLevel;
PanelWidth := Panel1.Width;
PanelHeight := Panel1.Height;
// Adjust zoom level with bounds
ZoomLevel := Max(MinZoom, Min(MaxZoom, ZoomLevel + Delta * 0.1));
// Compute focus point scaling
if ZoomLevel <> OldZoom then
begin
ImageCenterX := (FocusX - OffsetX) / OldZoom;
ImageCenterY := (FocusY - OffsetY) / OldZoom;
OffsetX := FocusX - ImageCenterX * ZoomLevel;
OffsetY := FocusY - ImageCenterY * ZoomLevel;
end;
// Update caption
Form1.Caption := Format('Zoom: %.0f%%', [ZoomLevel * 100]);
RenderImage;
end;
procedure TForm1.FitImage;
var
RotatedWidth, RotatedHeight: Double;
ScalingFactor: Double;
AngleRadians: Double;
begin
if (ImgWidth = 0) or (ImgHeight = 0) or (CurrentTexture = nil) then Exit;
// Normalize the rotation angle to the range [0, 360)
AngleRadians := DegToRad((FRotationAngle mod 360 + 360) mod 360);
// Calculate rotated bounding box dimensions
RotatedWidth := Abs(ImgWidth * Cos(AngleRadians)) + Abs(ImgHeight * Sin(AngleRadians));
RotatedHeight := Abs(ImgWidth * Sin(AngleRadians)) + Abs(ImgHeight * Cos(AngleRadians));
// Calculate scaling factor to fit the panel's height
ScalingFactor := Panel1.Height / RotatedHeight;
// Update the zoom level to maintain proportional scaling
ZoomLevel := ScalingFactor;
// Recalculate offsets to ensure proper centering
CenterImage;
end;
end.
Recent
