mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-03 06:38:13 +02:00
Examples, ImgViewer:
- added tiff support - fixed Windows only path error - synched some leftover debug+release build mode differences - minor fixes Patch from Reinier Olislagers with some changes, bug #23433. git-svn-id: trunk@39439 -
This commit is contained in:
parent
a2490a7283
commit
7028bcf779
@ -26,7 +26,8 @@ interface
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
LCLIntf, SysUtils, Classes, Graphics, Controls, Forms, FileUtil,
|
LCLIntf, SysUtils, Classes, Graphics, Controls, Forms, FileUtil,
|
||||||
Dialogs, StdCtrls, ComCtrls, ExtCtrls, ActnList, Menus, LCLType;
|
Dialogs, StdCtrls, ComCtrls, ExtCtrls, ActnList, Menus, LCLType,
|
||||||
|
fpreadtiff {adds TIFF format read support to TImage};
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
@ -123,7 +124,7 @@ implementation
|
|||||||
{$R *.lfm}
|
{$R *.lfm}
|
||||||
|
|
||||||
const
|
const
|
||||||
ImageTypes = '.jpg.jpeg.bmp.xpm.png';
|
ImageTypes = '|.jpg|.jpeg|.bmp|.xpm|.png';
|
||||||
|
|
||||||
resourcestring
|
resourcestring
|
||||||
SSelectImageDir = 'Select directory to add images from';
|
SSelectImageDir = 'Select directory to add images from';
|
||||||
@ -147,7 +148,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TMainForm.AddFile(FileName: string; ShowFile: boolean);
|
procedure TMainForm.AddFile(FileName: string; ShowFile: boolean);
|
||||||
|
// Adds a file to the listbox and displays it if ShowFile is true
|
||||||
var
|
var
|
||||||
Index: integer;
|
Index: integer;
|
||||||
|
|
||||||
@ -159,7 +160,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TMainForm.ShowFile(Index: integer);
|
procedure TMainForm.ShowFile(Index: integer);
|
||||||
|
// Loads file and displays it into the IMain TImage
|
||||||
var
|
var
|
||||||
LoadOK: boolean;
|
LoadOK: boolean;
|
||||||
|
|
||||||
@ -177,15 +178,18 @@ begin
|
|||||||
Imain.Stretch := false;
|
Imain.Stretch := false;
|
||||||
FImageScale := 1.0;
|
FImageScale := 1.0;
|
||||||
IMain.Picture.LoadFromFile(LBFiles.Items[Index]);
|
IMain.Picture.LoadFromFile(LBFiles.Items[Index]);
|
||||||
Caption := SImageViewer + '(' + LBFiles.Items[Index] + ')';
|
Caption := SImageViewer + ' (' + LBFiles.Items[Index] + ')';
|
||||||
LoadOK := true;
|
LoadOK := true;
|
||||||
except
|
except
|
||||||
|
// If we can't load the image, try next file unless we're at the end
|
||||||
if Index < LBFiles.Items.Count - 1 then
|
if Index < LBFiles.Items.Count - 1 then
|
||||||
Inc(Index)
|
Inc(Index)
|
||||||
else
|
else
|
||||||
Index := -1;
|
Index := -1;
|
||||||
end
|
end
|
||||||
until LoadOK or (Index = -1);
|
until LoadOK or (Index = -1);
|
||||||
|
|
||||||
|
// Now synchronize our listbox to the file we loaded:
|
||||||
with LBFiles do
|
with LBFiles do
|
||||||
begin
|
begin
|
||||||
if Index <> ItemIndex then
|
if Index <> ItemIndex then
|
||||||
@ -228,12 +232,14 @@ var
|
|||||||
Info: TSearchRec;
|
Info: TSearchRec;
|
||||||
Ext: string;
|
Ext: string;
|
||||||
begin
|
begin
|
||||||
Directory := IncludeTrailingBackslash(Directory);
|
Directory := IncludeTrailingPathDelimiter(Directory);
|
||||||
if FindFirstUTF8(Directory + '*.*', 0, Info) = 0 then
|
if FindFirstUTF8(Directory + '*.*', 0, Info) = 0 then
|
||||||
try
|
try
|
||||||
repeat
|
repeat
|
||||||
Ext := ExtractFileExt(Info.Name);
|
Ext := ExtractFileExt(Info.Name);
|
||||||
if Pos(Ext, ImageTypes) <> 0 then
|
// Support opening tiff files as well as the built-in image types.
|
||||||
|
// Note: requires fpreadtiff in the uses clause to work.
|
||||||
|
if Pos(lowercase('|'+Ext+'|'), ImageTypes+'|.tif|.tiff|') <> 0 then
|
||||||
AddFile(Directory + Info.Name, false);
|
AddFile(Directory + Info.Name, false);
|
||||||
until (FindNextUTF8(Info) <> 0)
|
until (FindNextUTF8(Info) <> 0)
|
||||||
finally
|
finally
|
||||||
|
@ -19,8 +19,12 @@
|
|||||||
<Item2 Name="debug">
|
<Item2 Name="debug">
|
||||||
<CompilerOptions>
|
<CompilerOptions>
|
||||||
<Version Value="11"/>
|
<Version Value="11"/>
|
||||||
|
<Target>
|
||||||
|
<Filename Value="imgviewer"/>
|
||||||
|
</Target>
|
||||||
<SearchPaths>
|
<SearchPaths>
|
||||||
<SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)"/>
|
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||||
|
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||||
</SearchPaths>
|
</SearchPaths>
|
||||||
<Parsing>
|
<Parsing>
|
||||||
<SyntaxOptions>
|
<SyntaxOptions>
|
||||||
|
Loading…
Reference in New Issue
Block a user