Скачать: CL | DM;

[Глюк] Прорисовка контролов в левом верхнем углу   Найти похожие ветки 

← →
skillcoder ©   (2006-09-17 21:13) [0]

Из-за обработки события onDrawItem объекта TKOLListView после некоторого промежутка работы программы, скорее всего после некоторого количества прорисовок ListView"a некоторые контролы, например
Те что обновляются по таймеру, начинают вместо положеных им на форме мест рисоватся в левом верхнем углу экрана, даже TKOLEditBox (он также по таймеру обновляется).

Я так понимаю у меня функция отрисовки гдето протикает.

Вот её код:


function TMainForm.GalaxyListDrawItem(Sender: PObj; DC: HDC;
 const Rect: TRect; ItemIdx: Integer; DrawAction: TDrawAction;
 ItemState: TDrawState): Boolean;
var
 Data: PData;
 R, Rr, Rchk, Rrr: TRect;
 cl, clb, clGrid: TColor;
 OldBkMode: Integer;
 txt: String;
 i: Integer;
 FirstShift: Integer;
 ChkWidth: Integer;
 TempFont, Font: HFont;
begin
 FirstShift:=0;
 ChkWidth:=2;
 Data := PData (PControl (Sender).lvItemData [ItemIdx]);
 if not Assigned (Data) or (Data = nil) or (PControl (Sender).Count <= 0) then
   Exit;
 Font:=CreateFont(-2, 3, 0, 0,
                          FW_NORMAL, 0, 0, 0, 1, OUT_DEFAULT_PRECIS,
                          CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, "MS Sans Serif");

 R := PControl (Sender).LVItemRect(ItemIdx, lvupIconAndLabel);

 Rr:=R;
 if odsSelected in ItemState then
   clb := Data.SelectBgColor
 else
   clb := Data.BgColor;
 FillRect (DC, Rr, CreateSolidBrush (clb));

 clGrid := PControl(Sender).canvas.pen.color;
 PControl(Sender).Canvas.pen.color := cl3DLight;
 PControl(Sender).Canvas.RectAngle(R.Left,R.Top,R.Right+1,R.Bottom);
 PControl(Sender).Canvas.pen.color := clGrid;

 if (lvoCheckBoxes in PControl (Sender).LVOptions) then
 begin
   FirstShift:=15;
   cl := PControl(Sender).Canvas.Pen.Color;
   PControl(Sender).Canvas.Pen.Color := clBlack;
   Rchk:= MakeRect(R.Left+3,R.Top+2,R.Left+FirstShift,R.Top+14);
   FillRect(DC,Rchk,CreateSolidBrush (clBlack));
   PControl(Sender).Canvas.Pen.Color := clBlack;
   Rchk:= MakeRect(R.Left+3+ChkWidth,R.Top+2+ChkWidth,R.Left+FirstShift-ChkWidth,R.Top+14-ChkWidth);
   FillRect(DC,Rchk,CreateSolidBrush (clWhite));
   if Data.Checked then
   begin
     clb:=SetTextColor (DC, clRed);
     TempFont:=Windows.CreateFont(20, 20, GM_COMPATIBLE, 0, FW_NORMAL, 0, 0, 0, DEFAULT_CHARSET
                   ,OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH
                   ,"WebDings");
     SelectObject (DC, TempFont);
     txt:= chr(97);
     Rchk:= MakeRect(R.Left,R.Top-3,R.Left+FirstShift,R.Bottom);
     OldBkMode := SetBkMode (DC, TRANSPARENT);
     DrawText (DC, @ txt [1], -1, Rchk, DT_LEFT or DT_VCENTER);
     SetBkMode (DC, OldBkMode);
     SetTextColor (DC, clb);
   end;
   PControl(Sender).Canvas.Pen.Color := cl;
 end;
 Rr.Left:=R.Left+FirstShift+3;

 if odsSelected in ItemState then
   cl := Data.SelectColor
 else
   cl := Data.Color;

 SelectObject (DC, Font);

 SetTextColor (DC, cl);
 OldBkMode := SetBkMode (DC, TRANSPARENT);
 DrawText (DC, @ Data.Text [1], Length (Data.Text), Rr, DT_LEFT or DT_VCENTER);
 for i:=1 to PControl(Sender).LVColCount do
 begin
   txt:= PControl(Sender).LVItems[ItemIdx,i];
   R.Left := R.Left+PControl(Sender).LVColWidth[i-1];
   R.Right := R.Left+PControl(Sender).LVColWidth[i];
   Rrr:=MakeRect (R.Left+5 , R.Top,  R.Right-5, R.Bottom);
   clGrid := PControl(Sender).canvas.pen.color;
   PControl(Sender).Canvas.pen.color := cl3DLight;
   PControl(Sender).Canvas.RectAngle(R.Left,R.Top,R.Right+1,R.Bottom);
   PControl(Sender).Canvas.pen.color := clGrid;
   SelectObject (DC, Font);
   SetBkMode (DC, TRANSPARENT);
   DrawText (DC, @ txt [1], Length (txt), Rrr, DT_LEFT or DT_VCENTER);
 end;
 Rrr:=Rr;
 Rrr.Left:=Rrr.Left-1;
 Rrr.Top:=Rrr.Top;
 Rrr.Right:=Rrr.Right-1;
 Rrr.Bottom:=Rrr.Bottom-1;
 if odsSelected in ItemState then
   DrawFocusRect (DC, Rrr);
 SetBkMode (DC, OldBkMode);
end;



Помогите пожалуйста избавится от бага

---

← →
MTsv DN ©   (2006-09-18 10:15) [1]

>  Data: PData;
Для начала, думаю, разъясни, что за PData...

А затем:
1. Последней строчкой: Result:= True;
2. DeleteObject() для Шрифта и Кисти тоже неплохо было бы сделать...
это навскидку, не компилируя...

С Уважением MTsv DN

---

← →
skillcoder ©   (2006-09-18 20:06) [2]


type
 PData = ^TData;
 TData = packed record
   Text: String;
   Color: TColor;
   BgColor: TColor;
   SelectColor: TColor;
   SelectBgColor: TColor;
   Checked: Boolean;
 end;


---

← →
skillcoder ©   (2006-09-18 20:19) [3]

Шрифты я удаляю, а вот как кисти удалить?, ведь я их не создаю

---

← →
skillcoder ©   (2006-09-18 21:29) [4]

Точно проблема была именно в утечке.
Т.е. Нужно после зоздания удалять всё :)

Только подскажите как удалить кисти, ато баг всёравно остаётся, только теперь пропадет прорисовка фона, но всё рисуется где нужно.

У меня остались 2 вопроса:
1. Где в моём коде создаются кисти и Как их удалять?
2. CreateSolidBrush (clWhite) - Нужно ли это после использования удалять и как?

---

← →
MTsv DN ©   (2006-09-18 22:53) [5]

> Шрифты я удаляю, а вот как кисти удалить?, ведь я их не создаю
Как это не создаете??? А это по Вашему что???
FillRect(DC, Rchk, CreateSolidBrush (clWhite));

У себя я делал так:
var
Brush : HBrush;
...
Brush := CreateSolidBrush (clWhite);
FillRect(DC,Rchk,Brush);
DeleteObject(Brush);

С Уважением MTsv DN

---

← →
Vladimyr ©   (2006-09-20 16:24) [6]

На 98 Винде такое бывает, если использовать канву.
Заменил канву на DC - и всё стало нормально.

(Только на 98! На других ОС всё ОК.)

---

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

Скачать: CL | DM;



Память: 0.47 MB
Время: 0.012 c