Здравствуйте, уважаемые форумчане!
Помогите, пожалуйста, решить следующую проблему:
Я загружаю любой файл в программу, преобразовываю его в 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.