Использую для отображения хода загрузки второй поток, в котором написано примерно следующее...
/// ThreadMainProcedure ///
repeat
state = not state
CopyToPrimarySurface(At_x,At_y, BackBuffer[state]);
until false;
///////////////////////////
т.е. происходит смена изображения на экране по аналогии с Flip , только Flip тут не подходит из-за
оконного режима. Типа получается в результате мерцание надписи Loading...
Проблемы начинаются при перетаскивании окна во время загрузки...т.к. нужно менять At_x,At_y и делать
их = СlientRect.x, y
пробовал делать так:
TMyThread.SetScreen;
begin
At_x = MyForm.ClientRect.x
At_x = MyForm.ClientRect.y
end;
и в цикле перед копированием вставлять
Syncronize(SetScreen);
но при этом поток виснет... на экран ничего не копируется.
Самое интересное, что даже если процедуру SetScreen сделать пустой,
то все равно виснет на вызове Syncronize
Основная проблема также в том что когда грузяться ресурсы не обрабатываются сообщения в программе.
Сделать именно загрузку ресурсов в другом потоке — получается не очень успешно, т.к. некоторые вещи
начинают очень странно работать, похоже проблемы с синхронизацией.
Внутри загрузки интенсивно используются объекты TJpegImage, TBitmap, IDirectDrawSurface. В некоторых
случаях результирующая картинка получается порченой, cлетают шрифты при использовании объекта TFont.
При работе в основном потоке все загружается нормально.
Cоотв. самый простой способ — оставить загрузку в основном потоке а индикатор в доп. процесс,
но тут начинаются траблы с тем что окно не обрабатывает сообщения , вставил Application.ProcessMessages,
начали сыпаться эксепшены...acc. viol., и нет возможности менять значения переменных At_x,At_y. Которые
должны соотв. коорд левого верхего угла формы.
Но хотелось бы сделать загрузку в доп. потоке а индикатор менять уже в цикле сообщений основного потока,
тогда остается один вопрос — как пофиксить порчу информации при работе с выше перечисленными объектами ...
Наверняка кто-то уже это все делал, так что пишите буду очень благодарен за разъяснения, т.к. чувствую
что в каком-то месте туплю
.
Вот сделал пример кода который не работает. Т.е. изображение в памяти не будет соотв. изображению в файле
test.bmp. (test.bmp класть в тот же каталог где exe файл ).
Картинку лучше сделать чернобелой...чтобы легче было сравнивать.
Но если сделать загрузку ( вызвать LoadRes ) из основного потока, то все будет ок.
TMyThread = class(TThread)
procedure Execute; override;
end;
var
Form1: TForm1;
load_thread:TMyThread;
// Указатель на память в которую будут загружаться ресурсы.
mem:pointer = nil;
// Состояние загрузки , 1-идет загрузка, >2 - загрузка окончена
loading_state:byte=0;
// Ширина и Высота картинки изпользуемой при загрузке
w,h:integer;
implementation
{$R *.DFM}
procedure LoadRes;
var
bmp:TBitmap;
i,j:integer;
begin
bmp:=TBitmap.Create; bmp.LoadFromFile('test.bmp');
// запоминаем ширину и высоту
w:=bmp.Width; h:=bmp.Height;
// выделяем один раз память.
if mem = nil then mem:=allocmem(bmp.Width*bmp.Height);
// заполняем память
for i:=0 to bmp.Width-1 do for j:=0 to bmp.Height-1 do
if bmp.Canvas.Pixels[i,j]<>clBlack then PByte(Integer(mem)+j*bmp.Width+i)^:=1
else PByte(Integer(mem)+j*bmp.Width+i)^:=0;
bmp.Free;
end;
procedure TMyThread.Execute;
var
i:integer;
begin
loading_state:=1; // помечаем начало загрузки
for i:=0 to 20 do LoadRes; // несколько раз чтобы помедленее было.
loading_state:=2; // конец загрузки
end;
procedure TForm1.ApplicationEvents1Idle(Sender: TObject;
var Done: Boolean);
begin
Done:=false;
Label1.Visible:=(loading_state=1); // Делаем метку 'Loading...' видимой если идет загрузка
Tag:=1-Tag;
Label1.Color:=RGB(Tag*255,0,0); // меняем по очереди цвет лэйбла с красного на черный...
if Loading_State=2 then FormPaint(Sender); // как только загрузка окончена, выводим результат на форму
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// Запускаем поток для загрузки
loading_state:=0;
load_thread:=TMyThread.Create(false);
end;
procedure TForm1.FormPaint(Sender: TObject);
var
i,j:integer;
begin
if loading_state>=2 then begin
{ Разкомментировать для проверки что в основном потоке все грузиться ок. }
// if loading_state=2 then LoadRes;
loading_state:=3; // чтобы не грузить каждый раз при перерисовке окна, а также
// запретить вызовы OnPaint из цикла в OnIdle;
// Делаем размер формы = размеру картинки
Width:=w; Height:=h;
// Выводим на форму содержимое памяти.
for i:=0 to w-1 do for j:=0 to h-1 do
if PByte(Integer(mem)+i+j*w)^=0 then Canvas.Pixels[i,j]:=clBlack
else Canvas.Pixels[i,j]:=clWhite;
end;
end;
Здравствуйте, PavZ, Вы писали:
PZ>Исходник:
PZ>http://jdm.narod.ru/TestThread.zip
PZ>(Delphi 5)
При работе с Canvas из thread-а надо его "лочить"
bmp.Canvas.Lock;
try
for i:=0 to bmp.Width-1 do
for j:=0 to bmp.Height-1 do
begin
if bmp.Canvas.Pixels[i,j]<>clBlack then
PByte(Integer(mem)+j*bmp.Width+i)^:=1
else
PByte(Integer(mem)+j*bmp.Width+i)^:=0;
end;
finally
bmp.Canvas.Unlock;
end;
работает медленнее, но тут уж надо оптимизировать...
Здравствуйте, PavZ, Вы писали:
PZ>Исходник:
PZ>http://jdm.narod.ru/TestThread.zip
PZ>(Delphi 5)
Попробуйте так:
// Указатель на память в которую будут загружаться ресурсы.
mem: TBitmap; //в буффер памяти копироать не нужно. т.к рисовать на форме...
// Состояние загрузки , 1-идет загрузка, >2 - загрузка окончена
loading_state: byte = 0;
// Ширина и Высота картинки изпользуемой при загрузке
w, h: integer;
implementation
{$R *.DFM}
procedure LoadRes;
var
bmp: TBitmap;
i, j: integer;
begin
bmp := tbitmap.Create;
bmp.LoadFromFile('test.bmp');
// запоминаем ширину и высоту
w := bmp.Width;
h := bmp.Height;
// выделяем один раз память.
//освободим в FormDestroy
if mem = nil then
begin
mem := TBitmap.Create;
mem.Height := bmp.Height;
mem.Width := bmp.Width;
mem.PixelFormat := bmp.PixelFormat;
end;
// заполняем память
bmp.Canvas.Lock;
mem.Canvas.Lock;
try
mem.Canvas.Draw(0,0,bmp);//это вместо копировния в массив байт.
finally
mem.Canvas.UnLock;
bmp.Canvas.UnLock;
end;
bmp.Free;
end;
procedure TMyThread.Execute;
var
i: integer;
begin
loading_state := 1; // помечаем начало загрузки
for i := 0 to 20 do LoadRes; // несколько раз чтобы помедленее было.
loading_state := 2; // конец загрузки
end;
procedure TForm1.ApplicationEvents1Idle(Sender: TObject;
var Done: boolean);
begin
Done := False;
Label1.Visible := (loading_state = 1);
// Делаем метку 'Loading...' видимой если идет загрузка
// По идее можно рисовать прямо на канве формы...
Tag := 1 - Tag;
Label1.Color := RGB(Tag * 255,0,0);
// меняем по очереди цвет лэйбла с красного на черный...
if Loading_State = 2 then
begin
// Делаем размер формы = размеру картинки
Width := w;
Height := h;
FormPaint(Sender);
end;
// как только загрузка окончена, выводим результат на форму
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// Запускаем поток для загрузки
loading_state := 0;
load_thread := TMyThread.Create(False);
end;
procedure TForm1.FormPaint(Sender: TObject);
var
i, j: integer;
begin
if loading_state >= 2 then
begin
{ Разкомментировать для проверки что в основном потоке все грузиться ок. }
// if loading_state=2 then LoadRes;
loading_state := 3; // чтобы не грузить каждый раз при перерисовке окна, а также
// запретить вызовы OnPaint из цикла в OnIdle;
// Выводим на форму содержимое памяти.
Canvas.Draw(0,0,mem);
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(mem);
end;
... << RSDN@Home 1.1 beta 1 >>
