PHP DM Gate v0.9 » TGraphicControl

homm © (04.03.07 19:32) [0]

Делаю графические контролы, обязательное требование у которых - отсутствие дрожания. Естественно для этого сделано следующее:

procedure TGRushControl.SetParent(AParent: TWinControl);
begin
if AParent<>nil then begin
AParent.DoubleBuffered := TRUE;
end;
inherited SetParent(AParent);
end;

Но тогда получается что когда я у одного контрола вызываю Invalidate, все контролы того же родителя тоже перерисовываются (вызывается их обработчик Paint). Как на старался достать область, действительно учавстующую в перерисовке API вызовами в обработчике Paint так и не удалось.

procedure TControl.InvalidateControl(IsVisible, IsOpaque: Boolean);
var Rect: TRect;
.......
begin
if (IsVisible or (csDesigning in ComponentState) and
not (csNoDesignVisible in ControlStyle)) and (Parent <> nil) and
Parent.HandleAllocated then
begin
Rect := BoundsRect; // - Вот этот рэкт мне очень нужен
InvalidateRect(Parent.Handle, @Rect, not (IsOpaque or
(csOpaque in Parent.ControlStyle) or BackgroundClipped));
end;
end;

А ведь, если я буду его знать я смогу исключить прорисовку тех контролов, которые реально все равно заклипаны вызовом BeginPaint в TWinControl.WMPaint родителя контрола, а значит их прорисовка не отображается.

Я пробовал получить злосчастный рэкт с помощью вызова GetUpdateRect(Parent.Handle, PS.rcPaint, TRUE) из Paint, но почему-то он возващает одни нули, хотя InvalidateRect, как видно из приведенного куска кода выше, вызывается с BoundsRect в качестве области инвалидирования. Такой-же эффект (нули вместо BoundsRect) получается и без использования DoubleBuffering

<Цитата>
homm © (04.03.07 23:14) [1]

Кажется понял одну вешь: После вызова BeginPaint, GetUpdateRect будет давать только пустую область, т.к. BeginPaint похоже валидатит ее.
Вопрос становится еще сложне...

<Цитата>
Макс Черных © (05.03.07 02:24) [2]

Ну а зачем такие извращения? Почему не устраивает старый, проверенный способ, при котором наследник TGraphicControl отрисовывается на битмапе в памяти, а потом через BitBlt все копируется на Canvas. DoubleBuffered так, собственно, и работает.

<Цитата>
homm © (05.03.07 07:09) [3]

> [2] Макс Черных © (05.03.07 02:24)
Подумай сам, как это может избавить от дрожания: есть 2 контрола, один частично перекрывает другой. Оба они забуферизованы предложенным тобой способом. Я делаю invalidate одного из них, при этом в область инвалидирования попадает и другой. Необходимость перерисовки становится известа родительскому контролу, он делает PaintControls, где ресуется и выводится на экран сначала первый, а затем второй контрол. Получаем еще то дрожание.

В общем мои мзыскания продвинулись вот до чего: Если я ловлю нужный мне рект непосредственно в родителе, то все происходит так как мне нужно:

unti1.pas:
procedure TForm1.WMPaint(var Message: TWMPaint);
begin
GetUpdateRect(Handle, UpdateRect, FALSE);
inherited;
end;

GRushcontrol.pas:
procedure TGRushControl.Paint;
begin
IntersectRect(rct, BoundsRect, UpdateRect);
if (IsRectEmpty(rct)=FALSE) then begin
// Рисуем здесь!!!
end;
end;

вопрос собственно как перехватить в родители WM_Paint средствами VCL. Про винапи средства (SetWindowLong) мне изсвестно.

<Цитата>
DimaBr (05.03.07 09:47) [4]

Что в вашем понятии означает "Дрожание"

<Цитата>
homm © (05.03.07 09:54) [5]

В общем, покритикуйте пожалуста мою реализацию:

const
PropWndProc:PChar = 'TWinControl_WndProc_OLD';
PropUpdateRect:PChar = 'TWinControl_UpdateRect_OLD';

