VPF::Сортировка списка. - Форум программистов

X-Vlad

Дата 1.6.2005, 17:40 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 570
Регистрация: 10.4.2002
Где: Украина, Львов

Репутация: 1
Всего: 5

Привет всем. )))) Давно я здесь не появлялся.. ну звиняйте )) работы валом было )
Такс.. ну приступим собственно к вопросу.
вот написал такой вот код (еще один чел помог).

Помогите реализовать сортировку этого списка. Сортировка должна быть (a-z, z-a) тоесть от меншего и наоборот.

Код


unit DListL;

interface
Type TOnDeleteDLRecord = procedure(Data: Pointer) of object;

Type  pDLRecord = ^DLRecord;
      DLRecord = record
                 Data: Pointer;
                 Prev: pDLRecord;
                 Next: pDLRecord;
                 end;

      DLObjectL = class(TObject)
                 private
                 fFirst: pDLRecord;
                 fCursor: pDLRecord;
                 fLast: pDLRecord;
                 fValueSize: Cardinal;
                 fOnDelete: TOnDeleteDLRecord;
                 procedure FreeData(var Data: Pointer);
                 function GetEOF: boolean;
                 function GetBOF: boolean;

                 public
                 constructor Create;virtual;
                 destructor Destroy;virtual;

                 procedure Init(ValueSize: Cardinal);virtual;
                 procedure Free;virtual;
                 procedure First;
                 procedure Last;
                 procedure Next;
                 procedure Prev;
                 procedure Add(Data: Pointer);
                 procedure Insert(Data: Pointer);
                 procedure Delete;
                 procedure GetData(Data: Pointer);
                 procedure GetPData(var Data: Pointer);
                 procedure SortData;

                 property EOF: boolean Read GetEOF;
                 property BOF: boolean Read GetBOF;
                 property ValueSize: Cardinal Read fValueSize Write Init;
                 property OnDelete: TOnDeleteDLRecord Read fOnDelete Write fOnDelete;

                 end;

implementation

constructor DLObjectL.Create;
begin
 New(fFirst);
 New(fLast);
 fFirst^.Prev:=nil;
 fFirst^.Next:=fLast;
 fLast^.Prev:=fFirst;
 fLast^.Next:=nil;
 fFirst^.Data:=nil;
 fLast^.Data:=nil;
 fCursor:=fLast;
end;

destructor DLObjectL.Destroy;
begin
 Free;
 fCursor:=nil;
 Dispose(fFirst);
 fFirst:=nil;
 Dispose(fLast);
 fLast:=nil;
end;

procedure DLObjectL.Init(ValueSize: Cardinal);
begin
 Free;
 fValueSize:=ValueSize;
end;

procedure DLObjectL.Free;
var
 Temp: pDLRecord;
begin
 Temp:=fFirst^.Next;
  if Temp<>fLast then
   begin
    fCursor:=Temp;
     While not(EOF) do
      begin
       Temp:=fCursor;
       fCursor:=Temp^.Next;
       fCursor^.Prev:=fFirst;
       FreeData(Temp^.Data);
       Dispose(Temp);
       Temp:=nil;
      end;
   fFirst^.Next:=fCursor;
  end;
end;

procedure DLObjectL.FreeData(var Data: Pointer);
begin
 if Data<>nil then
  begin
    if Assigned(fOnDelete) then fOnDelete(Data);
   FreeMem(Data,fValueSize);
  end;
 Data:=nil;
end;

function DLObjectL.GetEOF: boolean;
begin
 if fCursor=fLast then GetEOF:=true
                  else GetEOF:=false;
end;

function DLObjectL.GetBOF: boolean;
begin
 if fCursor=fFirst then GetBOF:=true
                   else GetBOF:=false;
end;

procedure DLObjectL.First;
begin
 fCursor:=fFirst^.Next;
end;

procedure DLObjectL.Last;
begin
 if fLast^.Prev=fFirst then fCursor:=fLast
                       else fCursor:=fLast^.Prev;
end;

procedure DLObjectL.Next;
begin
 if not(EOF) then fCursor:=fCursor^.Next;
end;

procedure DLObjectL.Prev;
begin
 if not(BOF) then fCursor:=fCursor^.Prev;
end;

procedure DLObjectL.Add(Data: Pointer);
var
 Temp: pDLRecord;
