PHP DM Gate v0.9 » Оптимизация создания визуализации из спец. файла <span class="vd">[D7, WinXP]</span>

Festil (13.02.10 20:44) [0]

Из текстового файла считывается информация для создания на дисплее изображения с оттенками серого.
В текстовом файле содержится матрица из чисел, представляющие собой численные значение яркости. 1024 столбцов, 768 строк. [ch1,' ',ch2,' ',ch3,' '...]и тд для каждой строки. (ff)
1024х768.bmp содержит чистый холст размером 1024*768, для уменьшения действий по созданию bmp.
Image сначала использует холст, а потом на него попиксельно накладываются точки из такого спец файла.

Внизу приведен код. Но так как его реализация занимает большое количество времени ищу пути по улучшению быстродействия. Тк в основной программе нужно будет отображать такие же спец файлы через каждую секунду (притом что их ох как много)

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

const
ax=1024;
bx=768;
var
Form1: TForm1;
ff:TextFile; i,j:integer;
bmp:Tbitmap;
cha:char;
ggg:integer;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
assignfile(ff,'E:\Delphi7\Копия prog4 ver1\Data\1.txt');
reset(ff);
Bmp:=TBitmap.Create;
bmp.LoadFromFile('E:\Delphi7\1024х768.bmp');
Image1.Picture.Bitmap:=bmp;
Image1.Height:=768;
Image1.Width:=1024;
for i:=0 to 767 do
begin
for j:=0 to 1023 do
begin
Read(ff,ggg,cha);
Image1.Picture.Bitmap.Canvas.Pixels[j,i]:=RGB(ggg,ggg,ggg);
end;
readln(ff);
end;
end;

<Цитата>
antonn © (13.02.10 20:51) [1]

> Если кто хочет помочь - пишите, либо указав методы по увеличению
> быстродействия,

самый очевидный - для начала воспользоваться сканлайном.

<Цитата>
Festil (13.02.10 21:04) [2]

> самый очевидный - для начала воспользоваться сканлайном.

а можно ссылку на статью?

<Цитата>
Вася (13.02.10 21:45) [3]

я уже писал в соседней теме - пишем что-то вроде "Working with ScanLine" в яндекс и всё...=))

<Цитата>
Festil (13.02.10 21:56) [4]

Вася, как я уже писал в первом посту, мне нужны дельные советы а не блуждающие тропочки.

<Цитата>
Вася (13.02.10 22:43) [5]

вы бы сначала попробовали так сделать...

а после всех операций с битмапом в TImage надо бы его обновлять - Refresh.
и тормоза вовсе не в чтении файла.

<Цитата>
Festil (13.02.10 23:25) [6]

поставил так
Read(ff,ggg,cha);
Image1.Picture.Bitmap.Canvas.Pixels[j,i]:=RGB(ggg,ggg,ggg);
Image1.Refresh;

и теперь ясно, что тормоза все-таки из-за такого грубого попиксельного принуждения.

<Цитата>
Jeer © (14.02.10 00:43) [7]

> и теперь ясно,

Хоть что-то стало ясно - тоже хорошо.
Но сканлайном давно советовали заняться.

> либо другую реализацию чтения/записи/составления этого спец
> файла.

Файл *.bmp

<Цитата>
Festil (14.02.10 14:46) [8]

спасибо за сканлайн, теперь все просто летает
VAR
i : INTEGER;
j : INTEGER;
Row: pByteArray;
bmp:Tbitmap;
f:TextFile;
ch:char;
g:Byte;
begin
bmp:=Tbitmap.Create;
bmp.LoadFromFile('C:\687.bmp');
assignfile(f,'E:\Delphi7\Копия prog4 ver1\Data\1.txt');
reset(f);
Image1.Height:=768;
Image1.Width:=1024;
FOR j := 0 TO Bmp.Height-1 DO
BEGIN
Row := Bmp.ScanLine[j];
FOR i := 0 TO Bmp.Width-1 DO
BEGIN
Read(f,g,ch);
Row[i] :=g;
END;
Readln(f);
END;
Image1.Picture.Graphic := Bmp;
end;

<Цитата>
icWasya © (19.02.10 12:13) [9]

А если не заморачиваться с файлом "чистый холст", то можно сделать так

uses UGrayPal;
...
bmp:=Tbitmap.Create;
bmp.PixelFormat:=pf8bit;
bmp.Palette :=GrayPal;
bmp.Height:=768;
bmp.Width:=1024;
...

где UGrayPal - это

unit UGrayPal;

interface
uses Windows;

function GrayPal:HPalette;
function IsGrayPal(Palette:HPalette):Boolean;
function BWPal:HPalette;OverLoad;
function BWPal(Black,White:LongWord):HPalette;OverLoad;

implementation
var MaxLogPal:TMaxLogPalette;LogPal:TLogPalette Absolute MaxLogPal;
MinLogPal:packed record
palVersion: Word;
palNumEntries: Word;
palPalEntry: array [0..1] of TPaletteEntry;
end;
_2LogPal:TLogPalette Absolute MinLogPal;

function GrayPal:HPalette;
begin
Result := CreatePalette(LogPal);
end;

function BWPal:HPalette;
begin
Result := CreatePalette(_2LogPal);
end;

function BWPal(Black,White:LongWord):HPalette;
var
MinLogPal:packed record
palVersion: Word;
palNumEntries: Word;
palPalEntry: array [0..1] of TPaletteEntry;
end;
_2LogPal:TLogPalette Absolute MinLogPal;

begin

MinLogPal.palNumEntries :=2;
MinLogPal.palVersion :=$300;
with MinLogPal.palPalEntry[1] do begin
peRed :=GetRValue(Black);
peGreen :=GetGValue(Black);
peBlue :=GetBValue(Black);
peFlags :=0;
end;
with MinLogPal.palPalEntry[0] do begin
peRed :=GetRValue(White);
peGreen :=GetGValue(White);
peBlue :=GetBValue(White);
peFlags :=0;
end;

Result := CreatePalette(_2LogPal);
end;

function IsGrayPal(Palette:HPalette):Boolean;
var
TestLogPal: TMaxLogPalette;
LogPal: TLogPalette Absolute TestLogPal;
var I: Integer;

begin
FillChar(TestLogPal,SizeOf(TestLogPal),0);
Result:=False;
GetPaletteEntries(Palette, 0, 256 ,LogPal);
for I:=0 to 255 do with TestLogPal.palPalEntry[I] do begin
if peRed <>I then Exit;
if peGreen <>I then Exit;
if peBlue <>I then Exit;
//if peFlags <>0 then Exit;
end;
Result:=True;
end;

procedure InitPal;
var I:Integer;
begin
MaxLogPal.palNumEntries :=256;
MaxLogPal.palVersion :=$300;

for I:=0 to 255 do with MaxLogPal.palPalEntry[I] do begin
peRed :=I; peGreen :=I; peBlue :=I; peFlags :=0;
end;

MinLogPal.palNumEntries :=2;
MinLogPal.palVersion :=$300;
with MinLogPal.palPalEntry[1] do begin
peRed :=0; peGreen :=0; peBlue :=0; peFlags :=0;
end;
with MinLogPal.palPalEntry[0] do begin
peRed :=255; peGreen :=255; peBlue :=255; peFlags :=0;
end;
end;

initialization
InitPal;

end.

<Цитата>
brother © (19.02.10 12:25) [10]

> if peRed <>I then Exit;
> if peGreen <>I then Exit;
> if peBlue <>I then Exit;
> //if peFlags <>0 then Exit;

улыбнуло

<Цитата>