Почему неиспользуемый код влияет на работу программы !?

← →
dmk (2003-12-07 13:06) [0]

Есть процедура отрисовки клиентской части окна
(Далее см. середину кода)

procedure TImageForm.RepaintByParts(x,y:Integer; DrawType:cardinal);
var
lWidth,lHeight: Integer;
xCounter,yCounter: Integer;
xParts,yParts: Integer;
vpX,vpY: Integer;
StayInX,StayInY: Integer;
fTop,fLeft: Integer;
//...
HiddenDC: HDC;
PS: TPaintStruct;
CubeLen: Integer;

begin
if FDestroyed or (not FInited) then Exit;
If not FCanDraw then Exit;

If FPainterExecuted then
begin
FPainter.StopPainting;
FPainterExecuted := False;
end;

_Thread_DC := RepaintDC;
_Thread_x := x;
_Thread_y := y;
_Thread_dt := DrawType;
_Thread_vp := vp;

FPainter.Priority := tpHighest;
FPainter.RunPainting;
FPainterExecuted := True;
FPainter.Execute;

FJustRepainted := True;
DrawCropLines;
SetPreviewCoords;

Exit;
Если все после Exit(вместе с Exit) удалить !!!!!!!,
то процедура отрисовки начинает
тормозить как будто
FPainter.Priority = tpLowest;
Код вынесенный в поток тот, что после
Exit; !!!! :( Где может быть проблема???
Может кто встречался с подобным?

//......................

CubeLen := 256;

//...
If x < 0 then x := 0;
If y < 0 then y := 0;

//...
lWidth := vp.Width;
lHeight := vp.Height;

//...
xParts := (lWidth div CubeLen);
yParts := (lHeight div CubeLen);

//...
If (lWidth mod CubeLen) <> 0 then Inc(xParts);
If (lHeight mod CubeLen) <> 0 then Inc(yParts);

//...
vpX := 0;
vpY := 0;

//...
fLeft := x;
fTop := y;

//...
StayInY := lHeight;
StayInX := lWidth;

HiddenDC := 0;

///Debug !!!
//Caption := "Paint in " + IntToStr(np) + " time";
//Inc(Np);

With Regions do
begin

If DrawType = dtRepaintDBuffer then HiddenDC := BeginPaint(Handle,PS);

For yCounter := 0 to yParts - 1 do
begin
//...
srcRegion.Top := vpY + fTop;

//...
If StayInY >= CubeLen
then srcRegion.Height := CubeLen
else srcRegion.Height := StayInY;

//...
For xCounter := 0 to xParts - 1 do
begin
srcRegion.Left := vpX + fLeft;

//...
If StayInX >= CubeLen
then srcRegion.Width := CubeLen
else srcRegion.Width := StayInX;

//...
destRegion.Left := vpX;
destRegion.Top := vpY;
destRegion.Width := srcRegion.Width;
destRegion.Height := srcRegion.Height;

//...
FImageStream.NeedFullRGBRegion(srcRegion, RepaintBuffer, destRegion);

//...
If DrawType = dtRepaintDBuffer then
begin
BitBlt(HiddenDC,
vp.Left + vpX + FRulesSize,
vp.Top + vpY + FRulesSize,
srcRegion.Width,
srcRegion.Height,
RepaintBuffer.dbMemDC,
vpX,
vpY,
SRCCOPY);
end
else
begin
BitBlt(RepaintDC,
vp.Left + vpX,
vp.Top + vpY,
srcRegion.Width,
srcRegion.Height,
RepaintBuffer.dbMemDC,
vpX,
vpY,
SRCCOPY);
end;
//...
Inc(vpX, srcRegion.Width);
Dec(StayInX, srcRegion.Width);
end;//X

//...
Inc(vpY,srcRegion.Height);
vpX := 0;
StayInX := lWidth;
Dec(StayInY,srcRegion.Height);
end;//Y
//.............................
If DrawType = dtRepaintDBuffer then EndPaint(Handle,PS);

end;//With

end;

← →
Digitman (2003-12-07 13:14) [1]

что такое FPainter ? это что, объект-наследник TThread ?

← →
Anatoly Podgoretsky (2003-12-07 13:16) [2]

У тебя Дельфи есть, если есть, то используй отладчик

← →
dmk (2003-12-07 14:29) [3]

>что такое FPainter ? это что, объект-наследник TThread ?
Да.

type
TWinPainter = class(TThread)
private
{ Private declarations }
FPaintingStopped: Boolean;
procedure RepaintWnd(RepaintDC: HDC; x,y: Integer; vp:TRegion; DrawType:DWord);

protected
constructor Create(CreateSuspended: Boolean);
procedure Execute; override;
procedure StopPainting;
Procedure RunPainting;
end;
{ TWinPainter }

>У тебя Дельфи есть, если есть, то используй отладчик
Если вы Анатолий про встроенный, то я им всегда пользуюсь.
Код работат без проблем. Но начинает тормозить когда
удаляешь весь код после вызова Exit.
Вот я и удивился. Что может быть? Ни с одним потоком ранее
таких глюков не было. Мне неохота было удалять этот код. Вот
я и поставил Exit. А когда удалил - стали наблюдаться тормоза.
Если код оставить, то все в порядке!!!!! Но это же не нормально!
Да! Если это поможет, то RepaintByParts вызывается по сообщению
WM_MOUSEMOVE.
Логика проста. При зажатой кнопке мыши происходит прокрутка
изображения. Если происходит сдвиг:
1. Вызываем в потоке перерисовку содержимого окна.
2. В прорисовке проверяем изображение на сдвиг, т.е
если во время прорисовки произошел вызов процедуры
прорисовки, то останавливаем прорисовку и начинаем
ее заново.

Бред какой-то! Я за"Rem"ил этот код, тоже все Ok.
Как его удаляешь!!!!, начинаются тормоза. Причем этот код
никогда не вызывается!!!!

← →
dmk (2003-12-07 14:32) [4]

И еще вопрос.
Почему после остановки потока(Terminate)
и повторного запуска(Execute) свойство Terminated
остается True??? Из за этого пришлось
ввести свои дополнительные переменные.

← →
Digitman (2003-12-07 14:46) [5]

созданный тобой класс-наследник TThread ты используешь неправильно. отсюда и все проблемы - из-за непонимания логики работы класса TThread.

читай мануалы, статьи и пр.

← →
dmk (2003-12-07 14:56) [6]

Где неправильно????
Если не трогать приоритеты, то получается тоже самое.
Я собственно и вынес прорисовку в поток, чтобы от
остального не зависело.
Раньше было тоже самое, но без потока.
Просто по сообщению WM_MOUSEMOVE вызывалась
процедура прорисовки. И к тому же, почему все работает
если этот кусок кода остается???????????????

← →
Digitman (2003-12-07 14:59) [7]

> Я собственно и вынес прорисовку в поток

не знаю уж куда ты ее "выносил", но вот эта строчка

FPainter.Execute;

зачем ?

← →
Digitman (2003-12-07 15:03) [8]

с какого перепугу ты решил, что вызов некоего метода некоего объекта приведет к исполнению кго тела в доп.код.потоке ?

← →
dmk (2003-12-07 15:22) [9]

>с какого перепугу ты решил
Поверьте, я не пугался =)

