paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 21:29:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

* expanded the test programs

Browse Source
This commit is contained in:
luk 2003-10-16 22:04:22 +00:00
parent 0f8b5d1a45
commit 8a4c312509
1 changed files with 63 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
fcl/image/imgconv.pp
View File

@ -16,21 +16,40 @@
{$mode objfpc}{$h+} {$mode objfpc}{$h+}
program ImgConv; program ImgConv;
uses FPImage, FPWriteXPM, FPWritePNG, FPReadXPM, FPReadPNG, sysutils; {_$define UseFile}
uses FPImage, FPWriteXPM, FPWritePNG, FPReadXPM, FPReadPNG,
{$ifndef UseFile}classes,{$endif}
sysutils;
var img : TFPMemoryImage; var img : TFPMemoryImage;
reader : TFPCustomImageReader; reader : TFPCustomImageReader;
Writer : TFPCustomimageWriter; Writer : TFPCustomimageWriter;
ReadFile, WriteFile, WriteOptions : string;
procedure Init; procedure Init;
var t : char; var t : char;
begin begin
T := upcase (paramstr(1)[1]); if paramcount = 4 then
if T = 'X' then begin
Reader := TFPReaderXPM.Create T := upcase (paramstr(1)[1]);
if T = 'X' then
Reader := TFPReaderXPM.Create
else
Reader := TFPReaderPNG.Create;
ReadFile := paramstr(2);
WriteOptions := paramstr(3);
WriteFile := paramstr(4);
end
else else
Reader := TFPReaderPNG.Create; begin
T := upcase (paramstr(3)[1]); Reader := nil;
ReadFile := paramstr(1);
WriteOptions := paramstr(2);
WriteFile := paramstr(3);
end;
WriteOptions := uppercase (writeoptions);
T := WriteOptions[1];
if T = 'X' then if T = 'X' then
Writer := TFPWriterXPM.Create Writer := TFPWriterXPM.Create
else else
@ -39,14 +58,33 @@ begin
end; end;
procedure ReadImage; procedure ReadImage;
{$ifndef UseFile}var str : TStream;{$endif}
begin begin
img.LoadFromFile (paramstr(2), Reader); if assigned (reader) then
img.LoadFromFile (ReadFile, Reader)
else
{$ifdef UseFile}
img.LoadFromFile (ReadFile);
{$else}
if fileexists (ReadFile) then
begin
str := TFileStream.create (ReadFile,fmOpenRead);
try
img.loadFromStream (str);
finally
str.Free;
end;
end
else
writeln ('File ',readfile,' doesn''t exists!');
{$endif}
end; end;
procedure WriteImage; procedure WriteImage;
var t : string; var t : string;
begin begin
t := UpperCase(paramstr(3)); t := WriteOptions;
writeln (' WriteImage, options=',t);
if (t[1] = 'P') then if (t[1] = 'P') then
with (Writer as TFPWriterPNG) do with (Writer as TFPWriterPNG) do
begin begin
@ -58,11 +96,15 @@ begin
' - WordSized ',WordSized,' - UseAlpha ',UseAlpha); ' - WordSized ',WordSized,' - UseAlpha ',UseAlpha);
end end
else if (t[1] = 'X') then else if (t[1] = 'X') then
begin
if length(t) > 1 then
with (Writer as TFPWriterXPM) do with (Writer as TFPWriterXPM) do
begin begin
ColorCharSize := ord(t[2]) - ord('0'); ColorCharSize := ord(t[2]) - ord('0');
end; end;
img.SaveToFile (paramstr(4), Writer); end;
writeln ('Options checked, now writing...');
img.SaveToFile (WriteFile, Writer);
end; end;
procedure Clean; procedure Clean;
@ -73,22 +115,29 @@ begin
end; end;
begin begin
if paramcount <> 4 then if (paramcount <> 4) and (paramcount <> 3) then
begin begin
writeln ('Give filename to read and to write, preceded by filetype:'); writeln ('Give filename to read and to write, preceded by filetype:');
writeln ('X for XPM, P for PNG'); writeln ('X for XPM, P for PNG');
writeln ('example: imgconv X hello.xpm P hello.png'); writeln ('example: imgconv X hello.xpm P hello.png');
writeln (' The PNG has settings when writing: G : grayscale,'); writeln ('example: imgconv hello.xpm P hello.png');
writeln (' A : use alpha, I : Indexed in palette, W : Word sized.'); writeln ('Options for');
writeln (' PNG : G : grayscale, A : use alpha, ');
writeln (' I : Indexed in palette, W : Word sized.');
writeln (' XPM : Number of chars to use for 1 pixel');
writeln (' The color size of an XPM can be set after the X as 1,2,3 or 4'); writeln (' The color size of an XPM can be set after the X as 1,2,3 or 4');
writeln ('example: imgconv X hello.xpm PIA hello.png'); writeln ('example: imgconv hello.xpm PIA hello.png');
writeln ('example: imgconv P hello.png X2 hello.xpm'); writeln ('example: imgconv hello.png X2 hello.xpm');
end end
else else
try try
writeln ('Initing');
Init; Init;
writeln ('Reading image');
ReadImage; ReadImage;
writeln ('Writeing image');
WriteImage; WriteImage;
writeln ('Clean up');
Clean; Clean;
except except
on e : exception do on e : exception do