function GRushWndProc(Window: HWND; Message, wParam, lParam: Longint): Longint; stdcall;
var
PrevWndProc: Pointer;
UpdateRect: PRect;
begin
if (Message = WM_PAINT) then begin
GetMem(UpdateRect, sizeof(TRect));
GetUpdateRect(Window, UpdateRect^, FALSE);
SetProp(Window, PropUpdateRect, DWORD(UpdateRect));
end;
PrevWndProc := Pointer(GetProp(Window, PropWndProc));
if PrevWndProc<>nil then
Result := CallWindowProc(PrevWndProc, Window, Message, wParam, lParam);

if (Message = WM_PAINT) then begin
FreeMem(UpdateRect);
RemoveProp(Window, PropUpdateRect);
end;
end;

procedure TGRushControl.SetParent(AParent: TWinControl);
var WinProc: DWORD;
begin
if Parent<>nil then begin
WinProc := RemoveProp(Parent.Handle, PropWndProc);;
if (WinProc<>0) then
SetWindowLong(Parent.Handle, GWL_WNDPROC, WinProc);
end;
inherited SetParent(AParent);
if Parent<>nil then with Parent do begin
DoubleBuffered := TRUE;
WinProc := GetWindowLong(Handle, GWL_WNDPROC);
if (WinProc <> DWORD(@GRushWndProc)) then begin
SetProp(Handle, PropWndProc, WinProc);
SetWindowLong(Handle, GWL_WNDPROC, DWORD(@GRushWndProc));
end;
end;
end;

procedure TGRushControl.Paint;
var
UpdateRect: PRect;
TR: TRect;
begin
UpdateRect := Pointer(GetProp(Parent.Handle, PropUpdateRect));
if UpdateRect<>nil then
IntersectRect(TR, BoundsRect, UpdateRect^);
if (IsRectEmpty(TR)=FALSE) OR (UpdateRect=nil) then begin
// рисуем, как вы догадались, здесь :)
end;
end;

вроде раболает, как в рантайм, так и в дезайне. Но может какие подвожные камни есть?

Кстати, еще вопрос: чем inherited SetParent(AParent); отличается от просто inhirated; и что в данном случае следует применять?

<Цитата>
homm © (05.03.07 09:56) [6]

> Что в вашем понятии означает "Дрожание"
когда прежде чем выводится компонент, на занимаемаемую им площадь рисуется другой или родитель, отсюда на долюсекундв, пока не прорисовался нужный компонет на занимаемой им площади отображается выведая не им картинка. я то думал что это уж совсем очевидно.

<Цитата>
DimaBr (05.03.07 10:02) [7]

Полный изврат, нафика козе баян ?
В данном случае inherited от inherited SetParent(AParent); ничем не отличаются, например реальное отличие

if тра-ля-ля
then inherited
else inherited SetParent(NewParent)

но опят же можно просто
inherited;
AParent = NewParent

а вот в такой конструкции только так
procedure SetValue(const Value: integer);
var NewValue: integer;
begin
NewValue := 123456789;
inherited SetValue(NewValue);
end;

<Цитата>
homm © (05.03.07 10:08) [8]

Так, об одном косяке уже подумал. Если кто-то поставит свой хук поверх моего, то WinProc <> DWORD(@GRushWndProc) всегдда даст TRUE, а значит я снова поставлю свой хук поверх и т.к. при этом затрется PropWndProc, то получится бесконечная рекурсия.

Выход не в проверке адресса функции GWL_WNDPROC, а в проверки наличия PropWndProc.
Вот так правильнее будет:

procedure TGRushControl.SetParent(AParent: TWinControl);
var WinProc: DWORD;
begin
if Parent<>nil then begin
WinProc := RemoveProp(Parent.Handle, PropWndProc);;
if (WinProc<>0) then
SetWindowLong(Parent.Handle, GWL_WNDPROC, WinProc);
end;
inherited SetParent(AParent);
if Parent<>nil then with Parent do begin
DoubleBuffered := TRUE;
if (GetProp(Handle, PropWndProc) = 0) then begin
WinProc := SetWindowLong(Handle, GWL_WNDPROC, DWORD(@GRushWndProc));
SetProp(Handle, PropWndProc, WinProc);
end;
end;
end;

<Цитата>
homm © (05.03.07 10:10) [9]