А взял я это из примера по дельфи TThreads.
Если не выполнить этот метод, то код в потоке вообще не
запустится =)

Provides an abstract method that contains the code which executes when the thread is run.

procedure Execute; virtual; abstract;

Description

Override Execute and insert the code that should be executed when the thread runs. Execute is responsible for checking the value of the Terminated property to determine if the thread needs to exit.

A thread executes when Create is called if CreateSuspended set to False, or when Resume is first called after the thread is created if CreateSuspended set to True.

Note: Do not use the properties and methods of other objects directly in the Execute method of a thread. Instead, separate the use of other objects into a separate procedure call, and call that procedure by passing it as a parameter to the Synchronize method.

← →
Digitman (2003-12-07 15:26) [10]

> А взял я это из примера по дельфи TThreads

нет там такого.
и быть не может.
не выдумывай.

к тому же по поводу метода Execute тебе черным по белому в хелпе написано :

> should be executed when the thread runs

← →
dmk (2003-12-07 15:52) [11]

>Если не выполнить этот метод, то код в потоке вообще не
>запустится =)
И не запустится потому, что вызов процедуры прорисовки
происходит именно в Execute; Так же как и в примере.

Да! А ошибку я нашел.
У меня ширина окна неправильно передавалась потоку.
В итоге процедура рисовала окно гораздо большей ширины.
Тут и задержка была.

>should be executed when the thread runs
Необязательно. Все зависит от логики программы.
У меня в большинстве случаев он простаивает.
И когда стоит - приоритет у него tpIdle.
Т.е. если процедуре прорисовки удается
полностью прорисовать окно, то поток останавливается.
А в момент следующего вызова устанавливается нужный
приоритет и выполняется новая прорисовка.

Да и кипятиться не стоит =) Особенно мастеру.

← →
Digitman (2003-12-07 15:56) [12]

> И не запустится потому, что вызов процедуры прорисовки
> происходит именно в Execute; Так же как и в примере.

нет такого примера.
метод Execute вызывается в контексте поточной ф-ции АВТОМАТИЧЕСКИ

← →
Digitman (2003-12-07 15:57) [13]

и стартует этот метод, согласно хэлпу:

...when Create is called if CreateSuspended set to False, or when Resume is first called after the thread is created if CreateSuspended set to True.

← →
Digitman (2003-12-07 16:00) [14]

покажи мне пример, где ЯВНО вызывается метод Execute)

← →
dmk (2003-12-07 16:19) [15]

Взято из примера

procedure TSortThread.Execute;
begin
Sort(Slice(FSortArray^, FSize));
end;

Вот мой код:

