1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101:
| unit Main;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,dateUtils;
type
CompareProc = Procedure (List: TStringList; Index1, Index2: Integer ); TlistBox=Class(stdCtrls.TListBox) Procedure Sort(p:CompareProc); End;
TForm5 = class(TForm) ListBox1: TListBox; Button1: TButton; procedure Button1Click(Sender: TObject); procedure ListBox1Click(Sender: TObject); private public end;
var Form5: TForm5;
implementation
{$R *.dfm} function CompareZahl(const A, B: Double):Integer; begin if A =B then Result := 0 else if A < B then Result := -1 else Result := 1; end;
function Compare4Int(List: TStringList; Index1, Index2: Integer ):Integer; var i1,i2:Integer; begin if TryStrToInt(List[index1],i1) and TryStrToInt(List[index2],i2) then Result := CompareZahl(i1, i2) else Result := 0; end;
function Compare4FirstIsInt(List: TStringList; Index1, Index2: Integer ):Integer; var cnt1,cnt2:Integer; Procedure GetCount(Var cnt:Integer;Index:Integer); begin cnt := 0; while (Length(List[index]) > (cnt )) and (List[Index][cnt + 1] in ['0'..'9']) do inc(cnt); end; begin GetCount(cnt1,Index1); GetCount(cnt2,Index2); if (cnt1>0) and (cnt2>0) then Result := CompareZahl(StrToInt(Copy(List[Index1],1,cnt1 )) , StrToInt(Copy(List[Index2],1,cnt2 ))) else Result := 0; end;
procedure TForm5.Button1Click(Sender: TObject);
begin ListBox1.Items.AddObject('4 was auch immer mit Objekt',TObject(4)); ListBox1.Sort(@Compare4FirstIsInt); end;
procedure TlistBox.Sort(p:CompareProc); var sl:TStringList; begin sl := TStringList.Create; try sl.Assign(Items); sl.CustomSort(@p); Items.Assign(sl); finally sl.Free; end;
end;
procedure TForm5.ListBox1Click(Sender: TObject); begin Showmessage(IntToStr(Integer(ListBox1.Items.Objects[ListBox1.ItemIndex]))); end;
end. |