unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
procedure StreamToHexStringFile(Input: TMemoryStream; const ConstName,
FileName: string); forward;
{$R *.lfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var
aStream: TMemoryStream;
begin
aStream := TMemoryStream.Create;
Image1.Picture.SaveToStream(aStream);
StreamToHexStringFile(aStream, 'ImageData', 'IMG.TXT');
aStream.Free;
ShowMessage('The image has been exported to IMG.TXT' +LineEnding+
'You can use it in your Pascal code by copy/pasting the text' +LineEnding+
'directly or using the compiler directive {$INCLUDE filename}.');
end;
//----------------------------------------------------------------------
procedure HexStringToStream(const Input: string; Output: TMemoryStream;
OutputReturn: Boolean);
var
Bookmark: Int64;
Buffer: array of Byte;
ResultSize: Integer;
i: Integer;
begin
ResultSize := Input.Length div 2;
SetLength(Buffer, ResultSize);
HexToBin(PChar(Input), PChar(Buffer), ResultSize);
Bookmark := Output.Position;
for i := 0 to (ResultSize-1) do
Output.WriteByte(Buffer[i]);
if OutputReturn then
Output.Position := Bookmark;
end;
procedure StreamToHexStringList(Input: TMemoryStream; Output: TStringList);
var
Buffer: array[0..31] of Byte;
Remain: Integer;
Todo: Integer;
S: string;
i: Integer;
begin
Input.Seek(0, soBeginning);
Remain := Input.Size;
while (Remain > 0) do
begin
Todo := 32;
if (Remain < 32) then
Todo := Remain;
Input.ReadBuffer(Buffer, Todo);
S := '';
for i := 0 to (Todo- 1) do
S := S + IntToHex(Buffer[i], 2);
Output.Add(S);
Remain := Remain - Todo;
end;
end;
procedure StreamToHexStringFile(Input: TMemoryStream; const ConstName,
FileName: string);
var
Buffer: TStringList;
S: string;
i: Integer;
begin
Buffer := TStringList.Create;
StreamToHexStringList(Input, Buffer);
with Buffer do
begin
for i := 0 to (Count-1) do
begin
S := ' ' + '''' + Strings[i] + '''';
case (i < Count-1) of
True: S := S + '+';
False: S := S + ';';
end;
Buffer[i] := S;
end;
if (Count >= 0) then
begin
Insert(0, ' ' + ConstName + ' = ');
Insert(0, 'const');
SaveToFile(FileName);
end;
Free;
end;
end;
end.