begin
 New(Temp);
 Temp^.Prev:=fLast;
 Temp.Next:=nil;
 Temp.Data:=nil;
 GetMem(fLast^.Data,fValueSize);
 fLast^.Next:=Temp;
 Move(Data^,fLast^.Data^,fValueSize);
 fCursor:=fLast;
 fLast:=Temp;
 Temp:=nil;
end;

procedure DLObjectL.Insert(Data: Pointer);
var
 Temp: pDLRecord;
begin
 if BOF then Next;
 if EOF then Add(Data) else
  begin
   New(Temp);
   GetMem(Temp^.Data,fValueSize);
   Move(Data^,Temp^.Data^,fValueSize);
   Temp^.Prev:=fCursor^.Prev;
   Temp^.Next:=fCursor;
   fCursor^.Prev^.Next:=Temp;
   fCursor^.Prev:=Temp;
   fCursor:=Temp;
   Temp:=nil;
  end;
end;

procedure DLObjectL.Delete;
var
 Temp: pDLRecord;
begin
 if not(EOF) and not(BOF) then
  begin
   Temp:=fCursor;
   fCursor:=fCursor^.Next;
   fCursor^.Prev:=Temp^.Prev;
   Temp^.Prev^.Next:=fCursor;
   FreeData(Temp^.Data);
   Dispose(Temp);
   Temp:=nil;
   if EOF then Last;
  end;
end;

procedure DLObjectL.GetData(Data: Pointer);
begin
 if not(Eof) and not(Bof) then
  Move(fCursor^.Data^,Data^,fValueSize);
end;

procedure DLObjectL.GetPData(var Data: Pointer);
begin
 if not(Eof) and not(Bof) then
  Data:=fCursor^.Data
 else Data:=nil;
end;

procedure DLObjectL.SortData;
begin

end;

end.

Зарание благодарен.

--------------------

Хорошая штука - комп..:)
www.x-vlad.com

Quadr0

Дата 1.6.2005, 18:32 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

...

Это сообщение отредактировал(а) Quadr0 - 14.7.2011, 21:00

X-Vlad

Дата 2.6.2005, 14:40 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 570
Регистрация: 10.4.2002
Где: Украина, Львов

Репутация: 1
Всего: 5

Quadr0 спасибо, что подсказал. я там в первую очередь смотрел - того что мне нужно нету. smile

Цитата

А где хоть свойство caption?

зачем это свойство? есть обьект, код которого приведен выше. Он заганяет в память то что я задаю. Мне надо дописать в обьекте процедуру сортировки... тоесть должны сортироватся любые даные.. будь то integer или string... если кто может помочь - помогите.
Добавлено @ 14:42
вот так я пользуюсь этим обьектом.. но еще надо сортировку smile

Код


...
type
  TMyList = record
   Name: string[50];
   PName: string[100];
  end;

  TMainFormF = class(TForm)
    GroupBox1: TGroupBox;
    ResMemo: TMemo;
    NameEdit: TLabeledEdit;
    PNameEdit: TLabeledEdit;
    AllListBtn: TButton;
    NextBtn: TButton;
    PrevBtn: TButton;
    SortBtn: TButton;
    GroupBox2: TGroupBox;
    FirstCheck: TRadioButton;
    AddBtn: TButton;
    CurrentCheck: TRadioButton;
    LastCheck: TRadioButton;
    DelBtn: TButton;
    LastBtn: TButton;
    FirstBtn: TButton;
    procedure FormShow(Sender: TObject);
    procedure AddBtnClick(Sender: TObject);
    procedure AllListBtnClick(Sender: TObject);
    procedure PrevBtnClick(Sender: TObject);
    procedure NextBtnClick(Sender: TObject);
    procedure DelBtnClick(Sender: TObject);
    procedure FirstBtnClick(Sender: TObject);
    procedure LastBtnClick(Sender: TObject);
  private
    MyDataList: DlObjectL;
    MyList: TMyList;
    procedure CreateMyList;
    procedure FreeMyList;
  public
    { Public declarations }
  end;



var
  MainFormF: TMainFormF;

implementation

{$R *.dfm}

procedure TMainFormF.CreateMyList;
begin
 MyDataList:=DlObjectL.Create;
 MyDataList.ValueSize:=Sizeof(MyList);
end;

procedure TMainFormF.FreeMyList;
begin
 MyDataList.Free;
end;


procedure TMainFormF.FormShow(Sender: TObject);
begin
 CreateMyList;
end;

procedure TMainFormF.AddBtnClick(Sender: TObject);
Var
 MyName, MyPName:string;
 MyCheck:integer;
