Calculate any Image to Array Data

Mit dem folgenden Beispiel lassen sich alle Grafikbilder, egal welches Formats, in Array-Daten umrechnen. Es wird eine Konsole EXE erstellt, auf die dann das besagte Bild gezogen werden kann. Je größer das Bild, desto länger die Array-Daten.

Für ein z. B. 300 Kb großes Bitmap kommen dann ca. 186.000 Zeilen Array-Daten zusammen.

program AnyImgtoArray;

{$APPTYPE CONSOLE}

uses
  Windows,
  Classes,
  SysUtils;

type
  TMyByteArray = array of byte;

const
  BUFFERSIZE        = 2048;
  HEXPREFIX         = '$';
  HEXSUFFIX         = ',';

function BuffToHex(ByteArray: TMyByteArray): string;
var
  i                 : Integer;
  s                 : string;
  foo               : string;
  HexLength         : Integer;
const
  HEXSTR            = '0123456789ABCDEF';
begin
  HexLength := Length(HEXPREFIX) + 2 + Length(HEXSUFFIX);
  SetLength(foo, Length(ByteArray) * HexLength);
  for i := 0 to High(ByteArray) do
  begin
    s := HEXPREFIX + HEXSTR[((ByteArray[i] and $F0) shr 4) + 1] + HEXSTR[(ByteArray[i] and $0F) + 1] + HEXSUFFIX;
    Move(s[1], foo[i * HexLength + 1], HexLength);
  end;
  Result := foo;
end;

var
  fs                : TFileStream;
  Buffer            : TMyByteArray;
  BytesRead         : Longint;
  s                 : string;
  i, j              : Integer;
  HexLength         : Integer;
  len               : Integer;
  f                 : TextFile;
begin
  i := 0;
  SetLength(Buffer, BUFFERSIZE);

  if not FileExists(ParamStr(1)) then
  begin
    Writeln('AnyImgtoArray');
    Writeln('Coverts an icon file into a Delphi byte array.');
    Writeln;
    Writeln('Drag Image File to EXE');
    Writeln('and Convert Array Data.');
    Writeln;
    Writeln('Usage: AnyImgtoArray.exe Image File');
    Readln;
    exit;
  end;

  AssignFile(f, ChangeFileExt(ParamStr(1), '.txt'));
{$I-}
  rewrite(f);
{$I+}
  if IOResult = 0 then
  begin
    try
      fs := TFileStream.Create(ParamStr(1), fmOpenRead);
      HexLength := Length(HEXPREFIX) + 2 + Length(HEXSUFFIX);
      SetLength(s, fs.size * HexLength);
      try
        repeat
          BytesRead := fs.Read(Buffer[0], BUFFERSIZE);
          Move(BuffToHex(Buffer)[1], s[i * (HexLength * BUFFERSIZE) + 1], HexLength * BytesRead);
          Inc(i);
        until BytesRead < BUFFERSIZE;
        Delete(s, 1, 88);
        for i := 1 to length(s) do
        begin
          if i mod 80 = 0 then
          begin
            j := i;
            while s[j - 1] <> ',' do
              Inc(j);
            Insert(#13#10, s, j);
          end;
        end;
        len := -1;
        for i := 1 to length(s) do
          if s[i] = '$' then
            Inc(len);
        Delete(s, length(s), 1);
        WriteLn(f, 'IconByteArray: array[0..' + IntToStr(len) + '] of Byte = (' + #13#10 + s + ');');
        CloseFile(f);
      finally
        FreeAndNil(fs);
      end;
    except
      on E: Exception do
      begin
        Writeln(E.Message);
        ReadLn;
      end;
    end;
  end
  else
  begin
    Writeln(SysErrorMessage(GetLastError));
    Readln;
  end;
end.