TCheckListBox OnDrawItem cannot draw my own checkbox :(

[xterro]

Hello, I'm trying to make my own checklistbox. I use both Linux and Windows. For example I have wrote OnDrawItem method for TCheckListBox:
On windows,This function works somehow strange. During filling of listbox with items, first added items text, becomes bold(why?). If fill listbox with items and afted scroll listbox then listbox fillings with black color.
But on Linux this method even doesn't call.

Code: [Select]

procedure TForm1.OnDrawItem(Control: TWinControl; Index: Integer; ARect: TRect;
State: TOwnerDrawState);
var
    CBText : String;
    CBItem : TColorCheckListItem;
    TextSize : TSize;
    TextPosY : Integer;
    PPoints : array[1..3] of TPoint;
    FCheckRectSize : Integer = 20; { by default }
    HRectIndent : Integer = 5;
    VRectIndent : Integer = 2;
    tmpBrush : TBrush;
begin
    with (Control as TCheckListBox).Canvas do begin
        //Pen.Color := clBlack;
        FCheckRectSize := Round((ARect.Bottom - ARect.Top) - 2*VRectIndent);
        tmpBrush := Brush;
        if (Index <= CheckListBox.Items.Count-1) then begin
            CBText := CheckListBox.Items.Strings[Index];
            CBItem := TColorCheckListItem(CheckListBox.Items.Objects[Index]);

            if Assigned(CBItem) then begin
                Rectangle(ARect.Left + HRectIndent, ARect.Top + VRectIndent,
                         ARect.Left + FCheckRectSize + HRectIndent, ARect.Top + FCheckRectSize + VRectIndent);
                Brush.Color := CBItem.Color;

                if(CBItem.IsChecked) then begin
                    { draw empty rectangle with small clip at left top corner }
                    PPoints[0].x := Round(ARect.Left + HRectIndent + 1);
                    PPoints[0].y := Round(ARect.Top + VRectIndent + FCheckRectSize/2);

                    PPoints[1].x := Round(ARect.Left + HRectIndent + 1);
                    PPoints[1].y := Round(ARect.Top + VRectIndent + 1);

                    PPoints[2].x := Round(ARect.Left + HRectIndent + FCheckRectSize/2);
                    PPoints[2].y := Round(ARect.Top + VRectIndent + 1);

                    Polygon(PPoints);
                    end
                else
                    { fill rect }
                    FillRect(ARect.Left + HRectIndent + 1, ARect.Top + VRectIndent + 1,
                            ARect.Left + FCheckRectSize + HRectIndent - 1, ARect.Top + FCheckRectSize + VRectIndent - 1);
            end;

            TextSize := Canvas.TextExtent(CBText);
            TextPosY := ARect.Top + Round(((ARect.Bottom - ARect.Top)/2 - TextSize.cy/2));

            if(CBItem.BoldText = True) then
                Font.Bold := True;

            Brush.Style := bsClear;
            TextOut(ARect.Left + (HRectIndent * 2) + FCheckRectSize, TextPosY, CBText);

            if (odSelected in State) then begin
                Brush.Color := clSkyBlue;
                Font.Color := clHighlightText;
                FillRect(ARect);
                DrawFocusRect(aRect);
            end
            else begin
                Brush.Color := clWindow;
                Font.Color := clWindowText;
            end;
        end;
        Brush := tmpBrush;
    end;
end;One more thing, when triggered condition: "if Assigned(CBItem)" then value of variable "FCheckRectSize" becomes equal to 6, but it must be equal to 20. I dont know why. What I'm doing wrong? I use Lazarus 1.0.14(Windows 7) and 1.0.12(Linux)
Some pictures of problem: http://freepascal.ru/forum/download/file.php?id=1584&mode=view and http://freepascal.ru/forum/download/file.php?id=1585&mode=view

[engkin]

On windows,This function works somehow strange. During filling of listbox with items, first added items text, becomes bold(why?).

You are not filling the rect which makes the text look darker every time you add a new item

If fill listbox with items and afted scroll listbox then listbox fillings with black color.

Same as the previous one. Here the background is not filled/cleared.

Here is your code with the missing call and moving a small section up:

procedure TForm1.OnDrawItem(Control: TWinControl; Index: Integer; ARect: TRect;
State: TOwnerDrawState);
var
    CBText : String;
    CBItem : TColorCheckListItem;
    TextSize : TSize;
    TextPosY : Integer;
    PPoints : array[1..3] of TPoint;
    FCheckRectSize : Integer = 20; { by default }
    HRectIndent : Integer = 5;
    VRectIndent : Integer = 2;
begin
    with (Control as TCheckListBox).Canvas do begin
        //Pen.Color := clBlack;
        //FCheckRectSize := Round((ARect.Bottom - ARect.Top) - 2*VRectIndent);
        if (Index <= CheckListBox.Items.Count-1) then begin
            CBText := CheckListBox.Items.Strings[Index];
            CBItem := TColorCheckListItem(CheckListBox.Items.Objects[Index]);

            if Assigned(CBItem) then begin
                {Rectangle(ARect.Left + HRectIndent, ARect.Top + VRectIndent,
                         ARect.Left + FCheckRectSize + HRectIndent, ARect.Top + FCheckRectSize + VRectIndent);//}
///////////////
                if (odSelected in State) then begin
                    Brush.Color := clSkyBlue;
                    Font.Color := clHighlightText;
                    FillRect(ARect);
                    DrawFocusRect(aRect);
                end
                else begin
                    Brush.Color := clWindow;
                    Font.Color := clWindowText;
                    FillRect(ARect);//<---- missing this call
                end;
///////////////
                Brush.Color := CBItem.Color;

                if(CBItem.IsChecked) then begin
                    { draw empty rectangle with small clip at left top corner }
                    PPoints[0].x := Round(ARect.Left + HRectIndent + 1);
                    PPoints[0].y := Round(ARect.Top + VRectIndent + FCheckRectSize/2);

                    PPoints[1].x := Round(ARect.Left + HRectIndent + 1);
                    PPoints[1].y := Round(ARect.Top + VRectIndent + 1);

                    PPoints[2].x := Round(ARect.Left + HRectIndent + FCheckRectSize/2);
                    PPoints[2].y := Round(ARect.Top + VRectIndent + 1);

                    Polygon(PPoints);
                    end;
                //else
                    { fill rect }
                    FillRect(ARect.Left + HRectIndent + 1, ARect.Top + VRectIndent + 1,
                            ARect.Left + FCheckRectSize + HRectIndent - 1, ARect.Top + FCheckRectSize + VRectIndent - 1);
            end;

            TextSize := Canvas.TextExtent(CBText);
            TextPosY := ARect.Top + Round(((ARect.Bottom - ARect.Top)/2 - TextSize.cy/2));

            if(CBItem.BoldText = True) then
                Font.Bold := True;

            Brush.Style := bsClear;
            TextOut(ARect.Left + (HRectIndent * 2) + FCheckRectSize, TextPosY, CBText);
        end;
    end;
end;

[xterro]

Thank you    I will try your supplements tomorrow at work,  because at home I use Linux, and here  this method "OnDrawItem" not working. It even doesn't invoke 

[howardpc]

Also to match the index values you use your PPoints array should be declared as

Code: [Select]

  PPoints: array[0..2] of TPoint;


[xterro]

Now is work fine, Thnak you By the way, on Linux this method works incorrect. Despite of I have set style as "lbOwnerDrawFixed", TCheckListBox  draws standard checkbox next to my custom checkbox.

[zeljko]

Now is work fine, Thnak you By the way, on Linux this method works incorrect. Despite of I have set style as "lbOwnerDrawFixed", TCheckListBox  draws standard checkbox next to my custom checkbox.

Linux is pretty wide term. What widgetset you use under linux ? gtk2 or qt ?

[xterro]

Gtk2