begin
 MyName:=NameEdit.Text;
 MyPName:=PNameEdit.Text;
 MyCheck:=0;
  if (MyName='') or (MyPName='') then
   begin
    application.MessageBox('Çàïîâí³òü ïîëÿ.','Ïîìèëêà',0);
    exit;
   end;
 if FirstCheck.Checked then MyCheck:=1;
 if CurrentCheck.Checked then MyCheck:=2;
 if LastCheck.Checked  then MyCheck:=3;
  case MyCheck of
   1: begin                           // Äîäàòè íà ïî÷àòîê ñïèñêó
       MyList.Name:=MyName;
       MyList.PName:=MyPName;
       MyDataList.First;
       MyDataList.Insert(@MyList);
      end;
   2: begin                          // Äîäàòè â òåêó÷ó ïîçèö³þ ñïèñêó
       MyList.Name:=MyName;
       MyList.PName:=MyPName;
       MyDataList.Insert(@MyList);
      end;
   3: begin                          // Äîäàòè â ê³íåöü ñïèñêó
       MyList.Name:=MyName;
       MyList.PName:=MyPName;
       MyDataList.Add(@MyList);
      end;
  end;
end;

procedure TMainFormF.AllListBtnClick(Sender: TObject);
Var
 MyName, MyPName:string;
begin
 ResMemo.Clear;
 MyDataList.First;
 while not MyDataList.EOF do
  begin
   MyDataList.GetData(@MyList);
   MyName:=MyList.Name;
   MyPName:=MyList.PName;
   ResMemo.Lines.Add(MyName+'   '+MyPName);
   MyDataList.Next;
  end;
end;

procedure TMainFormF.PrevBtnClick(Sender: TObject);
Var
 MyName, MyPName:string;
begin
 ResMemo.Clear;
 MyDataList.Prev;
 MyDataList.GetData(@MyList);
 MyName:=MyList.Name;
 MyPName:=MyList.PName;
 ResMemo.Lines.Add(MyName+'   '+MyPName);
end;

procedure TMainFormF.NextBtnClick(Sender: TObject);
Var
 MyName, MyPName:string;
begin
 ResMemo.Clear;
 MyDataList.Next;
 MyDataList.GetData(@MyList);
 MyName:=MyList.Name;
 MyPName:=MyList.PName;
 ResMemo.Lines.Add(MyName+'   '+MyPName);
end;

procedure TMainFormF.DelBtnClick(Sender: TObject);
begin
 MyDataList.Delete;
end;

procedure TMainFormF.FirstBtnClick(Sender: TObject);
Var
 MyName, MyPName:string;
begin
 ResMemo.Clear;
 MyDataList.First;
 MyDataList.GetData(@MyList);
 MyName:=MyList.Name;
 MyPName:=MyList.PName;
 ResMemo.Lines.Add(MyName+'   '+MyPName);
end;

procedure TMainFormF.LastBtnClick(Sender: TObject);
Var
 MyName, MyPName:string;
begin
 ResMemo.Clear;
 MyDataList.Last;
 MyDataList.GetData(@MyList);
 MyName:=MyList.Name;
 MyPName:=MyList.PName;
 ResMemo.Lines.Add(MyName+'   '+MyPName);
end;

--------------------

Хорошая штука - комп..:)
www.x-vlad.com

X-Vlad

Дата 3.6.2005, 13:16 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 570
Регистрация: 10.4.2002
Где: Украина, Львов

Репутация: 1
Всего: 5

освежаю темку )))

--------------------

Хорошая штука - комп..:)
www.x-vlad.com

Dynamic

Дата 4.6.2005, 17:20 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 372
Регистрация: 5.7.2004
Где: Салехард

Репутация: 12
Всего: 15

Ну вот тебе "пузырек":

Код


var change: boolean;
   i: integer;
   p1, p2: pDLRecord;
begin
  if MyList.EOF <> MyList.First then
  with MyList do
  repeat
     change := false;
     First;
     while not EOF do
     begin
       GetData(p1);
       Next;
       GetData(p2);
       if CompareData(p1, p2) > 0 then
       begin
         ExchangeData(p1, p2);
         change := true;
       end;
     end;
  until not change;

Только добавь 2 процедуры:

Код


function CompareData(p1, p2: pDLRecord): integer; // сравнение
procedure ExchangeData(p1, p2: pDLRecord);  // обмен узлов

ПисАл прямо здесь, так что возможны неточности, отладишь уже сам.

--------------------

Было бы о чем молчать, а уж что сказать – всегда найдется...

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »