Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2003.08.28;
Скачать: [xml.tar.bz2];

Вниз

Как отсортировать данные в двухпольном TStringGrid?   Найти похожие ветки 

 
dvp1   (2003-08-15 14:48) [0]

Как отсортировать данные в двухпольном TStringGrid?
Как предварительно отсортировать TList?
Структура TList такая: загрузка из текстового файла
type
Rec = Record
Name : string;
BirthDate : integer;
end;
TRec = ^Rec;
var
MyList : TList;
PRec : TRec;
<.......................>
New(PRec);
PRec^.Name := NAMEFROMFILE;
PRec^.BirthDate := Day_1;
MyList.Add(Prec);

Что сделать?


 
still   (2003-08-15 14:55) [1]

Пишешь функцию типа
TListSortCompare
Туда передаются два указателя- вот и сравнивай.
Посмотри метод Sort у TList.


 
Aleksandr   (2003-08-15 14:58) [2]

Да очень просто - есть у него метод Sort. Пишешь функцию вроде MySortFunc, в которую передаются два итема этого объекта, в ней сравниваешь их свойства и возвращаешь результат типа integer (-1,0 или 1). А потом уже где-нибудь при работе с объектом вызываешь MyList.Sort(@MySortFunc)


 
Serginio666   (2003-08-15 14:58) [3]

StringGrid1.Rows
procedure Tlist.Sort(Compare: TListSortCompare);


 
dvp1   (2003-08-15 15:41) [4]

НЕ получается ничего с этой сортирующей функцией...
Напишите подробней


 
dvp1   (2003-08-15 15:41) [5]

НЕ получается ничего с этой сортирующей функцией...
Напишите подробней


 
still   (2003-08-15 15:48) [6]

function MySort(Item1, Item2: Pointer): Integer;
begin
Result := StrComp(PChar(TRec(Item1)^.Name), PChar(TRec(Item1)^.Name));
end;

procedure Button1Click(Sender: TObject);
begin
MyList.Sort(MySort);
end;

вот примерно так


 
Aleksandr   (2003-08-15 15:56) [7]

still :
Ну, я всегда делал так:

procedure Button1Click(Sender: TObject);
begin
MyList.Sort(@MySort)
end;


dvp1 :
А вообще, лучше покажите свой код. Мало ли что там неправильно.


 
Serginio666   (2003-08-15 15:57) [8]

function CompareNames(Item1, Item2: Pointer): Integer;
begin
Result := CompareText(TRec(Item1).Name, TRec(Item2).Name);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
List1.Sort(@CompareText);
end;


 
pasha_golub   (2003-08-15 16:06) [9]

2Aleksandr
Можно не указывать @, компилятор нормально справляется с такой структурой, тем более что это процедурный тип, там и ежу понятно как его использовать :-)


 
Serginio666   (2003-08-15 16:08) [10]

>pasha_golub © (15.08.03 16:06) [9]
Я знаю просто содрал пример из Help.


 
dvp1   (2003-08-15 16:10) [11]

Вот код одного основного модуля...
Нужно отсортировать и выгрузить в TStringGrid////

unit LMGrid;

interface

uses
Grids, SysUtils, Dialogs, Classes;

procedure ClrStrGrid (strGrid: TStringGrid);
procedure InitStringGrid (strGrid: TStringGrid; TotalCols,
TotalRows, ColHPixels: integer);
Function Search(str_1: string; str_2: string; FileToCopy: string; Del : integer): ByteBool;
procedure SaveStringGrid (str_1: string; str_2: string;
FileToSave: string);
procedure OpenStringGrid (strGrid: TStringGrid;
FileToOpen: string; Month : Integer);

//function ListSortFunc(Item1, Item2: Pointer): string;

implementation

procedure InitStringGrid (strGrid: TStringGrid; TotalCols,
TotalRows, ColHPixels: integer);

{ Initialize string grid by setting total number of rows
columns and size per column }

var
CurCol: integer;

begin
продолжение следует....


 
DVP1   (2003-08-15 16:10) [12]

strGrid.ColCount := TotalCols;
strGrid.RowCount := TotalRows;

with strGrid do
begin
for CurCol := 0 to RowCount - 1 do
RowHeights [CurCol] := ColHPixels;

ColWidths [0] := 40;
ColWidths [1] := 360;
ColWidths [2] := 100;
ColWidths [3] := 100;
// ColWidths [3] := 100;
end;
end;

procedure ClrStrGrid (strGrid: TStringGrid);

var
CurCol, CurRow: Integer;

begin

with strGrid do
for CurCol := 0 to ColCount - 2 do
for CurRow:= 1 to RowCount - 2 do
Cells[CurCol, CurRow] := ""

