[Cramol]

Здравствуйте, уважаемые форумчане!
Помогите, пожалуйста, решить следующую проблему:
Я загружаю любой файл в программу, преобразовываю его в HEX-вид, делю на HEX-триады ($FFFFFF, $FFAACC и т.д.), а потом строю из всего этого квадратную картинку, после чего сохраняю в файл.
Все бы хорошо, но если размер загружаемого >50 Кб, то программа виснет. Да и вообще - медленно все работает. Подгружаемые файлы предусматриваются не более 10 Мб.
Подскажите, пожалуйста, правильное написание кода. Сейчас использую так:

Код:

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ExtCtrls, math, ComCtrls;

type
 TForm1 = class(TForm)
   OpenDialog1: TOpenDialog;
   Image1: TImage;
   Button4: TButton;
   redt1: TRichEdit;
   procedure Button4Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

function StreamToHex(Buf: TStream): string;
const
Convert: array[0..15] of Char = '0123456789ABCDEF';
var
i, p: integer;
B: byte;
begin
SetLength(Result, Buf.Size * 2);
p := Buf.Position;
Buf.Position := 0;
for i := 1 to Buf.Size do
begin
Buf.Read(B, 1);
Result[(i * 2) - 1] := Convert[B shr $4];
Result[(i * 2)] := Convert[B and $F];
end;
Buf.Position := p;
end;

procedure TForm1.Button4Click(Sender: TObject);
const
Convert: array[0..15] of Char = '0123456789ABCDEF';
var
i, p, r: integer;
B: byte;
str: string;

w,h, x,y: integer;
Stream: TFileStream;
color: tcolor;
begin
if OpenDialog1.Execute then
Stream := TFileStream.Create(OpenDialog1.FileName, fmOpenRead);

Stream.Seek(0,soFromBeginning);
redt1.Text:= StreamTohex(Stream);
Stream.Position :=0;
r := Stream.Size;
str:='$';

h := ceil(sqrt(r/3));
w := ceil(sqrt(r/3));

Image1.Picture.Bitmap.Height := h;
Image1.Picture.Bitmap.Width := w;

x:=0;
y:=0;
for i := 1 to Stream.Size do
begin
Stream.Read(B, 1);
str := str + Convert[B shr $4] + Convert[B and $F];
if (i mod 3) = 0 then
begin
color := stringToColor(str);
Image1.Picture.Bitmap.Canvas.Pixels[x,y] := color;
inc(x);
if x>w then
begin
  x:=0;
  inc(y);
end;
str := '$';
end;
Image1.Picture.SaveToFile('c:\test.bmp');
end;
Stream.Free;
end;

end.