ListBox custom draw problem

[BubikolRamios]

As per attached image (Two paralel list boxes, with db table data), I don't get how right ListBox items gets shifted down only by lbOwnerDrawFixed an the following code:

Code: Pascal  [Select][+][-]

1. procedure TForm1.ListBoxDrawItem(Control: TWinControl;
2.   Index: Integer; ARect: TRect; State: TOwnerDrawState);
3. var
4.   aColor: TColor;                       //Background color
5. begin
6.   aColor:=$EEEEFF;
7.   ListBox.Canvas.Brush.Color:=aColor;  //Set background color
8.   ListBox.Canvas.FillRect(ARect);      //Draw a filled rectangle
9.   ListBox.Canvas.TextRect(ARect, 0, ARect.Top, ListBox.Items[Index]);  //Draw Itemtext
10. end;
11.  

[Thaddy]

You have to subtract 1 from every member of Arect.

[BubikolRamios]

Don't see what that means.
If you ment ARect.Top-1, that does not work.

[Thaddy]

No, the Arect should be shrunk as a whole: left+1, top+1,right-1, bottom-1....

[BubikolRamios]

See what you mean, and rect shrinks indeed:

Code: Pascal  [Select][+][-]

1. procedure TForm1.ListBoxDrawItem(Control: TWinControl;
2.   Index: Integer; ARect: TRect; State: TOwnerDrawState);
3. var
4.   aColor: TColor;                       //Background color
5. begin
6.   ARect.Top:=ARect.Top+1;
7.   ARect.Left:=ARect.Left+1;
8.   ARect.Right:=ARect.Right-1;
9.   ARect.Bottom:=ARect.Bottom-1;
10.   aColor:=$EEEEFF;
11.   ListBox.Canvas.Brush.Color:=aColor;  //Set background color
12.   ListBox.Canvas.FillRect(ARect);      //Draw a filled rectangle
13.   ListBox.Canvas.TextRect(ARect, 0, ARect.Top, ListBox.Items[Index]);  //Draw Itemtext
14. end;
15.  

But instead, compared to upper attached image there are now like 1 px white spaces inbetween and around right listbox items (expected result I guess), alltogether shifted down same as on upper attached image.
Editing last line of code with ARect.Top-1 or  ARect.Top-2 or ... does not corect a thing.

Note also that cumulative "shift down" grows with number of items, around 20 items - thing is shifted down for about whole item height.

[Blaazen]

And is the ItemHeight property same for both listboxes?

EDIT: I mean at runtime.

[BubikolRamios]

Yes.

Edit: It is default all the time, not changed at run time.

[Thaddy]

leave the left and top alone, just the bottom and maybe right.

But what I really meant is: the COLOR rect is ok. Just Shrink the TEXTRECT by one.

[BubikolRamios]

But what I really meant is: the COLOR rect is ok. Just Shrink the TEXTRECT by one.

Nope, if I do only:

Code: Pascal  [Select][+][-]

1. ListBox.Canvas.FillRect(ARect);
2. //and comment out
3. //ListBox.Canvas.TextRect(....
4.  

I get only colored stuff, with no text. And I can see shift down is there.
So the probem is ARect that comes in as it is, hence creating extra TRect for .Canvas.TextRect and shrinking only that, any of dimensions or all, does not change a thing, tested that too.

EDIT: shrinking original ARect does not make any change towards nicely leveled left/right list box items as they are without  lbOwnerDrawFixed.
That moves items around a bit but with no perspective to be leveled ever.

[Blaazen]

I looked to code of ECImageMenu of ECControls and I have this line in constructor (based on my testing in Wine):

Code: Pascal  [Select][+][-]

1. Style := lbOwnerDrawVariable;  { because of Win32 - it doesn't like lbOwnerDrawFixed }

So try to switch to lbOwnerDrawVariable. Also, you can assign OnMeasureItem event to set proper ItemHeight there.

[lainz]

Or try to override the painting in the other one so both get shift down 

[BubikolRamios]

lbOwnerDrawVariable

does not help.

Or try to override the painting in the other one so both get shift down

That is good idea, but if there are multiple ListBox-es that is a pain to keep in mind & do unnecesary programing.
Anyway, lost my patience, switched to ListView, that should hopefuly work ...

[engkin]

When a ListBox control is created, its ItemHeight is zero.

Based on ListBox.Style:

lbStandard: ItemHeight value is calculated and is *not* related to FItemHeight making it a read only property:

Code: Pascal  [Select][+][-]

1. //\lcl\include\customlistbox.inc
2. function TCustomListBox.GetItemHeight: Integer;
3. begin
4.   if HandleAllocated and (Style = lbStandard) then
5.   begin
6.     with ItemRect(TopIndex) do
7.       Result := Bottom - Top;

lbOwnerDrawFixed: The system requests the height by sending WM_MeasureItem message once. If FItemHeight is zero, the value passed by the system is used. The problem this value is not identical to the value used in lbStandard as the system does not know about the font and its height, yet:

The system sends the WM_MEASUREITEM message to the owner window of combo boxes and list boxes created with the OWNERDRAWFIXED style before sending the WM_INITDIALOG message. As a result, when the owner receives this message, the system has not yet determined the height and width of the font used in the control; function calls and calculations requiring these values should occur in the main function of the application or library.

This is the code involved:

Code: Pascal  [Select][+][-]

1. procedure TCustomListBox.LMMeasureItem(var TheMessage: TLMMeasureItem);
2. var
3.   AHeight: Integer;
4. begin
5.   with TheMessage.MeasureItemStruct^ do
6.   begin
7.     if Self.ItemHeight <> 0 then
8.       AHeight := Self.ItemHeight
9.     else
10.       AHeight := ItemHeight;  //<--- ItemHeight of MeasureItemStruct^ where the wrong value is
11.     MeasureItem(Integer(ItemId), AHeight);
12.     if AHeight > 0 then
13.       ItemHeight := AHeight; //<--- ItemHeight of MeasureItemStruct^
14.   end;
15. end;

ItemHeight passed in MeasureItemStruct^ has the value 20 on my system.