I am trying to implement virtual data mode with EasyListview
From the demo :
procedure TForm1.AddItems(Count: Integer);
var
i: Integer;
begin
// Add items to the listview. Actually the items are added to the first
// group. This group is created automatically when the first item is added.
LV.BeginUpdate;
try
for i := 0 to Count - 1 do
LV.Items.AddVirtual;
finally
LV.EndUpdate;
end;
end;
procedure TForm1.LVItemGetCaption(Sender: TCustomEasyListview;
const Item: TEasyItem; Column: Integer; var Caption: WideString);
begin
case Column of
0: Caption := 'Item ' + IntToStr(Item.Index);
1: Caption := 'Detail ' + IntToStr(Item.Index);
end;
end;
If I add some items which are string :
procedure TForm1.AddItems(Count: Integer);
var
i: Integer;
begin
// Add items to the listview. Actually the items are added to the first
// group. This group is created automatically when the first item is added.
LV.BeginUpdate;
try
for i := 0 to Count - 1 do
begin
LV.Items.AddVirtual.Caption := 'DISPLAY ME ' + IntToStr(i);
end;
finally
LV.EndUpdate;
end;
end;
How to get and displaying the stored virtual caption(=string) when LVItemGetCaption is being called?
If I get the caption with Caption := LV.Items.Items[Item.Index].Caption ; then Stack overflow.
You must add your data object to the item. E.g.:
type
TMyData = class
Caption: string;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
item: TEasyItemVirtual;
MyData: TMyData;
begin
EasyListview1.BeginUpdate;
try
for i := 0 to 100 - 1 do
begin
MyData := TMyData.Create;
MyData.Caption := Format('My Item %D',[i]);
item := EasyListview1.Items.AddVirtual;
item.Data := MyData;
end;
finally
EasyListview1.EndUpdate;
end;
end;
procedure TForm1.EasyListview1ItemGetCaption(Sender: TCustomEasyListview; Item: TEasyItem;
Column: Integer; var Caption: WideString);
begin
case Column of
0: Caption := TMyData(Item.Data).Caption;
1: Caption := TMyData(Item.Data).Caption;
end;
end;
And don't forget to free your object:
procedure TForm1.EasyListview1ItemFreeing(Sender: TCustomEasyListview; Item: TEasyItem);
begin
if Assigned(Item.Data) then
Item.Data.Free;
end;
Virtual nodes are ones that don't store their data. They're just views of data you are expected to already have in some other data structure of your program. When the control needs to display a node, it asks your program what text it should use by firing the OnItemGetCaption event.
In fact, it will call the event any time it needs to know the value of the Caption property, so when you try to handle the caption-fetching event by fetching the value of the caption, you trigger infinite recursion.
Related
Short Version: Is there any way to control or modify LisBox items individually? for example set their Visible property to False separately.
I found a TListBoxItem class in Fire Monkey when I was searching, but I don't want to use Fire Monkey and want it in VCL.
Detailed Version:
I tried to filter my ListBox using two TStringList and an Edit, one StringList is global to keep the original list (list_files_global) and another StringList to help filtering procedure (list_files_filter) and my primary list of files is my ListBox (list_files).
I created my global StringList on onCreate event while program is starting to store my original list:
procedure Tfrm_main.FormCreate(Sender: TObject);
Begin
list_files_global := TStringList.Create;
list_files_global.Assign(list_files.Items);
End;
and used Edit's onChange event for filtering:
procedure Tfrm_main.edit_files_filterChange(Sender: TObject);
Var
list_files_filter: TStringList;
i: Integer;
Begin
list_files_filter := TStringList.Create;
list_files_filter.Assign(list_files.Items);
list_files.Clear;
for i := 0 to list_files_filter.Count - 1 do
if pos(edit_files_filter.text, list_files_filter[i]) > 0 then
list_files.Items.Add(list_files_filter[i]);
End;
and for switching off the filter, just recover the list from my global list that I created at first:
list_files.Items := list_files_global;
here so far, everything works just fine, but problem is when I'm trying to edit/rename/delete items from filtered list, for example I change an item:
list_files.Items[i] := '-- Changed Item --';
list will be edited, but when I switch off the filter, the original list will be back and all changes are lost.
so I want to know is there any proper way to solve this problem? Something like hiding items individually or change items visibility, etc... so I can change the filtering algorithm and get rid of all this making extra lists.
I searched the internet and looked into Delphi's help file for a whole day and nothing useful came up.
The items of a VCL listbox, List Box in the API, does not have any visibility property. The only option for not showing an item is to delete it.
You can use the control in virtual mode however, where there are no items at all. You decide what data to keep, what to display. That's LBS_NODATA window style in the API. In VCL, set the style property to lbVirtual.
Extremely simplified example follows.
Let's keep an array of records, one record per virtual item.
type
TListItem = record
FileName: string;
Visible: Boolean;
end;
TListItems = array of TListItem;
You can extend the fields as per your requirements. Visibility is one of the main concerns in the question, I added that. You'd probably add something that represents the original name so that you know what name have been changed, etc..
Have one array per listbox. This example contains one listbox.
var
ListItems: TListItems;
Better make it a field though, this is for demonstration only.
Required units.
uses
ioutils, types;
Some initialization at form creation. Empty the filter edit. Set listbox style accordingly. Fill up some file names. All items will be visible at startup.
procedure TForm1.FormCreate(Sender: TObject);
var
ListFiles: TStringDynArray;
i: Integer;
begin
ListFiles := ioutils.TDirectory.GetFiles(TDirectory.GetCurrentDirectory);
SetLength(ListItems, Length(ListFiles));
for i := 0 to High(ListItems) do begin
ListItems[i].FileName := ListFiles[i];
ListItems[i].Visible := True;
end;
ListBox1.Style := lbVirtual;
ListBox1.Count := Length(ListFiles);
Edit1.Text := '';
end;
In virtual mode the listbox is only interested in the Count property. That will arrange how many items will show, accordingly the scrollable area.
Here's the filter part, this is case sensitive.
procedure TForm1.Edit1Change(Sender: TObject);
var
Text: string;
Cnt: Integer;
i: Integer;
begin
Text := Edit1.Text;
if Text = '' then begin
for i := 0 to High(ListItems) do
ListItems[i].Visible := True;
Cnt := Length(ListItems);
end else begin
Cnt := 0;
for i := 0 to High(ListItems) do begin
ListItems[i].Visible := Pos(Text, ListItems[i].FileName) > 0;
if ListItems[i].Visible then
Inc(Cnt);
end;
end;
ListBox1.Count := Cnt;
end;
The special case in the edit's OnChange is that when the text is empty. Then all items will show. Otherwise code is from the question. Here we also keep the total number of visible items, so that we can update the listbox accordingly.
Now the only interesting part, listbox demands data.
procedure TForm1.ListBox1Data(Control: TWinControl; Index: Integer;
var Data: string);
var
VisibleIndex: Integer;
i: Integer;
begin
VisibleIndex := -1;
for i := 0 to High(ListItems) do begin
if ListItems[i].Visible then
Inc(VisibleIndex);
if VisibleIndex = Index then begin
Data := ListItems[i].FileName;
Break;
end;
end;
end;
What happens here is that the listbox requires an item to show providing its index. We loop through the master list counting visible items to find out which one matches that index, and supply its text.
This is something I often do, but with list views instead of list boxes. The basic principles are the same, though.
I tend to store the individual items as objects, which are reference types in Delphi. And I keep them all in one main unfiltered list, which owns the objects, while I maintain a filtered list (which does not own the objects) for display purposes. Like #Sertac, I combine this with a virtual list view.
To see how this works in practice, create a new VCL application and drop a list view (lvDisplay) and an edit control (eFilter) on the main form:
Notice I have added three columns to the list view control: "Name", "Age", and "Colour". I also make it virtual (OwnerData = True).
Now define the class for the individual data items:
type
TDogInfo = class
Name: string;
Age: Integer;
Color: string;
constructor Create(const AName: string; AAge: Integer; const AColor: string);
function Matches(const AText: string): Boolean;
end;
where
{ TDogInfo }
constructor TDogInfo.Create(const AName: string; AAge: Integer;
const AColor: string);
begin
Name := AName;
Age := AAge;
Color := AColor;
end;
function TDogInfo.Matches(const AText: string): Boolean;
begin
Result := ContainsText(Name, AText) or ContainsText(Age.ToString, AText) or
ContainsText(Color, AText);
end;
And let us create the unfiltered list of dogs:
TForm1 = class(TForm)
eFilter: TEdit;
lvDisplay: TListView;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FList, FFilteredList: TObjectList<TDogInfo>;
public
end;
where
function GetRandomDogName: string;
const
DogNames: array[0..5] of string = ('Buster', 'Fido', 'Pluto', 'Spot', 'Bill', 'Rover');
begin
Result := DogNames[Random(Length(DogNames))];
end;
function GetRandomDogColor: string;
const
DogColors: array[0..2] of string = ('Brown', 'Grey', 'Black');
begin
Result := DogColors[Random(Length(DogColors))];
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
begin
FList := TObjectList<TDogInfo>.Create(True); // Owns the objects
// Populate with sample data
for i := 1 to 1000 do
FList.Add(
TDogInfo.Create(GetRandomDogName, Random(15), GetRandomDogColor)
);
FFilteredList := FList;
lvDisplay.Items.Count := FFilteredList.Count;
lvDisplay.Invalidate;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if FFilteredList <> FList then
FreeAndNil(FFilteredList);
FreeAndNil(FList);
end;
The idea is that the list view control always displays the FFilteredList, which either points to the same object instance as FList, or points to a filtered (or sorted) version of it:
// The list view's OnData event handler
procedure TForm1.lvDisplayData(Sender: TObject; Item: TListItem);
begin
if FFilteredList = nil then
Exit;
if not InRange(Item.Index, 0, FFilteredList.Count - 1) then
Exit;
Item.Caption := FFilteredList[Item.Index].Name;
Item.SubItems.Add(FFilteredList[Item.Index].Age.ToString);
Item.SubItems.Add(FFilteredList[Item.Index].Color);
end;
// The edit control's OnChange handler
procedure TForm1.eFilterChange(Sender: TObject);
var
i: Integer;
begin
if string(eFilter.Text).IsEmpty then // no filter, display all items
begin
if FFilteredList <> FList then
begin
FreeAndNil(FFilteredList);
FFilteredList := FList;
end;
end
else
begin
if (FFilteredList = nil) or (FFilteredList = FList) then
FFilteredList := TObjectList<TDogInfo>.Create(False); // doesn't own the objects
FFilteredList.Clear;
for i := 0 to FList.Count - 1 do
if FList[i].Matches(eFilter.Text) then
FFilteredList.Add(FList[i]);
end;
lvDisplay.Items.Count := FFilteredList.Count;
lvDisplay.Invalidate;
end;
The result:
Notice that there always is only one in-memory object for each dog, so if you rename a dog, the changes will reflect in the list view, filtered or not. (But don't forget to invalidate it!)
On my system , the main menu is fully dynamic, is builded from data in the database.
I have a specific situation where some menu items need to be assembled before being displayed.
Let's assume that my menu has the following main items:
Files - Customer - Reports - About
When I click in Reports menu item must assemble the items before they are displayed.
I did an analysis of the code in TMainMenu, TMenu and TMenuItem class. Unfortunately I have not found a simple solution to the problem.
Exist a way to create these items before being displayed?
There is a trick you can use. You need to add one dummy TMenuItem under Reports and set its Visible property to False. Then add OnClick event to Reports item and do your populating logic there. Before you add new items you have to delete existing ones, but you should leave your dummy item intact.
Something like:
procedure TForm1.ReportItemClick(Sender: TObject);
var
Item: TMenuItem;
I: Integer;
begin
// Delete all items but first - dummy - one
for I := ReportItem.Count - 1 downto 1 do
ReportItem.Items[I].Free;
Item := TMenuItem.Create(ReportItem);
Item.Caption := 'abc';
// Item.OnClick := ...
// or
// Item.Action := ...
ReportItem.Add(Item);
Item := TMenuItem.Create(ReportItem);
Item.Caption := '123';
// Item.OnClick := ...
// or
// Item.Action := ...
ReportItem.Add(Item);
end;
Lets Suppose that you have an DS (TDataSet) how load all your data reports. And in the moment that you drop Reports Menu you can call UpdateMenuReport.
type
TMenuArray = array of TMenuItem;
var MyMenu: TMenuArray;
procedure TMain.MyClickPopupMenu(Sender: TObject);
begin
case TMenuItem(TMenuItem(Sender).Parent).Tag of
// do Something
end;
end;
procedure TMain.UpdateMenuReport;
procedure InitMyMenu(var AMenu: TMenuArray);
var i: Integer;
begin
if Length(AMenu)>0 then for i:= 0 to Length(AMenu)-1 do AMenu[i].Free;
SetLength(AMenu, 0);
end;
var j, i: integer;
begin
InitMyMenu(MyMenu);
Reports.Clear;
if DS.Active and (DS.RecordCount > 0) then
begin
SetLength(MyMenu, DS.RecordCount);
for i:= 0 to DS.RecordCount-1 do
begin
MyMenu[i] := TMenuItem.Create(Self);
MyMenu[i].Name := 'Reports_'+ IntToStr(i);
MyMenu[i].Caption := DS.FieldByname('NOM_REPORT').AsString;
MyMenu[i].Tag := DS.FieldByname('ID').AsInteger;
MyMenu[i].OnClick := MyClickPopupMenu;
end;
end;
end;
I want to know the best way to free a TList filled with record.
I have the following record:
type
TPkBill = record
PkBill: integer;
Constructor Create(c_PkBill: integer);
constructor TPkBill.Create(c_PkBill: integer);
begin
PkBill := c_PkBill;
end;
I create the list and fill it with the record:
procedure TfrmProject.lvBillDblClick(Sender: TObject);
var
i, iCount: integer;
item: TListItem;
oPkBill: TPkBill;
lstPkBill: Tlist;
begin
iCount := 0;
lstPkBill:= TList.Create;
//if an item is selected in lv
if (lvBill.ItemIndex = -1) then begin exit; end
else
begin
//Loop through all items and get selected item
for i := 0 to lvBill.Items.Count - 1 do
begin
item := lvBill.Items.Item[i];
if(item.Selected = true)then
begin
//create new item
oPkBill := TPkBill.Create(StrToInt(lvBill.Items[i].Caption));
//add it to a list
lstPkBill.Add(TObject(oPkBill));
//add up
iCount := iCount +1;
end;
end;
//Now we have a list ok pkBill
if(iCount > 1)then //other stuff I do
end
I want to be able to free the TList and also to free the record.
Here is what I already tried:
for i := 0 to lstPkBill.Count - 1 do
begin
//TObject(TPkBill(lstPkBill[i])).Free; //Acces violation at adress..
//FreeMem(TPkBill(lstPkBill[i])); //Incompatible types
//FreeMem(TObject(lstPkBill[i])); //Incompatible types
end;
lstPkBill.Clear;
FreeAndNil(lstPkBill);
Thanks you for the help, it's appreciated!
You have defined a record with a constructor. Calling a record constructor does not allocate memory on the heap, like a class constructor does. Your oPkBill variable exists on the stack. Calling oPkBill := TPkBill.Create(...) merely populates the members of that variable. You are then type-casting that entire variable (which only contains one Integer member) into a TObject pointer. You are not actually allocating any memory on the heap for the list item, so there is no need to free them.
I suspect what you were actually trying to do is something more like this:
type
PPkBill = ^TPkBill;
TPkBill = record
PkBill: integer;
Constructor Create(c_PkBill: integer);
end;
constructor TPkBill.Create(c_PkBill: integer);
begin
PkBill := c_PkBill;
end;
procedure TfrmProject.lvBillDblClick(Sender: TObject);
var
i: Integer;
item: TListItem;
oPkBill: PPkBill;
lstPkBill: TList;
begin
if lvBill.ItemIndex = -1 then Exit;
//an item is selected in lv
lstPkBill := TList.Create;
try
//Loop through all items and get selected items
for i := 0 to lvBill.Items.Count - 1 do
begin
item := lvBill.Items.Item[i];
if item.Selected then
begin
//create new item
New(oPkBill);
try
oPkBill^ := TPkBill.Create(StrToInt(lvBill.Items[i].Caption));
//add it to a list
lstPkBill.Add(oPkBill);
except
Dispose(oPkBill);
raise;
end;
end;
end;
//Now we have a list ok pkBill
if (lstPkBill.Count > 1) then
begin
//other stuff I do
end;
finally
for i := 0 to lstPkBill.Count - 1 do
Dispose(PPkBill(lstPkBill[i]));
lstPkBill.Free;
end;
end;
I have a function to update a cxGrid made with help from answers to Loop through records on a cxgrid and update a field/column
But it is sometimes acting a bit strange. If I open the form with the cxGrid and click the columnheader without doing anything else, the records are updateted OK. But if the 'selectorbar' is moved away from the top, the record marked is not updated.
I am sure it is a property that needs to be changed, but which one.
The variable fSelected is set to False at FormShow and is ther so that the user can unselect records as well.
procedure TfrmContactsSelect.colContactSelectedHeaderClick(Sender: TObject);
var
i: Integer;
Index: Integer;
BookMark : TBookMark;
Contact: variant;
begin
if fMulti = True then
begin
Screen.Cursor := crHourGlass;
fSelected := not fSelected;
BookMark := qryContacts.GetBookmark;
qryContacts.DisableControls;
try
for i := 0 to grdContactsView1.DataController.FilteredRecordCount - 1 do
begin
Index := grdContactsView1.DataController.FilteredRecordIndex[i];
Contact := grdContactsView1.DataController.Values[Index, 4];
if grdContactsView1.DataController.LocateByKey(Contact) then
begin
qryContacts.Edit;
qryContacts.FieldByName('fldcontact_selected').AsBoolean := fSelected;
qryContacts.Post;
end;
end;
finally
qryContacts.EnableControls;
qryContacts.GotoBookmark(BookMark);
qryContacts.FreeBookmark(BookMark);
end;
Screen.Cursor := crDefault;
end;
end;
Delphi XE7, DevExpress 14.2.2, UniDAC 5.5.12 for DB access
Comment:
I have ended up with the following solution based on the answer and input from MartynA
procedure TfrmContactsSelect.colContactSelectedHeaderClick(Sender: TObject);
var
i: Integer;
Index: Integer;
MarkedRecord: variant;
CurrentRecord: variant;
begin
if fMulti = True then
begin
Screen.Cursor := crHourGlass;
fSelected := not fSelected;
Index := grdContactsView1.DataController.FocusedRecordIndex;
MarkedRecord := grdContactsView1.DataController.Values[Index, colContactGuid.ID];
try
for i := 0 to grdContactsView1.DataController.FilteredRecordCount - 1 do
begin
Index := grdContactsView1.DataController.FilteredRecordIndex[i];
CurrentRecord := grdContactsView1.DataController.Values[Index, colContactGuid.ID];
if grdContactsView1.DataController.LocateByKey(CurrentRecord) then
begin
grdContactsView1.DataController.Edit;
grdContactsView1.DataController.SetEditValue(colContactSelected.ID, fSelected, evsText);
grdContactsView1.DataController.Post;
end;
end;
finally
grdContactsView1.DataController.LocateByKey(MarkedRecord);
end;
Screen.Cursor := crDefault;
end;
end;
I can reproduce your problem using the sample project I posted in my answer to your other q.
Try this: Add a TMemo to your form, and inside the 'if grdContactsView1.DataController.LocateByKey(Contact) then' block, write the value of a row-unique datafield and the Selected datafield value to the memo.
Then, what I get when some row other than the top row is selected is that one row is listed twice in the memo, with Selected both false and true, and one of the rows in the filter isn't listed at all, which I think accounts for the behaviour you're seeing. If I then comment out the .Edit .. .Post lines, it correctly lists all the rows in the filter.
So evidently doing the Selected field changes inside a block which iterated the FilteredRecordIndex property of the DBTableView is what's causing the problem.
Personally, I find that it goes a bit against the grain to modify dataset rows in code via a DB-aware control (because you usually end up fighting the DB-awareness of the control), but in this case, it's straightforward to do the processing via the DBTableView of the cxGrid.
procedure TForm1.ProcessFilteredRecords;
var
PrevV,
V : Variant;
i,
Index: Integer;
S : String;
begin
// First, pick up a reference to the current record
// so that we can return to it afterwards
Index := cxGrid1DBTableView1.DataController.FocusedRecordIndex;
PrevV := cxGrid1DBTableView1.DataController.Values[Index, 0];
try
for i := 0 to cxGrid1DBTableView1.DataController.FilteredRecordCount - 1 do begin
Index := cxGrid1DBTableView1.DataController.FilteredRecordIndex[i];
V := cxGrid1DBTableView1.DataController.Values[Index, 0];
if cxGrid1DBTableView1.DataController.LocateByKey(V) then begin
cxGrid1DBTableView1.DataController.Edit;
// 2 is the index of my Selected column in the grid
if cxGrid1DBTableView1.DataController.SetEditValue(2, True, evsText) then
Caption := 'OK'
else
Caption := 'Failed';
cxGrid1DBTableView1.DataController.Post;
end;
end;
finally
if cxGrid1DBTableView1.DataController.LocateByKey(PrevV) then
Caption := 'OK'
else
Caption := 'Failed';
end;
end;
Another way to avoid the problem is to change the Selected states in two steps:
Iterate the FilteredRecordIndex to build a list of rows to change - in your case this would be a list of guids
Then, iterate the list of rows and update their Selected states.
Code:
procedure TForm1.ProcessFilteredRecords;
var
V : Variant;
i,
Index: Integer;
BM : TBookMark;
S : String;
TL : TStringList;
begin
Memo1.Lines.Clear;
TL := TStringList.Create;
try
for i := 0 to cxGrid1DBTableView1.DataController.FilteredRecordCount - 1 do begin
Index := cxGrid1DBTableView1.DataController.FilteredRecordIndex[i];
V := cxGrid1DBTableView1.DataController.Values[Index, 0];
if cxGrid1DBTableView1.DataController.LocateByKey(V) then begin
if CDS1.FieldByName('Selected').AsBoolean then
S := 'True'
else
S := 'False';
S := CDS1.FieldByName('Name').AsString + ' ' + S;
Memo1.Lines.Add(S);
TL.Add(CDS1.FieldByName('Guid').AsString);
end;
end;
try
BM := CDS1.GetBookMark;
CDS1.DisableControls;
for i := 0 to TL.Count - 1 do begin
if CDS1.Locate('guid', TL[i], []) then begin
CDS1.Edit;
CDS1.FieldByName('Selected').AsBoolean := True;
CDS1.Post;
end
end;
finally
CDS1.EnableControls;
CDS1.GotoBookmark(BM);
CDS1.FreeBookmark(BM);
end;
finally
TL.Free;
end;
end;
Like you, I was expecting that changing a property or two of the cxGrid might avoid the problem without any code, but I haven't been able to find anything which does.
I am working on an application where i have a combobox with long text values.Since the text values are large(in term of characters ..20 or more), to display in the combobox, the requirement was to display on the first character after selecting from the drop down.
Like in the image marked in red. if the user selects 3th item 3 0.5 to 1.25 Slight i should only display the 3 in the combobox.
So i tried this
sTheSelectedValue : string;
procedure TForm1.ComboBox1Select(Sender: TObject);
begin
sTheSelectedValue:=TrimTextAndDisplay(ComboBox1.Text); //send theselected value
ComboBox1.Text :=''; //clear the selection
ComboBox1.Text:=sTheSelectedValue; //now assign as text to combo box
Button1.Caption:=ComboBox1.Text; //just show the new value on the button.
end;
function TForm1.TrimTextAndDisplay(TheText : string): string;
var
sTheResult : string;
begin
sTheResult :=copy(TheText,0,1); //extract the first value..
Result :=sTheResult;
end;
The result is
The button seem to show the proper value but not the combobox.
what i want is to get 3 in the combobox, i cant seem set ComboBox1.Text:=
can any one tell me how to do it?
like this on selection of from the combobox the result should be
I would suggest owner-drawing the ComboBox to handle this. Set the TComboBox.Style property to csOwnerDrawFixed, then store just the numbers '1', '2', '3', etc in the TComboBox.Items property itself and use the TComboBox.OnDrawItem event to render the full strings when the drop-down list is visible, eg:
var
sTheSelectedValue : string;
const
ItemStrings: array[0..7] of string = (
'0 to 0.1 Calm (rippled)',
'0.1 to 0.5 Smooth (wavelets)',
'0.5 to 1.25 Slight',
'1.25 to 2.5 Moderate',
'2.5 to 4 Rough',
'4 to 6 Very rough',
'6 to 9 High',
'9 to 14 Very high');
procedure TForm1.FormCreate(Sender: TObject);
var
I: Integer;
begin
ComboBox1.Items.BeginUpdate;
try
for I := Low(ItemStrings) to High(ItemStrings) do begin
ComboBox1.Items.Add(IntToStr(I+1));
end;
finally
ComboBox1.Items.EndUpdate;
end;
end;
procedure TForm1.ComboBox1Select(Sender: TObject);
begin
sTheSelectedValue := IntToStr(ComboBox1.ItemIndex+1);
Button1.Caption := sTheSelectedValue;
end;
procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
s: String;
begin
if odSelected in State then begin
ComboBox1.Canvas.Brush.Color := clHighlight;
ComboBox1.Canvas.Font.Color := clHighlightText;
end else begin
ComboBox1.Canvas.Brush.Color := ComboBox1.Color;
ComboBox1.Canvas.Font.Color := ComboBox1.Font.Color;
end;
ComboBox1.Canvas.FillRect(Rect);
s := IntToStr(Index+1);
if not (odComboBoxEdit in State) then begin
s := s + ' ' + ItemStrings[Index];
end;
ComboBox1.Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+2, s);
if (State * [odFocused, odNoFocusRect]) = [odFocused] then begin
ComboBox1.Canvas.DrawFocusRect(Rect);
end;
end;
You have to try to save the data in a record, for ex:
type
TMyRec = record
Num:Integer;
Text:String;
end;
TMyRecArray = array of TMyRec;
MyRecArray:TMyRecArray;
then you can set manually the items to be set in the ComboBox (on the OnFromCreate),
SetLength(MyRecArray,9);
MyRecArray[0].Num:=1;
MyRecArray[0].Text:='0 to 0.1 Calm Rippled';
.
.
and so on.
then in the combobox strigns place only the numbers, and
procedure TForm1.ComboBox1Select(Sender: TObject);
var
i:integer;
begin
for i:=0 to 9 do
begin
if ComboBox1.Text=IntToStr(MyRecArray[i].Num) then
Button1.Caption:=MyRecArray[i].Text;
end;
end;