[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.

[~TB~]

Canvas.Pixels[x,y] как и все средства GDI медленно работает. Думаю проблема в этом.

Попробуйте это - Graphics32

[Cramol]

Блин, очень глупо с моей стороны также было попиксельно сохранять картинку в файл. Вынес "Image1.Picture.SaveToFile('c:\test.bmp');" за цикл - теперь те же, к примеру, 5,5 Мб обрабатываются и на выходе сохраняются в картинку за 12-15 секунд. Уже неплохо, возможно, и достаточно, но да - хотелось бы ещё быстрее, думаю это возможно как-то

~TB~, покопаюсь, спасибо за наводку!

[Konrad]

Как вариант: не работай со стринг...

[Cramol]

Сообщение от Konrad

Как вариант: не работай со стринг...

А что оптимальнее будет использовать?

[Konrad]

Сообщение от Cramol

А что оптимальнее будет использовать?

Смотря для чего...

В твоем случае стоит попытаться переписать под байты.

Хотя, опять же: нужно смотреть.

[lmikle]

ScanLine. Самый быстрый из нативных способов.
Еще быстрее только если через API строить картинку сразу в памяти а потом еще переделать в битмап. Но оно сложно и тебе не нужно. ScanLine'а должно хватить.

Ну и зачем делать какие-то преобразования. открываешь файл как бинарник и вычитываешь 3 байта. Из них формируешь цвет, т.к. компьютеру все-равно в каком виде это будет в середине. Ему выжны собственно значения, так что никаких преобразований не надо.

Код:

var
  Stream : TFileStream;
  r, g, b : Byte;
  c : TColor;
begin
  Stream := TFileStream.Create(...);
  ...
  Stream.ReadBuffer(r,SizeOf(Byte));  
  Stream.ReadBuffer(g,SizeOf(Byte));
  Stream.ReadBuffer(b,SizeOf(Byte));
  c := RGBToColor(r,g,b);
  ...
end;

[AND_REY]

Вот вариант ~50мб за пару сек. рисует:

Код:

procedure TForm1.Button2Click(Sender: TObject);
Type
 TRGB = Record
   B,G,R: Byte;
  end;
 PRGBLine = ^TRGBLine;
 TRGBLine = Array [0..65535] of TRGB;
Var
 F: TFileStream;
 Bmp: TBitmap;
 Line: PRGBLine;
 R, j: Integer;
begin
 if OpenDialog1.Execute Then
  F:= TFileStream.Create(OpenDialog1.FileName, fmOpenRead) Else Exit;
 Bmp:= TBitmap.Create;
 Bmp.PixelFormat:= pf24bit;
 if (F.Size Mod 3) = 0 Then R:= (F.Size Div 3)
  Else R:= (F.Size Div 3) + 1 ;
 Bmp.Width:= Round(Sqrt(R));
 Bmp.Height:= Bmp.Width;
 if (Bmp.Width*Bmp.Height) < R Then Bmp.Height:= Bmp.Height + 1;
 For j:= 0 To Bmp.Height - 1 Do
  begin
   Line:= Bmp.ScanLine[j];
   F.Read(Line^, Bmp.Width*3);
  end;
 Image1.Canvas.Draw(0, 0, Bmp);
 Bmp.SaveToFile('c:\test.bmp');
 Bmp.Free;
 F.Free;
end;

[Cramol]

AND_REY, действительно - скорость практически мгновенная даже на больших файлах! Идеально! Спасибо огромное!

Ребят, а ещё один вопрос. Скажите, как лучше реализовать (по какой формуле, что ли) следующее:
Вот строится картинка. Кол-во её пикселей составляет 480.000. В идеале соотношение сторон будет 800х600.
Если сделать вот так:

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
 Z, W, H, I: integer;
begin
 H := 0;
 W := 0;
 Z := StrToInt(Edit1.Text);
 for I := Trunc(Sqrt(Z)) downto 1 do
 begin
   H := I;
   W := Z div H;
   if W * H = Z then
     break
 end;
 ShowMessage(Format('W = %d, H = %d', [W, H]))
end;

...то, в принципе, все нормально - 750x640 тоже будет смотреться, скажем так, "наглядно" для человека.
Но вот проблема: если число пикселей будет 480.001, то остается лишь один вариант - 12973х37. Картинка с такой длиной и высотой для пользователя, конечно, не самый лучший вариант. У этого числа только два таких простых множителя, другого разложения на множители нет.
Выходит, в таких случаях лучше будет, нпаример, дописать ещё один любой пиксель? Он будет не заметен на общей картинке, но тогда длина и ширина более "человечные" получатся.