Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "KOL";
Текущий архив: 2003.05.08;
Скачать: [xml.tar.bz2];

Вниз

Утечка ресурсов: Откуда ??   Найти похожие ветки 

 
SPeller   (2002-07-28 16:50) [0]

Всем доброго времени суток. Пишу на KOL свой UpDown компонент на основе виндового. Но мне его внешний вид не нравится, поэтому отрисовываю вручную. Так вот, после пол-минуты щёлканья по нему и соответствующей перерисовки системные ресурсы падают пости до нуля, и иногда вылазит окошко "Используется 90% системных ресурсов....". Загружена только Дельфи, больше ничего. При закрытии моей проги ресурсы вроде восстанавливаются, но чуть мень чем затратилось, и поэтому со временем время, в течении которого можно щёлкать по контролу уменьшается.


Вот мой код:

Отлавливаю перерисовку контрола замещением оконной процедуры:

function NewLBLUpDown(AParent:PControl; Left,Top,Width,Height,Min,Max:Integer; Visible:Boolean):PLBLUpDown;
var
p:PLBLUpDown;
begin
New(P, create);
AParent.Add2AutoFree(P);
...
P.fUpDown:=_NewCommonControl(P.fPanel, UPDOWN_CLASS,UDS_SETBUDDYINT or UDS_ARROWKEYS or WS_CHILD or Visible2Style[Visible],False,0);
P.fUpDown.CreateWindow;
InitCommonControlCommonNotify(P.fUpDown);

...

p.fOldWP:=GetWindowLong(p.fUpDown.Handle,GWL_WNDPROC);
p.fNewWP:=Longint(MakeObjectInstance(p.WndProcControl));
SetWindowLong(p.fUpDown.Handle,GWL_WNDPROC,p.fNewWP);

...

Result:=P;
end;


Сама оконная процедура такова:

procedure TLBLUpDown.WndProcControl(var Msg:TMessage);
begin
if msg.Msg=WM_PAINT then begin
DrawUpDown;
msg.Result:=1;
exit;
end;
msg.Result:=CallWindowProc(pointer(fOldWP),fUpDown.Handle,msg.Msg,msg.WParam,msg.LParam);
end;


Процедура отрисовки:

procedure TLBLUpDown.DrawUpDown;
var c:PCanvas; h,w,mid:integer; r:TRect; pt:TPoint; md:boolean;
begin

c:=fUpDown.Canvas;
h:=fUpDown.Height;
w:=fUpDown.Width;
GetCursorPos(pt);
ScreenToClient(fUpDown.Handle,pt);
md:=(GetKeyState(VK_LBUTTON) and $8000)<>0;
mid:=round(h/2);

if (pt.Y<mid)and(md) then begin
c.Pen.Color:=clBtnShadow;
c.Rectangle(0,0,w,mid);
c.Brush.Color:=clBtnFace;
c.FillRect(Rect(1,1,w-1,mid-1));
end else begin
c.Pen.Color:=clBtnHighLight;
c.MoveTo(0,mid-1);
c.LineTo(0,0);
c.LineTo(w-1,0);
c.Pen.Color:=clBtnShadow;
c.MoveTo(w-2,0);
c.LineTo(w-2,mid-2);
c.LineTo(0,mid-2);
c.Pen.Color:=clBlack;
c.MoveTo(0,mid-1);
c.LineTo(w-1,mid-1);
c.LineTo(w-1,-1);
end;
if (pt.Y>=mid)and(md) then begin
c.Pen.Color:=clBtnShadow;
c.Rectangle(0,mid,w,h);
c.Brush.Color:=clBtnFace;
c.FillRect(Rect(1,mid+1,w-1,h-1));
end else begin
c.Pen.Color:=clBtnHighLight;
c.MoveTo(0,h-1);
c.LineTo(0,mid);
c.LineTo(w,mid);
c.Pen.Color:=clBtnShadow;
c.MoveTo(w-2,mid);
c.LineTo(w-2,h-2);
c.LineTo(-1,h-2);
c.Pen.Color:=clBlack;
c.MoveTo(0,h-1);
c.LineTo(w-1,h-1);
c.LineTo(w-1,mid-1);
end;

r:=Rect(0,0,w,h);
ValidateRect(fUpDown.Handle,@r);
end;


 
SPeller   (2002-07-28 16:52) [1]

Где грабли могут быть ??


 
Oleg_Gashev   (2002-07-28 22:47) [2]

В New(P, create);
Destroy?


 
SPeller   (2002-07-28 22:51) [3]

Дестрой я делаю. Ресурсы то съедаются не при загрузке-выгрузке приложения, а в процессе работы. В частности оконной процедуры и процедуры отрисовки контрола.


 
Oleg_Gashev   (2002-07-28 23:03) [4]

p:PLBLUpDown сделай переменной класса, а не функции.


 
BorisMor   (2002-07-29 10:19) [5]

Я конечно не потеме, но всеже... :)
У Gandalf"а есть UpDown компонент чем он не устраивает ?


 
SPeller   (2002-07-29 12:23) [6]

