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:
maxim 2012-12-04 20:39:51 +00:00
parent a2490a7283
commit 7028bcf779
2 changed files with 18 additions and 8 deletions

View File

@ -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

View File

@ -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>