end;
///_________________________________________________________________
function SortFunc_1(Item1, Item2: Pointer): integer;
var
Year_1, Year_2, Month_1, Day_1, Month_2, Day_2 : Word;
begin
DecodeDate(StrToDate( ),Year_1, Month_1, Day_1);
Result := Compare
end ;
///_________________________________________________________________
procedure OpenStringGrid (strGrid: TStringGrid;
FileToOpen: string; Month : Integer);
type
////For sorting
Rec = Record
Name : string;
BirthDate : string;
end;

////////////////////////////////
//For sorting
TRec = ^Rec;
// }
var
//For sorting
MyList : TList;
PRec : TRec;
//
S_1 : string[11];
N_1, D_1 : integer;
CurRow, i, j, ind_ : integer;
FileStrGrid : textfile;
VarStrGridName : string;
VarStrGridDate : string;
//StrF : string[5];
//StrD : string[5];
Year_1, Year_2, Month_1, Day_1, Month_2, Day_2 : Word;

Buf: array[1..4096] of Char; { 4K buffer }
{ Restore saved grid values from a text file }

begin
if FileExists (FileToOpen) = False then begin
MessageDlg("File not found: " + FileToOpen, mtWarning,
[mbOk], 0);
exit;
end;
/////
AssignFile( FileStrGrid, FileToOpen);
SetTextBuf(FileStrGrid, Buf);
Reset (FileStrGrid);
N_1:=0;
CurRow := 1;
MyList := Tlist.Create; //For sorting
with strGrid do
begin
Cells [0, 0] := "


 
DVP1   (2003-08-15 16:11) [13]

then Prec := MyList.Items[j]; ind_ := j;
end;
MyList.Move(ind_, i);
//MyList.Remove(Prec);
//MyList.Pack;

ShowMessage("2"+IntToStr(MyList.Count));

// PRec := MyList.Items[0];
{ FOR i:=1 to MyList.Count - 1 do
begin
// if (TRec(MyList.Items[i])^.BirthDate > Prec^.BirthDate)
// then Prec := MyList.Items[i];

ShowMessage(IntToStr(Prec^.BirthDate));

//__________________________________________________
N_1 := N_1 + 1;
Str(N_1,S_1);
IF Month = 0 THEN Font.color := 250
ELSE Font.color := 70;
Cells [0, CurRow] := S_1;
Cells [1, CurRow] := Prec^.Name;
Cells [2, CurRow] := IntToStr(Prec^.BirthDate);
//__________________________________
MyList.Remove(Prec);
MyList.Pack;
//__________________________________
//ShowMessage(VarStrGridDate);
//ShowMessage(IntToStr(Year_2));
D_1 := Year_2 - Year_1;
Cells [3, CurRow] := IntToStr(D_1);
CurRow := CurRow + 1;
end; }
//end; }
end;

CloseFile(FileStrGrid);

end;
///////////////////////////////////////////////////////////////
Function Search(str_1: string; str_2: string; FileToCopy: string; Del : integer): ByteBool;
var
StrFileToCopy : textfile;
VarStrGridName_1 : string;
VarStrGridName_2 : string;
ReturnedValue : ByteBool;
// ReturnedValue_1 : ByteBool;
// StrTMPFile: textfile;
Buf: array[1..4096] of Char; { 4K buffer }
begin
//


 
DVP1   (2003-08-15 16:35) [14]

Все получилось ...
СПАСИБО ОГРОМНОЕ ЗА СОВЕТЫ...

//////////////////////////////________________________________________ _______
function SortFunc_1(Item1, Item2: Pointer): integer;
var
Year_1, Year_2, Month_1, Day_1, Month_2, Day_2 : Word;
begin
DecodeDate(StrToDate(TRec(Item1).BirthDate),Year_1, Month_1, Day_1);
DecodeDate(StrToDate(TRec(Item2).BirthDate),Year_2, Month_2, Day_2);
IF (Month_1 = Month_2)and(Day_1 < Day_2) then
Result := -1
ELSE IF (Month_1 = Month_2)and(Day_1 = Day_2) then
Result := 0
ELSE IF (Month_1 = Month_2)and(Day_1 > Day_2) then
Result := 1
end ;
/////////////////////////////_________________________________________ _______


 
Amoeba   (2003-08-15 16:48) [15]

Есть такой готовый компонент TswStringGrid (D5, D6, без исходников). Возьмешь на Torry:
http://www.torry.net/vcl/grids/stringgrids/swstringgrid.zip



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2003.08.28;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.49 MB
Время: 0.006 c
14-92198
asp
2003-08-11 09:13
2003.08.28
Смена ника


3-92052
Isf
2003-08-04 12:05
2003.08.28
Key violation


3-92071
Max_
2003-08-01 16:42
2003.08.28
Oracle+BDE+install


1-92096
Vitalygavrilov
2003-08-15 14:59
2003.08.28
Возможно ли в QReport рисовать таблицы и необходимые линии


14-92254
Proger_XP
2003-08-09 10:48
2003.08.28
Инет





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский