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

← →
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) - Нужно ли это после использования удалять и как?

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

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

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

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

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

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