|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
#1
|
|||
|
|||
Долго строится картинка попиксельно
Здравствуйте, уважаемые форумчане!
Помогите, пожалуйста, решить следующую проблему: Я загружаю любой файл в программу, преобразовываю его в 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. |
#2
|
||||
|
||||
Canvas.Pixels[x,y] как и все средства GDI медленно работает. Думаю проблема в этом.
Попробуйте это - Graphics32 00110001 00101100 00110110 00110001 00111000 00110000 00110011 00110011 00111001 00111000 00111000 00110111 00110100 00111001 00111000 00111001 00110100 00111000 00110100 00111000 00110010 00110000 00110100 00110101 00111000 00110110 00111000 00110011 00110100 00110011 00110110 00110101 00110110 Последний раз редактировалось ~TB~, 31.05.2011 в 22:28. |
#3
|
|||
|
|||
Блин, очень глупо с моей стороны также было попиксельно сохранять картинку в файл. Вынес "Image1.Picture.SaveToFile('c:\test.bmp');" за цикл - теперь те же, к примеру, 5,5 Мб обрабатываются и на выходе сохраняются в картинку за 12-15 секунд. Уже неплохо, возможно, и достаточно, но да - хотелось бы ещё быстрее, думаю это возможно как-то
~TB~, покопаюсь, спасибо за наводку! |
#4
|
||||
|
||||
Как вариант: не работай со стринг...
|
#5
|
|||
|
|||
Цитата:
А что оптимальнее будет использовать? |
#6
|
||||
|
||||
Цитата:
В твоем случае стоит попытаться переписать под байты. Хотя, опять же: нужно смотреть. |
#7
|
|||
|
|||
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; Последний раз редактировалось lmikle, 31.05.2011 в 23:56. |
#8
|
||||
|
||||
Вот вариант ~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; If end Then begin; |
#9
|
|||
|
|||
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. Картинка с такой длиной и высотой для пользователя, конечно, не самый лучший вариант. У этого числа только два таких простых множителя, другого разложения на множители нет. Выходит, в таких случаях лучше будет, нпаример, дописать ещё один любой пиксель? Он будет не заметен на общей картинке, но тогда длина и ширина более "человечные" получатся. |