> Полный изврат, нафика козе баян ?
Увеличение производительности в разы при большом количестве контроллов. Что-бы вместо 40-а при движении мыши перерисовывался только один, который и изменяется при движении мыши.

<Цитата>
DimaBr (05.03.07 10:11) [10]

В этом то и отличие GraphicsControl от WinControl.
Рассмотрите внимательнее
TGraphicControl.WMPaint(var Message: TWMPaint);
TWinControl.WMPaint(var Message: TWMPaint);

<Цитата>
homm © (05.03.07 10:14) [11]

> В этом то и отличие GraphicsControl от WinControl.

Ну и отлично, и я от него избавился, кажется :)

На самом деле отличие в возможности рисовать прозрачные и полу-прозрачные компопенты, т.к. все компоненты рисуются на одной канве.

<Цитата>
DimaBr (05.03.07 10:46) [12]

В таком случае возьмите за основу WinControl

<Цитата>
homm © (05.03.07 10:49) [13]

> В таком случае возьмите за основу WinControl

я же уже ответил на этот вопрос заранее.

> На самом деле отличие в возможности рисовать прозрачные
> и полу-прозрачные компопенты, т.к. все компоненты рисуются
> на одной канве.

<Цитата>
homm © (05.03.07 10:54) [14]

Все равно фигня получалась :) При удалении однго контрола весь механизм слетал, т.к. он снимался в принципе в SetParent. Правильнее перенсти этот механизм в WM_DESTROY.

function GRushWndProc(Window: HWND; Message, wParam, lParam: Longint): Longint; stdcall;
var
PrevWndProc: Pointer;
UpdateRect: PRect;
begin
PrevWndProc := Pointer(GetProp(Window, PropWndProc));
case Message of
WM_PAINT: begin
GetMem(UpdateRect, sizeof(TRect));
GetUpdateRect(Window, UpdateRect^, FALSE);
SetProp(Window, PropUpdateRect, DWORD(UpdateRect));
end;
WM_DESTROY: begin
if PrevWndProc<>nil then begin
SetWindowLong(Window, GWL_WNDPROC, DWORD(PrevWndProc));
RemoveProp(Window, PropWndProc);
end;
end;
end;

if PrevWndProc<>nil then
Result := CallWindowProc(PrevWndProc, Window, Message, wParam, lParam);

if (Message = WM_PAINT) then begin
FreeMem(UpdateRect);
RemoveProp(Window, PropUpdateRect);
end;
end;

procedure TGRushControl.SetParent(AParent: TWinControl);
var WinProc: DWORD;
begin
inherited SetParent(AParent);
if Parent<>nil then with Parent do begin
DoubleBuffered := TRUE;
if (GetProp(Handle, PropWndProc) = 0) then begin
WinProc := SetWindowLong(Handle, GWL_WNDPROC, DWORD(@GRushWndProc));
SetProp(Handle, PropWndProc, WinProc);
end;
end;
end;

<Цитата>
DimaBr (05.03.07 11:28) [15]

прозрачные и полу-прозрачные компопенты
Эта проблема просто решается, а вот положите рядом Image и перекройте частично его Panelю. Теперь порпробуйте поднять картинкувыше панели...

<Цитата>
homm © (05.03.07 11:31) [16]

> Эта проблема просто решается
Да ну? И как интересно?

> Теперь порпробуйте поднять картинкувыше панели...
Зачем? Я и сам знаю что невозможно. Да мне это не нужно. Да и никому другому думаю не нужно.

<Цитата>
DimaBr (05.03.07 12:27) [17]

Просто
1. Сдвигаем Наш контрол в сторону (Left := -Left);
2. Даём паренту перерисоваться (Parent.Update)
3. Копируем содержимое на наш контрол по старым координатам
4. возвращаем контрол на место

<Цитата>
homm © (05.03.07 12:41) [18]

> Просто
> 1. Сдвигаем Наш контрол в сторону (Left := -Left);
> 2. Даём паренту перерисоваться (Parent.Update)
> 3. Копируем содержимое на наш контрол по старым координатам
> 4. возвращаем контрол на место
И того полностью избавляемся от дрожания??? Ну-ну..

<Цитата>
DimaBr (05.03.07 12:47) [19]

Поменяйте монитор, дрожать перестанет.

<Цитата>