2 BorisMor (29.07.02 10:19)

Ху из ит? - Gandalf ?

> чем он не устраивает ?

Своё лучше, свой код легче отладить и встроить что-то новое. Плюс просто интересно ради опыта.


 
BorisMor   (2002-07-29 15:22) [7]


> Ху из ит? - Gandalf ?
http://kol.mastak.ru/files2.html



> > чем он не устраивает ?
>
> Своё лучше, свой код легче отладить и встроить что-то новое.
> Плюс просто интересно ради опыта.

Понял.


 
SPeller   (2002-07-30 03:54) [8]

2 BorisMor (29.07.02 15:22)

Он меня тоже не устраивает. Больше всего меня не устраивает в стандартном updown"е его внешний вид. С этого и началось конструирование своего. Кстати, делать я его начал взяв за небольшую основу именно компонент MHUpDown.

ЗЫ: Если б хоть кто-нить взял мой код да посмотрел что там не так?


 
Vladimir Kladov   (2002-07-30 09:58) [9]

Не надо в KOL так делать. Canvas не знает, что его вызвали по
WM_PAINT, и пытается освободить ресурсы, которые освобождать не надо.
А те ресурсы, которые надо освобождать, он как раз не освобождает.
А все потому, что Canvas знает о родителе, но в момент начала
отрисовки у родителя не установился правильно fPaintDC. Выход может быь такой. Здесь control все равно внутренний, и можно использовать его OnPaint. Если бы контрол был унаследован от TControl, я бы все равно советовал переопределить OnPaint, а для внешнего интерфейса определить свой OnPaint, который перекрыл бы OnPaint унаследованный.

И еще. MakeObjectInstance выделяет 4К памяти и никогда их не
возвращает. Если контролы создаются динамически, и помногу, то эта утечка тоже может быть опасна. Этот глюк имеет место в VCL, и я совершенно не понимаю, зачем Александр притащил его в своем
objects.pas. Для обслуживания любых других сообщений (кроме paint) лучше использовать AttachProc. Можно и WndProc оверридить.


 
SPeller   (2002-07-30 10:16) [10]

2 Vladimir Kladov (30.07.02 09:58)

> и я совершенно не понимаю, зачем Александр притащил его
> в своем objects.pas

Да не в своём, а из KOLObjects.zip. И во многих компонентах для KOL он тоже имеется и он там используется.


 
SPeller   (2002-07-30 10:57) [11]

Да, и вот ещё вопрос: Если цепляться к OnPaint, то как тогда отрисовать то что должно отрисоваться без моего вмешательства? Ведь когда назначаешь обработчик, то контрол просто полностью закрашивается цветом фона и всё, как будто говорит, мол рисуй меня сам полностью. Мне в тулбаре надо нарисовать две линии, и соответственно при обработке OnPaint вызвать отрисовку кнопок.


 
Gandalf   (2002-07-31 16:08) [12]

Азм есть Гэндальф! Я могу взять код и посмотреть.


 
SPeller   (2002-07-31 17:26) [13]

:-))) Сейчас скину вам


 
Vladimir Kladov   (2002-08-01 09:22) [14]

SPeller © (30.07.02 10:57)

> Да не в своём, а из KOLObjects.zip. И во многих компонентах
> для KOL он тоже имеется и он там используется.

Я про него и говорил. Автор objects.pas - Александр Шахайло. А идея утащена из VCL. Люди жаловались, а Борланд не реагирует. Так глюк и дожил уже до 6-й версии Delphi.


> SPeller © (30.07.02 10:57)
> Да, и вот ещё вопрос: Если цепляться к OnPaint, то как тогда
> отрисовать то что должно отрисоваться без моего вмешательства?
> Ведь когда назначаешь обработчик, то контрол просто полностью
> закрашивается цветом фона и всё, как будто говорит, мол
> рисуй меня сам полностью. Мне в тулбаре надо нарисовать
> две линии, и соответственно при обработке OnPaint вызвать
> отрисовку кнопок.


В принципе, можно вызывать обработчик по умолчанию (CallDefWndProc, или просто DefWndProc), а потом отрисовать сверху. Но будет немного мелькать. Можно попробовать DoubleBuffered=true. Тогда рисовать будет через буфер. Хотя на глюк с потерей ресурсов это не повлияет, наверное.



Страницы: 1 вся ветка

Форум: "KOL";
Текущий архив: 2003.05.08;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.49 MB
Время: 0.009 c
14-23288
Хо-Хо
2003-04-22 12:16
2003.05.08
Партия пенсионеров.


14-23317
Num Lock
2003-04-14 09:35
2003.05.08
---|Ветка была без названия|---


8-23234
CjCrazy
2003-01-30 08:57
2003.05.08
просмотр фильмов с фтп


3-22934
stone
2003-04-18 10:38
2003.05.08
Как отловить горизонтальную прокрутку в TDBGrid


3-22930
yul
2003-04-20 23:10
2003.05.08
mdb





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский