Recent

Author Topic: [SOLVED] ListBox AddItem(string, Object) limitations?  (Read 1717 times)

indydev

  • Jr. Member
  • **
  • Posts: 64
[SOLVED] ListBox AddItem(string, Object) limitations?
« on: September 30, 2021, 01:17:10 am »
Looking at the ColorListBox examples One can see the following use of the Items.AddObject() procedure:

Code: Pascal  [Select][+][-]
  1. procedure TForm1.ColorListBox1GetColors(Sender: TCustomColorListBox; Items: TStrings);
  2.   begin
  3.     Items.AddObject('Gold', TObject(PtrInt($00D7FF)));
  4.     Items.AddObject('Chocolate', TObject(PtrInt($1E69D2)));
  5.     Items.AddObject('Light blue', TObject(PtrInt($E6D8AD)));  
  6.   end;
  7.  

But one can do the same with a plain listbox calling the AddItem method (but you are responsible for the display):

Code: Pascal  [Select][+][-]
  1. ListBox1AddItem('Light blue', TObject(PtrInt($E6D8AD)));
  2.  

I am able to add two colors by making an Object (or record--works either way), and calling AddItem like so

Code: Pascal  [Select][+][-]
  1. TFBColor = class(TObject)
  2.      foreground: TColor;
  3.      background: TColor;
  4.    end;
  5.  
  6. //code in implementation section
  7.  
  8. procedure TForm1.AddElementToLB(const Element: String; const AColor, BColor: TColor);
  9. var
  10.       FBColor: TFBColor;
  11. begin
  12.       FBColor.foreground := AColor;
  13.       FBColor.background := BColor;
  14.       ListBox1.AddItem(Element, TObject(PtrUInt((FBColor))));
  15. end;
  16.  

However, if I add a third field to the Object I get an External SIGSEV fault in the same procedure (example below), and if I change the type to a record I get a compilation error in the AddItem call complaining that the record variable is not an Object (which I can understand, since it not attempting to add an Object like it says it is).

Code: Pascal  [Select][+][-]
  1. procedure TForm1.AddElementToLB(const Element: String; const AColor, BColor, CColor: TColor);
  2. var
  3.       FBColor: TFBColor;
  4. begin
  5.       FBColor.foreground := AColor;  // <-- ERROR SIGSEV
  6.       FBColor.background := BColor;
  7.       FBColor.ThirdColor := CColor;
  8.       ListBox1.AddItem(Element, TObject(PtrUInt((FBColor))));
  9. end;
  10.  

What I am trying to understand is why I can use a record OR an Object type if there are only two fields, and why they fail (differently) if I add a third field?

Note: I have {$mode objfpc}{$H+} and {$MODESWITCH ADVANCEDRECORDS} on.
« Last Edit: September 30, 2021, 07:33:28 pm by indydev »

indydev

  • Jr. Member
  • **
  • Posts: 64
Re: ListBox AddItem(string, Object) limitations?
« Reply #1 on: September 30, 2021, 07:22:59 am »
Ok, I see both problems now. The local variable, and the colors outstripping the space. So when the examples being used inject a color code, they are able to do so because color codes are the same size as pointers?

So to start, can I do this?

Code: Pascal  [Select][+][-]
  1. Type
  2.  
  3. TFBColor = class(TObject)
  4.      foreground: TColor;
  5.      background: TColor;
  6.    end;
  7.  
  8. PFBColor = ^TFBColor;
  9.  
  10. TFBColors = array[0..255] of PFBColor; //I'm capping the listbox to 256.
  11.  

Then as items are added, the object is created with it's pointer in the array. Or are you saying I have to have the pointer in the array point to another array[0..1] containing the foreground and background colors?

PascalDragon

  • Hero Member
  • *****
  • Posts: 5446
  • Compiler Developer
Re: ListBox AddItem(string, Object) limitations?
« Reply #2 on: September 30, 2021, 08:57:55 am »
I am able to add two colors by making an Object (or record--works either way), and calling AddItem like so

Code: Pascal  [Select][+][-]
  1. TFBColor = class(TObject)
  2.      foreground: TColor;
  3.      background: TColor;
  4.    end;
  5.  
  6. //code in implementation section
  7.  
  8. procedure TForm1.AddElementToLB(const Element: String; const AColor, BColor: TColor);
  9. var
  10.       FBColor: TFBColor;
  11. begin
  12.       FBColor.foreground := AColor;
  13.       FBColor.background := BColor;
  14.       ListBox1.AddItem(Element, TObject(PtrUInt((FBColor))));
  15. end;
  16.  

However, if I add a third field to the Object I get an External SIGSEV fault in the same procedure (example below), and if I change the type to a record I get a compilation error in the AddItem call complaining that the record variable is not an Object (which I can understand, since it not attempting to add an Object like it says it is).

If you have a class you have to instantiate it first:

Code: Pascal  [Select][+][-]
  1. FBColor := TFBColor.Create;

Without that FBColor will contain garbage and thus point to some memory area that might or might not be valid (thus for a class it's totally an incident that two colors work). For a record, if you directly cast it to PtrUInt then on 64-bit systems you can of course fit two TColor in there, cause they have a width of 32-bit each and a PtrUInt has a width of 64-bit. If you want to store larger values then you need to allocate a pointer to a TFBColor record (e.g. using New on a PFBColor variable) and pass that to the list. In both cases (class instance as well as record pointer) you need to free the class or record again once the list is destroyed.

So to start, can I do this?

Code: Pascal  [Select][+][-]
  1. Type
  2.  
  3. TFBColor = class(TObject)
  4.      foreground: TColor;
  5.      background: TColor;
  6.    end;
  7.  
  8. PFBColor = ^TFBColor;
  9.  
  10. TFBColors = array[0..255] of PFBColor; //I'm capping the listbox to 256.
  11.  

Class references already are pointers so no need to introduce a PFBColor in that case. The important point is again to instantiate it.

ASerge

  • Hero Member
  • *****
  • Posts: 2223
Re: ListBox AddItem(string, Object) limitations?
« Reply #3 on: September 30, 2021, 06:05:41 pm »
Or are you saying I have to have the pointer in the array point to another array[0..1] containing the foreground and background colors?
Use classes.
Code: Pascal  [Select][+][-]
  1. uses
  2.   Classes, SysUtils, Forms, Controls, Graphics, StdCtrls, Contnrs;
  3.  
  4. type
  5.   TForm1 = class(TForm)
  6.     Button1: TButton;
  7.     ListBox1: TListBox;
  8.     procedure Button1Click(Sender: TObject);
  9.     procedure FormCreate(Sender: TObject);
  10.     procedure FormDestroy(Sender: TObject);
  11.   private
  12.     FFreeList: TObjectList;
  13.     procedure AddElementToLB(const AElementName: string; AForeground, ABackground: TColor);
  14.   end;
  15.  
  16. var
  17.   Form1: TForm1;
  18.  
  19. implementation
  20.  
  21. {$R *.lfm}
  22.  
  23. type
  24.   TFBColor = class(TObject)
  25.   strict private
  26.     FForeground: TColor;
  27.     FBackground: TColor;
  28.   public
  29.     constructor Create(AForeground, ABackground: TColor);
  30.     property Foreground: TColor read FForeground;
  31.     property Background: TColor read FBackground;
  32.   end;
  33.  
  34. constructor TFBColor.Create(AForeground, ABackground: TColor);
  35. begin
  36.   inherited Create;
  37.   FForeground := AForeground;
  38.   FBackground := ABackground;
  39. end;
  40.  
  41. procedure TForm1.AddElementToLB(const AElementName: string; AForeground, ABackground: TColor);
  42. var
  43.   Element: TFBColor;
  44. begin;
  45.   Element := TFBColor.Create(AForeground, ABackground);
  46.   FFreeList.Add(Element);
  47.   ListBox1.AddItem(AElementName, Element);
  48. end;
  49.  
  50. procedure TForm1.Button1Click(Sender: TObject);
  51. begin
  52.   AddElementToLB('Green on blue', clGreen, clBlue);
  53.   AddElementToLB('White on navy', clWhite, clNavy);
  54. end;
  55.  
  56. procedure TForm1.FormCreate(Sender: TObject);
  57. begin
  58.   FFreeList := TObjectList.Create(True);
  59. end;
  60.  
  61. procedure TForm1.FormDestroy(Sender: TObject);
  62. begin
  63.   FFreeList.Free;
  64. end;

indydev

  • Jr. Member
  • **
  • Posts: 64
[SOLVED]ListBox AddItem(string, Object) limitations?
« Reply #4 on: September 30, 2021, 07:31:56 pm »
Thank you for the explanations and examples. I have reached success using a record this way:

Code: Pascal  [Select][+][-]
  1. type
  2.  
  3.    TFBColor = record //class(TObject)
  4.      foreground: TColor;
  5.      background: TColor;
  6.      styling: TFontStyles;
  7.    end;
  8.  
  9.    TFBColors = array[0..255] of ^TFBColor;
  10.  
  11.          { TListboxHelper }
  12.  
  13.    TListboxHelper = class helper for TListbox
  14.       procedure AddElement(const Element: String; const AColor, BColor: TColor; FStyle: TFontStyles = []);
  15.       procedure RemoveElement(Index: Integer);
  16.       function GetItemColors(Index: Integer): TFBColor;
  17.          end;
  18.  
  19. // global variables
  20.  
  21. var
  22.       Form1: TForm1;
  23.       FBColors: TFBColors;
  24.       PFBColor: ^TFBColor;
  25.  
  26. {$R *.lfm}
  27. implementation
  28.  
  29. { TListboxHelper }
  30.  
  31. procedure TListboxHelper.AddElement(const Element: String; const AColor, BColor: TColor; FStyle: TFontStyles = []);
  32. var
  33.       idx: Integer = 0;
  34. begin
  35.       New(PFBColor);
  36.       idx := Items.count;
  37.       PFBColor^.foreground := AColor;
  38.       PFBColor^.background := BColor;
  39.       PFBColor^.styling:= FStyle;
  40.       FBColors[idx] := PFBColor;
  41.       AddItem(Element, TObject(PtrUint(FBColors[idx])));
  42. end;
  43.  
  44. procedure TListboxHelper.RemoveElement(Index: Integer);
  45. begin
  46.       Items.Delete(Index);
  47.       Dispose(FBColors[Index]);
  48. end;
  49.  
  50. function TListboxHelper.GetItemColors(Index: Integer): TFBColor;
  51. begin
  52.       Result :=  TFBColor(FBColors[Index]^);
  53. end;
  54.  
  55. // then the draw function
  56.  
  57. procedure TForm1.ElementListBoxDrawItem(Control: TWinControl; Index: Integer;
  58.                         ARect: TRect; State: TOwnerDrawState);
  59. const
  60.   Offset     = 2;
  61.   AdjOffset  = 3;
  62.   ColorWidth = 28;
  63.   Tab        = 5;
  64. var
  65.   rbox: TRect;
  66.   ItemFontSize: Integer;
  67.   FillColor, PenColor, TextColor: TColor;
  68.   Colors: TFBColor;
  69.   Cnvs: TCanvas;
  70.   ListBox: TListBox;
  71.   DispText: string[5] = ' abc ';
  72. begin
  73.   if Index < 0 then
  74.     Exit;
  75.  
  76.   ListBox := Control as TListBox;
  77.   Cnvs  := ListBox.Canvas;
  78.   Colors := FBColors[Index]^;
  79.  
  80.   rbox.top := ARect.top + Offset;        
  81.   rbox.bottom := ARect.bottom - Offset;  
  82.   rbox.left := ARect.left + AdjOffset;      
  83.   rbox.right := rbox.left + ColorWidth;      
  84.  
  85.   if not(odBackgroundPainted in State) then
  86.     Cnvs.FillRect(rbox);
  87.  
  88.  
  89.   PenColor := Cnvs.Pen.Color;
  90.   FillColor := ListBox.Color;
  91.  
  92.   Cnvs.Brush.Color := Colors.background;
  93.   Cnvs.Pen.Color   := silver;
  94.   Cnvs.Font.Color  := Colors.foreground;
  95.  
  96.   Cnvs.Rectangle(BidiFlipRect(rbox, ARect, UseRightToLeftAlignment));
  97.  
  98.   ItemFontSize := Canvas.Font.Size;
  99.  
  100.   Cnvs.Font.Size:= 8;
  101.   Cnvs.Font.Style:=Colors.Styling;
  102.   Cnvs.TextOut(rbox.Left + 1, rbox.Top + AdjOffset, DispText);
  103.  
  104.   Cnvs.Brush.Color := FillColor;
  105.   Cnvs.Pen.Color := PenColor;
  106.   Cnvs.Font.Color := clWindowText;
  107.   Cnvs.Font.Size := ItemFontSize;
  108.   Cnvs.Font.Style:= [];
  109.  
  110.   rbox := ARect;
  111.   rbox.left := rbox.left + ColorWidth + Offset + Tab;
  112.  
  113.   Cnvs.TextOut(rbox.Left, rbox.Top + Offset, ElementListBox.Items[Index]);
  114.  
  115. end;  
  116.  
« Last Edit: September 30, 2021, 08:31:04 pm by indydev »

 

TinyPortal © 2005-2018