Constructor TWinPainter.Create(CreateSuspended: Boolean);
begin
FPaintingStopped := CreateSuspended;
Inherited Create(CreateSuspended);
end;

procedure TWinPainter.Execute;
begin
RepaintWnd(_Thread_DC, _Thread_x, _Thread_y, _Thread_Vp, _Thread_dt);
end;

Procedure TWinPainter.StopPainting;
begin
FPaintingStopped := True;
end;

Procedure TWinPainter.RunPainting;
begin
FPaintingStopped := False;
end;

procedure TWinPainter.RepaintWnd(RepaintDC: HDC; x,y: Integer; vp:TRegion; DrawType:DWord);
var
FWidth,FHeight: Integer;
xCounter,yCounter: Integer;
xParts,yParts: Integer;
vpX,vpY: Integer;
StayInX,StayInY: Integer;
fTop,fLeft: Integer;
//Debug code!
//dv: TRegion;
//...
HiddenDC: HDC;
PS: TPaintStruct;
CubeLen: Integer;
FRulesSize: Integer;

begin
If FPaintingStopped then Exit;
If Terminated then Exit;

FRulesSize := ImageForm.FRulesSize;

//Размер стороны квадрата для отрисовки
CubeLen := 256;

//...
If x < 0 then x := 0;
If y < 0 then y := 0;

//...
FWidth := vp.Width;
FHeight := vp.Height;

//Кол-во частей по X и Y
xParts := (FWidth div CubeLen);
yParts := (FHeight div CubeLen);

//...
If (FWidth mod CubeLen) <> 0 then Inc(xParts);
If (FHeight mod CubeLen) <> 0 then Inc(yParts);

//...
vpX := 0;
vpY := 0;

//...
fLeft := x;
fTop := y;

//...
StayInY := FHeight;
StayInX := FWidth;

HiddenDC := 0;

//Debug !!!
//Caption := "Paint in " + IntToStr(np) + " time";
//Inc(Np);

With Regions do
begin

If DrawType = dtRepaintDBuffer then HiddenDC := BeginPaint(ActiveWnd,PS);

For yCounter := 0 to yParts - 1 do
begin
//...
srcRegion.Top := vpY + fTop;

//...
If StayInY >= CubeLen
then srcRegion.Height := CubeLen
else srcRegion.Height := StayInY;

//...
For xCounter := 0 to xParts - 1 do
begin
srcRegion.Left := vpX + fLeft;

//...
If StayInX >= CubeLen
then srcRegion.Width := CubeLen
else srcRegion.Width := StayInX;

//...
destRegion.Left := vpX;
destRegion.Top := vpY;
destRegion.Width := srcRegion.Width;
destRegion.Height := srcRegion.Height;

//...
ActiveImage.NeedFullRGBRegion(srcRegion, RepaintBuffer, destRegion);

//...
If DrawType = dtRepaintDBuffer then
begin
BitBlt(HiddenDC,
vp.Left + vpX + FRulesSize,
vp.Top + vpY + FRulesSize,
srcRegion.Width,
srcRegion.Height,
RepaintBuffer.dbMemDC,
vpX,
vpY,
SRCCOPY);
end
else
begin
BitBlt(RepaintDC,
vp.Left + vpX,
vp.Top + vpY,
srcRegion.Width,
srcRegion.Height,
RepaintBuffer.dbMemDC,
vpX,
vpY,
SRCCOPY);
end;
//...
Inc(vpX, srcRegion.Width);
Dec(StayInX, srcRegion.Width);

If FPaintingStopped then
begin
If DrawType = dtRepaintDBuffer then EndPaint(ActiveWnd, PS);
Exit;
end;

If Terminated then
begin
If DrawType = dtRepaintDBuffer then EndPaint(ActiveWnd, PS);
Exit;
end;

end;//X

//...
Inc(vpY,srcRegion.Height);
vpX := 0;
StayInX := FWidth;
Dec(StayInY,srcRegion.Height);
end;//Y
//.............................
If DrawType = dtRepaintDBuffer then EndPaint(ActiveWnd, PS);
end;//With

Self.Priority := tpNormal;
end;

и вызов:
procedure TImageForm.RepaintByParts(x,y:Integer; DrawType:cardinal);
begin
if FDestroyed or (not FInited) then Exit;
If not FCanDraw then Exit;

//Debug code!
//Inc(PCounter);
//Caption := IntToStr(PCounter);

If FPainterExecuted then
begin
FPainter.StopPainting;
FPainterExecuted := False;
end;

_Thread_DC := RepaintDC;
_Thread_x := x;
_Thread_y := y;
_Thread_dt := DrawType;
_Thread_vp := vp;

FPainterExecuted := True;
FPainter.Priority := tpHighest;
FPainter.RunPainting;
FPainter.Execute;

FJustRepainted := True;
DrawCropLines;
SetPreviewCoords;
end;

Почему неиспользуемый код влияет на работу программы !? Найти похожие ветки