BSOne.SFC/EM.Lib/ImageEn_SRC/Demos/Multi/Thumbnails/Unit1.pas

327 lines
8.5 KiB
Plaintext

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ImageEnView, IEMView, StdCtrls, ImageEnIO, ComCtrls, ieview, hyiedefs,
ExtCtrls, ieopensavedlg, FileCtrl, AppEvnts;
type
TForm1 = class(TForm)
GroupBox1: TPanel;
DriveComboBox1: TDriveComboBox;
DirectoryListBox1: TDirectoryListBox;
ImageEnMView1: TImageEnMView;
ImageEnView1: TImageEnView;
chkSoftShadow: TCheckBox;
chkWallpaper: TCheckBox;
chkShowText: TCheckBox;
Splitter1: TSplitter;
chkShowPreview: TCheckBox;
Button1: TButton;
chkExplorerColors: TCheckBox;
DebugTimer: TTimer;
GroupBox2: TGroupBox;
Label1: TLabel;
Label3: TLabel;
Label2: TLabel;
Label4: TLabel;
chkLookAhead: TCheckBox;
chkAutoRotate: TCheckBox;
lblOptions: TLabel;
chkLoadEXIFThumbs: TCheckBox;
lblStyle: TLabel;
lblZoom: TLabel;
edtZoom: TEdit;
updZoom: TUpDown;
Splitter2: TSplitter;
procedure FormCreate(Sender: TObject);
procedure DirectoryListBox1Change(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure ImageEnMView1ImageSelect(Sender: TObject; idx: Integer);
procedure ImageEnMView1BeforeImageDraw(Sender: TObject; idx, Left,
Top: Integer; Canvas: TCanvas);
procedure chkSoftShadowClick(Sender: TObject);
procedure chkWallpaperClick(Sender: TObject);
procedure chkShowTextClick(Sender: TObject);
procedure chkShowPreviewClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ImageEnMView1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure DebugTimerTimer(Sender: TObject);
procedure chkLookAheadClick(Sender: TObject);
procedure chkAutoRotateClick(Sender: TObject);
procedure chkExplorerColorsClick(Sender: TObject);
procedure chkLoadEXIFThumbsClick(Sender: TObject);
procedure edtZoomChange(Sender: TObject);
private
procedure UpdatePreview;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{$R WindowsTheme.res}
// Initialize
procedure TForm1.FormCreate(Sender: TObject);
begin
ImageEnMView1.ThumbnailDisplayFilter := rfFastLinear;
ImageEnMView1.ThumbnailResampleFilter := rfLanczos3;
ImageEnView1.GradientEndColor := clGray;
ImageEnMView1.GradientEndColor := clGray;
ImageEnMView1.SetModernStyling;
chkExplorerColorsClick(nil); // Reset colors
ImageEnMView1.EnableAlphaChannel := true;
ImageEnMView1.ShowText := false;
ImageenMView1.SoftShadow.Enabled := true;
ImageEnMView1.FillThumbnail := false;
// Automatic column count (based on width)
ImageEnMView1.GridWidth := -1;
end;
// Fill ImageEnMView
procedure TForm1.DirectoryListBox1Change(Sender: TObject);
begin
ImageEnMView1.Clear;
ImageEnMView1.FillFromDirectory(DirectoryListBox1.Directory);
//
ImageEnMView1.SelectedImage := 0;
UpdatePreview;
end;
{
// this is another way using FindFirst and FindNext:
procedure TForm1.DirectoryListBox1Change(Sender: TObject);
var
sr : TSearchRec;
Found,idx : integer;
fpath : string;
begin
ImageEnMView1.Clear;
ImageEnMView1.LockPaint;
Found := FindFirst(DirectoryListBox1.Directory+'\*.*',faArchive,sr);
if Found = 0 then
begin
while Found = 0 do
begin
fpath := DirectoryListBox1.Directory+'\'+sr.Name;
if IsKnownFormat(fpath) then
begin
idx := ImageEnMView1.AppendImage;
ImageEnMView1.ImageFileName[idx] := fpath;
ImageEnMView1.ImageBottomText[idx] := extractfilename(fpath);
end;
//
Found := FindNext(sr);
end;
FindClose(sr);
end;
imageEnMView1.UnLockPaint;
//
ImageEnMView1.SelectedImage := 0;
UpdatePreview;
end;
}
// Get text for display
procedure TForm1.ImageEnMView1BeforeImageDraw(Sender: TObject; idx, Left,
Top: Integer; Canvas: TCanvas);
begin
ImageEnMView1.ImageInfoText[idx]:= inttostr(ImageEnMView1.ImageOriginalWidth[idx]) + ' x ' +
inttostr(ImageEnMView1.ImageOriginalHeight[idx]) + ' x ' +
inttostr(ImageEnMView1.ImageBitCount[idx]);
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
DirectoryListBox1Change(self);
end;
procedure TForm1.ImageEnMView1ImageSelect(Sender: TObject; idx: Integer);
begin
UpdatePreview;
end;
// Soft shadow
procedure TForm1.chkSoftShadowClick(Sender: TObject);
begin
ImageEnMView1.SoftShadow.Enabled := chkSoftShadow.Checked;
ImageEnMView1.Update;
end;
// Wallpaper
procedure TForm1.chkWallpaperClick(Sender: TObject);
begin
if chkWallpaper.Checked then
ImageEnMView1.WallPaper.LoadFromFile(extractfilepath(paramstr(0)) + 'wallpaper.bmp')
else
ImageEnMView1.WallPaper := nil;
ImageEnMView1.Update;
end;
// Show text
procedure TForm1.chkShowTextClick(Sender: TObject);
begin
ImageEnMView1.ShowText := chkShowText.Checked;
end;
// Show Preview
procedure TForm1.chkShowPreviewClick(Sender: TObject);
begin
ImageEnView1.Visible := chkShowPreview.Checked;
Splitter1.Visible := chkShowPreview.Checked;
Splitter1.Left := ImageEnView1.Width;
UpdatePreview;
end;
// Sorting handler
function xcompare(i1, i2: integer): integer;
var
s1, s2: integer;
begin
with Form1.ImageEnMView1 do
begin
s1 := ImageOriginalWidth[i1] * ImageOriginalHeight[i1];
s2 := ImageOriginalWidth[i2] * ImageOriginalHeight[i2];
end;
if s1 < s2 then
result := -1
else if s1 > s2 then
result := 1
else
result := 0;
end;
// Sort By Dimensions
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
tempIO: TImageEnIO;
begin
// ImageEn loads images only when them are needed. So we have to all fill image properties before sort.
tempIO := TImageEnIO.Create(nil);
for i := 0 to ImageEnMView1.ImageCount-1 do
begin
tempIO.ParamsFromFile( ImageEnMView1.ImageFileName[i] );
ImageEnMView1.MIO.Params[i].Assign( tempIO.Params );
end;
tempIO.free;
ImageEnMView1.Sort(xcompare);
end;
procedure TForm1.chkAutoRotateClick(Sender: TObject);
begin
ImageEnMView1.EnableAdjustOrientation := chkAutoRotate.checked;
end;
// Show filename in hover hint
procedure TForm1.ImageEnMView1MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var
idx: integer;
begin
idx := ImageEnMView1.ImageAtPos(x, y);
if ImageEnMView1.Hint <> ImageEnMView1.ImageFileName[idx] then
begin
Application.CancelHint;
ImageEnMView1.Hint := ImageEnMView1.ImageFileName[idx];
end;
end;
// Output debug info
procedure TForm1.DebugTimerTimer(Sender: TObject);
begin
label3.caption := inttostr(ImageEnMView1.JobsRunning);
label4.caption := inttostr(ImageEnMView1.JobsWaiting);
end;
// look ahead (load next N non visible images)
procedure TForm1.chkLookAheadClick(Sender: TObject);
begin
if chkLookAhead.Checked then
begin
ImageEnMView1.LookAhead := 15;
ImageEnMView1.Update;
end
else
ImageEnMView1.LookAhead := 0;
end;
procedure TForm1.chkExplorerColorsClick(Sender: TObject);
const
Explorer_Selection_Background_Color = $00FCEADA;
Explorer_Selection_Border_Color = $00CEA27D;
begin
if chkExplorerColors.checked then
begin
ImageEnMView1.Background := clWindow;
ImageEnMView1.ThumbnailsBackground := clWindow;
ImageEnMView1.ThumbnailsBackgroundSelected := Explorer_Selection_Background_Color;
ImageEnMView1.SelectionColor := Explorer_Selection_Border_Color;
end
else
begin
ImageEnMView1.Background := clBtnFace;
ImageEnMView1.ThumbnailsBackground := clBtnFace;
ImageEnMView1.ThumbnailsBackgroundSelected := clBtnFace;
ImageEnMView1.SelectionColor := clRed;
end;
end;
// Use thumbnails stored in EXIF data when available
procedure TForm1.chkLoadEXIFThumbsClick(Sender: TObject);
begin
ImageEnMView1.EnableLoadEXIFThumbnails := chkLoadEXIFThumbs.checked;
end;
// Adjust zoom
procedure TForm1.edtZoomChange(Sender: TObject);
var
iZoom: Integer;
begin
try
iZoom := StrToInt(edtZoom.Text);
Except
edtZoom.Text := '100';
iZoom := 100;
end;
// For zooming ietNormal will give better performance
if (iZoom <> 100) and (ImageEnMView1.StoreType = ietThumb) then
begin
ImageEnMView1.StoreType := ietNormal;
// Reload all thumbs
DirectoryListBox1Change(nil);
end;
ImageEnMView1.Zoom := iZoom;
end;
// Load full size preview
procedure TForm1.UpdatePreview;
begin
if chkShowPreview.Checked and (ImageEnMView1.SelectedImage >= 0) then
ImageEnView1.io.LoadFromFile(ImageEnMView1.ImageFileName[ImageEnMView1.SelectedImage])
else
ImageEnView1.Blank;
end;
end.