unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, LCLType,
ExtDlgs, ExtCtrls;
type
TInfo = record
Name: string;
Image: TImage;
end;
{ TForm1 }
TForm1 = class(TForm)
ComboBox1: TComboBox;
Label1: TLabel;
Button1: TButton;
EditFileName: TEdit;
Image1: TImage;
OpenPictureDialog1: TOpenPictureDialog;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormResize(Sender: TObject);
private
Index: Integer; // Index of the image currently showing
Data: array of TInfo; // Loaded image data and their names
isViewing: Boolean;
procedure CenterFilename;
procedure ShowLoadedImage;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.CenterFilename;
begin
EditFileName.AutoSize := False;
EditFileName.Width := ClientWidth - round(ClientWidth div 30);
EditFileName.Top := Screen.Height-round(Screen.Height div 10);
EditFileName.Left := -10+round((ClientWidth div 2) - (EditFileName.Width div 2) ); // Vycentrování horizontálně
Image1.Left := round((Width - Image1.Width) div 2);
end;
procedure TForm1.ShowLoadedImage;
var
Count: Integer;
begin
Label1.Visible := False;
Button1.Visible := False;
Label1.Visible := False;
Count := Length(Data);
if Count <= 0 then Exit;
if Index > Count-1 then Exit;
Image1.Picture.Assign(Data[Index].Image.Picture);
EditFileName.Text := Data[Index].Name;
CenterFilename;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if not(OpenPictureDialog1.Execute) then Exit;
try
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
Button1.Visible := False;
EditFileName.Text := ExtractFileName(OpenPictureDialog1.FileName);
isViewing := True;
CenterFilename;
except
ShowMessage('Cannot open the file.');
end;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);
begin
case Key of
VK_ESCAPE: // Exit program
Close;
VK_F5: // Background color
case Color of
clDefault: Color := clBlack;
clBlack: Color := clGray;
clGray: Color := clWhite;
clWhite: Color := clDefault;
else Color := clDefault;
end;
VK_F6: // Info color;
case EditFileName.Font.Color of
clDefault: EditFileName.Font.Color := clBlack;
clBlack: EditFileName.Font.Color := clGray;
clGray: EditFileName.Font.Color := clWhite;
clWhite: EditFileName.Font.Color := clYellow;
clYellow: EditFileName.Font.Color := clRed;
clRed: EditFileName.Font.Color := clBlue;
clBlue: EditFileName.Font.Color := clDefault;
else EditFileName.Font.Color := clDefault;
end;
VK_F7: // Proportinal stretch
Image1.Proportional := not(Image1.Proportional);
VK_F8: // Fullscreen modes
case WindowState of
wsNormal: WindowState := wsMaximized;
wsMaximized: WindowState := wsFullScreen;
wsFullScreen: WindowState := wsNormal;
end;
VK_LEFT: // Show preview image
begin
Dec(Index);
if Index < 0 then
Index := Length(Data)-1;
ShowLoadedImage;
end;
VK_RIGHT,
VK_SPACE: // Show next image
begin
Inc(Index);
if Index >= Length(Data) then
Index := 0;
Image1.Proportional := True;
Image1.Stretch := True;
Image1.Align := alClient;
Button1.Visible := False;
ShowLoadedImage;
end;
end;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
if isViewing then
CenterFilename;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Tmp: TImage;
Count: Integer;
i: Integer;
begin
Constraints.MinHeight := 600;
Constraints.MinWidth := 800;
KeyPreview := True;
Caption := 'Image Viewer';
Button1.Caption := 'Open';
Image1.Proportional := True;
Image1.Stretch := True;
Image1.Align := alClient;
Index := 0;
isViewing := False;
// Try to load images using names supplied by parameter string
for i := 1 to ParamCount do
begin
Tmp := TImage.Create(nil);
try
Tmp.Picture.LoadFromFile(ParamStr(i));
Count := Length(Data);
Inc(Count);
SetLength(Data, Count);
Data[Count-1].Image := TImage.Create(nil);
Data[Count-1].Image.Picture.Assign(Tmp.Picture);
Data[Count-1].Name := ParamStr(i);
finally
Tmp.Free;
end;
end;
if Length(Data) > 0 then // Managed to load some images
begin
isViewing := True;
ShowLoadedImage;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
var
i: Integer;
begin
if Length(Data) <= 0 then Exit;
for i := 0 to Length(Data)-1 do
Data[i].Image.Free;
SetLength(Data, 0);
end;
end.
Recent
