{$mode objfpc}{$h+}
uses fpreadgif, fpreadpng, fpreadbmp, fpreadjpeg, fpimage, classes, sysutils, Crt;
var img : TFPMemoryImage;
ReadFile : string;
pixel : TFPColor;
x, y:integer;
ratioX, ratioY:integer;
procedure Init;
begin
ReadFile := ParamStr(1);
img := TFPMemoryImage.Create(0,0);
end;
procedure ReadImage;
const
pattern:array [0..15] of char = ('#','#','@','@','%','%',';',';','*','*',',',',','.','.',' ',' ');
var
r, g, b:byte;
newPix: integer;
readerClass: TFPCustomImageReaderClass;
reader: TFPCustomImageReader;
stream: TStream;
begin
if FileExists(ReadFile) then
begin
stream := TFileStream.Create(ReadFile, fmOpenRead + fmShareDenyNone);
try
stream.Position := 0;
readerClass := TFPCustomImage.FindHandlerFromStream(stream).Reader;
if Assigned(readerClass) then begin
reader := readerClass.Create;
try
img.LoadFromStream(stream, reader);
finally
reader.Free;
end;
ratioY := img.Height div 30;
ratioX := img.Width div 90;
y:=0;
x:=0;
begin
begin
pixel := img.Colors[x,y];
r := (pixel.Red shr 8) and $00ff;
g := (pixel.Green shr 8) and $00ff;
b := (pixel.Blue shr 8) and $00ff;
newPix := ((r shl 16) or (g shl 8) or (b)) and $00ffffff;
Write(pattern[(newPix div 1048576)]);
x:=x+ratioX;
end;
WriteLn;
x:=0;
y:=y+ratioY;
end;
end else
WriteLn('Unknown image format.');
finally
stream.Free;
end;
end
else
WriteLn (ReadFile,' file not found.');
end;
procedure Dipose;
begin
Img.Free;
end;
begin
if (ParamCount=0) then
begin
WriteLn('img2asc ,developed by bookhanming@outlook.my and Lazarus forum members');
WriteLn('Generate ASCII art from image file.');
WriteLn;
WriteLn('img2asc <image filename>');
end
else
try
Init;
ReadImage;
Dipose;
except
on e : exception do
writeln ('Error: ',e.message);
end;
WriteLn('Press Enter to quit...');
ReadLn;
end.
Recent
