TStringList排序問題 |
答題得分者是:jow
|
jhlz1968
一般會員 發表:6 回覆:9 積分:3 註冊:2005-07-13 發送簡訊給我 |
|
GrandRURU
站務副站長 發表:240 回覆:1680 積分:1874 註冊:2005-06-21 發送簡訊給我 |
|
jow
尊榮會員 發表:66 回覆:751 積分:1253 註冊:2002-03-13 發送簡訊給我 |
[code delphi] unit fMain; interface uses Classes, SysUtils, Dialogs, Controls, Forms, StdCtrls; type TRec = class(TPersistent) private FList: TStringList; function GetField(Index: Integer): string; function GetDataStr: string; public constructor Create(Data: string); destructor Destroy; override; property Filed[Index: Integer]: string read GetField; property DataStr: string read GetDataStr; end; TMyCompare = function(SortType: Integer; O1, O2: TObject): Integer of object; TRecList = class(TPersistent) private FList: TStringList; function MyCompare(SortType: Integer; O1, O2: TObject): Integer; virtual; procedure DO_SORT(SortType: Integer; SortList: TStringList; L, R: Integer; MyCompare: TMyCompare); public constructor Create(FileName: string); destructor Destroy; override; function GetSortList(SortType: Integer; var L: TStringList): Boolean; end; TForm1 = class(TForm) ListBox1: TListBox; Button1: TButton; procedure Button1Click(Sender: TObject); end; var Form1: TForm1; implementation {$R *.dfm} { TRec } constructor TRec.Create(Data: string); begin inherited Create; FList := TStringList.Create; FList.CommaText := Data; end; destructor TRec.Destroy; begin FreeAndNil(FList); inherited; end; function TRec.GetDataStr: string; begin Result := FList.CommaText; end; function TRec.GetField(Index: Integer): string; begin if (Index>-1) and (Index else Result := ''; end; { TRecList } constructor TRecList.Create(FileName: string); var I: Integer; L: TStringList; begin inherited Create; FList := TStringList.Create; if FileExists(FileName) then begin L := TStringList.Create; try L.LoadFromFile(FileName); for I := 0 to L.Count-1 do FList.AddObject('',TRec.Create(L[I])); finally FreeAndNil(L); end; end; end; destructor TRecList.Destroy; var I: Integer; begin for I := 0 to FList.Count-1 do FList.Objects[I].Free; FreeAndNil(FList); inherited; end; function TRecList.GetSortList(SortType: Integer; var L: TStringList): Boolean; var I: Integer; begin L := nil; if FList.Count > 0 then begin L := TStringList.Create; for I := 0 to FList.Count-1 do begin L.AddObject('',FList.Objects[I]); end; //Sort The Result List DO_SORT(SortType,L,0,L.Count-1,MyCompare); end; Result := L <> nil; end; procedure TRecList.DO_SORT(SortType: Integer; SortList: TStringList; L, R: Integer; MyCompare: TMyCompare); var I, J, K: Integer; P, T: TObject; begin repeat I := L; J := R; K := (L R) shr 1; P := SortList.Objects[K]; repeat while MyCompare(SortType,SortList.Objects[I],P) < 0 do Inc(I); while MyCompare(SortType,SortList.Objects[J],P) > 0 do Dec(J); if I <= J then begin T := SortList.Objects[I]; SortList.Objects[I] := SortList.Objects[J]; SortList.Objects[J] := T; if K = I then K := J else if K = J then K := I; Inc(I); Dec(J); end; until I > J; if L < J then DO_SORT(SortType,SortList,L,J,MyCompare); L := I; until I >= R; end; //User Defined Sort Compare Function function TRecList.MyCompare(SortType: Integer; O1, O2: TObject): Integer; var r1, r2: TRec; i1, i2: Integer; s1, s2: string; begin r1 := TRec(O1); r2 := TRec(O2); Result := 0; case ABS(SortType) of 1://Sort By ID: Field[0] begin s1 := r1.Filed[0]; s2 := r2.Filed[0]; if s1 > s2 then Result := 1 else if s1 < s2 then Result := -1; end; 2://Sort By Age: Filed[3] begin i1 := StrToIntDef(r1.Filed[3],0); i2 := StrToIntDef(r2.Filed[3],0); if i1 > i2 then Result := 1 else if i1 < i2 then Result := -1; end; end; if SortType < 0 then Result := Result * (-1); end; procedure TForm1.Button1Click(Sender: TObject); var I, SortType: Integer; L,M: TStringList; RecList: TRecList; begin RecList := TRecList.Create('C:\TEST.TXT'); try L := nil; SortType := -1;{降冪排序} (* SortType := 1;{升冪排序} *) if RecList.GetSortList(SortType,L) then try M := TStringList.Create; try for I := 0 to L.Count-1 do M.Add(TRec(L.Objects[I]).DataStr); M.SaveToFile('C:\RESULT.TXT'); ShowMessage(M.Text); finally FreeAndNil(M); end; finally FreeAndNil(L); end; finally FreeAndNil(RecList); end; end; end. [/code] 謹供參考... |
jhlz1968
一般會員 發表:6 回覆:9 積分:3 註冊:2005-07-13 發送簡訊給我 |
TO LOW:
謝謝你的幫助。 我測試了一下,好像只能按一個字段排序。 我想要的效果是 先按 年齡 排序,如果年齡相同,按工資(先按應發工資,再按羞發工資大小)多少排序。由於工資的格式比較特別。所以不知道怎麼排序。 比如下邊的數據。 1111,aa,男,22,2000/1986,無 1115,hh,女,18,1800/1760,無 1112,ss,女,34,2300/2409,有 1113,dd,男,22,2000/1849,無 1114,bb,女,22,2000/1936,無 我想要的結果: 1112,ss,女,34,2300/2409,有 1111,aa,男,22,2000/1986,無 1114,bb,女,22,2000/1936,無 1113,dd,男,22,2000/1849,無 1115,hh,女,18,1800/1760,無 |
jow
尊榮會員 發表:66 回覆:751 積分:1253 註冊:2002-03-13 發送簡訊給我 |
[code delphi] unit fMain; interface uses Classes, SysUtils, Dialogs, Controls, Forms, StdCtrls; type TRec = class(TPersistent) private FList: TStringList; function GetField(Index: Integer): string; function GetDataStr: string; public constructor Create(Data: string); destructor Destroy; override; class function GetPayInfo(O: TRec; var pay1, pay2: Integer): Boolean; property Field[Index: Integer]: string read GetField; property DataStr: string read GetDataStr; end; TMyCompare = function(SortType: Integer; O1, O2: TObject): Integer of object; TRecList = class(TPersistent) private FList: TStringList; function MyCompare(SortType: Integer; O1, O2: TObject): Integer; virtual; procedure DO_SORT(SortType: Integer; SortList: TStringList; L, R: Integer; MyCompare: TMyCompare); public constructor Create(FileName: string); destructor Destroy; override; function GetSortList(SortType: Integer; var L: TStringList): Boolean; end; TForm1 = class(TForm) ListBox1: TListBox; Button1: TButton; ClientSocket1: TClientSocket; ServerSocket1: TServerSocket; procedure Button1Click(Sender: TObject); end; var Form1: TForm1; implementation {$R *.dfm} { TRec } constructor TRec.Create(Data: string); begin inherited Create; FList := TStringList.Create; FList.CommaText := Data; end; destructor TRec.Destroy; begin FreeAndNil(FList); inherited; end; function TRec.GetDataStr: string; begin Result := FList.CommaText; end; function TRec.GetField(Index: Integer): string; begin if (Index>-1) and (Index else Result := ''; end; class function TRec.GetPayInfo(O: TRec; var pay1, pay2: Integer): Boolean; var S: string; P: Integer; begin pay1 := 0; pay2 := 0; Result := False; if O <> nil then begin Result := True; S := O.Field[4]; P := Pos('/',S); if P = 0 then pay1 := StrToIntDef(S,0) else begin pay1 := StrToIntDef(Copy(S,1,P-1),0); pay2 := StrToIntDef(Copy(S,P 1,Length(S)-P),0); end; end; end; { TRecList } constructor TRecList.Create(FileName: string); var I: Integer; L: TStringList; begin inherited Create; FList := TStringList.Create; if FileExists(FileName) then begin L := TStringList.Create; try L.LoadFromFile(FileName); for I := 0 to L.Count-1 do FList.AddObject('',TRec.Create(L[I])); finally FreeAndNil(L); end; end; end; destructor TRecList.Destroy; var I: Integer; begin for I := 0 to FList.Count-1 do FList.Objects[I].Free; FreeAndNil(FList); inherited; end; function TRecList.GetSortList(SortType: Integer; var L: TStringList): Boolean; var I: Integer; begin L := nil; if FList.Count > 0 then begin L := TStringList.Create; for I := 0 to FList.Count-1 do begin L.AddObject('',FList.Objects[I]); end; //Sort The Result List DO_SORT(SortType,L,0,L.Count-1,MyCompare); end; Result := L <> nil; end; procedure TRecList.DO_SORT(SortType: Integer; SortList: TStringList; L, R: Integer; MyCompare: TMyCompare); var I, J, K: Integer; P, T: TObject; begin repeat I := L; J := R; K := (L R) shr 1; P := SortList.Objects[K]; repeat while MyCompare(SortType,SortList.Objects[I],P) < 0 do Inc(I); while MyCompare(SortType,SortList.Objects[J],P) > 0 do Dec(J); if I <= J then begin T := SortList.Objects[I]; SortList.Objects[I] := SortList.Objects[J]; SortList.Objects[J] := T; if K = I then K := J else if K = J then K := I; Inc(I); Dec(J); end; until I > J; if L < J then DO_SORT(SortType,SortList,L,J,MyCompare); L := I; until I >= R; end; //User Defined Sort Compare Function function TRecList.MyCompare(SortType: Integer; O1, O2: TObject): Integer; var r1, r2: TRec; i1, i2, i11, i22: Integer; s1, s2: string; begin r1 := TRec(O1); r2 := TRec(O2); Result := 0; case ABS(SortType) of 1://Sort By ID: Field[0] begin s1 := r1.Field[0]; s2 := r2.Field[0]; if s1 > s2 then Result := 1 else if s1 < s2 then Result := -1; end; 2://Sort By Age: Field[3] begin i1 := StrToIntDef(r1.Field[3],0); i2 := StrToIntDef(r2.Field[3],0); if i1 > i2 then Result := 1 else if i1 < i2 then Result := -1 else Result := MyCompare( 1,O1,O2); end; 3: begin Result := MyCompare( 2,O1,O2); if Result = 0 then begin if TRec.GetPayInfo(TRec(O1),i1,i11) and TRec.GetPayInfo(TRec(O2),i2,i22) then begin if i1 > i2 then Result := 1 else if i1 < i2 then Result := -1 else if i11 > i22 then Result := 1 else if i11 < i22 then Result := -1 else Result := MyCompare( 1,O1,O2); end; end; end; end; if SortType < 0 then Result := Result * (-1); end; procedure TForm1.Button1Click(Sender: TObject); var I, SortType: Integer; L,M: TStringList; RecList: TRecList; begin RecList := TRecList.Create('C:\TEST.TXT'); try L := nil; SortType := -3;{降冪排序} (* SortType := 1;{升冪排序} *) if RecList.GetSortList(SortType,L) then try M := TStringList.Create; try for I := 0 to L.Count-1 do M.Add(TRec(L.Objects[I]).DataStr); M.SaveToFile('C:\RESULT.TXT'); ShowMessage(M.Text); finally FreeAndNil(M); end; finally FreeAndNil(L); end; finally FreeAndNil(RecList); end; end; end. [/code] |
jhlz1968
一般會員 發表:6 回覆:9 積分:3 註冊:2005-07-13 發送簡訊給我 |
|
taishyang
站務副站長 發表:377 回覆:5490 積分:4563 註冊:2002-10-08 發送簡訊給我 |
|
jow
尊榮會員 發表:66 回覆:751 積分:1253 註冊:2002-03-13 發送簡訊給我 |
修正
[code delphi] //User Defined Sort Compare Function function TRecList.MyCompare(SortType: Integer; O1, O2: TObject): Integer; var r1, r2: TRec; i1, i2, i11, i22: Integer; s1, s2: string; begin r1 := TRec(O1); r2 := TRec(O2); Result := 0; case ABS(SortType) of 1://Sort By ID: Field[0] begin s1 := r1.Field[0]; s2 := r2.Field[0]; if s1 > s2 then Result := 1 else if s1 < s2 then Result := -1; end; 2://Sort By Age: Field[3] begin i1 := StrToIntDef(r1.Field[3],0); i2 := StrToIntDef(r2.Field[3],0); if i1 > i2 then Result := 1 else if i1 < i2 then Result := -1; end; 3: begin Result := MyCompare( 2,O1,O2); if Result = 0 then begin if TRec.GetPayInfo(TRec(O1),i1,i11) and TRec.GetPayInfo(TRec(O2),i2,i22) then begin if i1 > i2 then Result := 1 else if i1 < i2 then Result := -1 else if i11 > i22 then Result := 1 else if i11 < i22 then Result := -1; end; end; end; end; if SortType < 0 then Result := Result * (-1); end; [/code] |
jhlz1968
一般會員 發表:6 回覆:9 積分:3 註冊:2005-07-13 發送簡訊給我 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |