Tablica, Dane, sortowanie

Nie wiem, czy ktoś to czyta czy nie (forum wygląda na puste), ale mam dosyć spory problem... muszę stworzyć program który umożilwia dodawanie pozycji 'imie, nick, email, gg' oraz SORTOWANIE ich wg. imienia.... caly problem polega na tym ze probowalem ze zwykla tablica (array) ale utkwilem na tym ze nie wiem jak posortowac wszystkie pozycje wzgl tablica[].imie

No to wpadłem na pomysł co by zrobić bazę danych, umieściłem wszystko co najpotrzebniejsze, mogę już dodawać do grida ładne rekordy, ale nadal nie wiem jak to posortowac alfabetycznie.... byłbym wdzięczny za jakąkolwiek pomoc, jeżeli ktoś zna lepszy pomysł na stworzenie zbioru rekordow to niech da znac, plz... Aha! jeszcze jedno - jak wyswietlic bazę (kazda kolumna pod soba, odstepy 1spacji miedzy komorkami w wierszach) w RichMemo ?

przepraszam za to '(forum wyglada na puste)' - tyczy sie to innego forum, na ktorym opisywalem ten problem, a pozniej zeń to kopiowałem...

Sortowanie tablicy według imienia to w array to żaden problem. Bierzesz chociażby QuicSort z Delphi (np. przy przykładzie przy wątkach w Delphi jest) i zamieniasz porównania > i < na odpowiednie funkcje porównujące dwa ciągi znaków. W najgorszym wypadku możesz nawet domyślne w Delphi > i < zostawić.

A jeżeli chcesz sortować przez bazę danych to najlepiej wykorzystać do otrzymania danych TQuery i w zapytaniu dać SORT.

No i właśnie o to 'porównujesz dwa ciągi znaków' chodzi.... bo nie mam zielonego pojecia co ja mam napisac w ifie...

type
  TTwojtyp = packed record 
    imie: string;
    nick: string;
  email: string;
     gg: integer;
  end;

 Dane array [0..85] of TTwojtyp = 
  ((imie: 'Kazik'; nick: 'Kaziu'; email: '[email protected]'; gg: 997),
   ((imie: 'Czesiek'; nick: 'Pajker'; email: '[email protected]'; gg: 000002),
 // itd

I sortujesz . wd imienia to:

Dane[i].imie ; itd - jako "i" bierzesz licznik w tablicy... czaisz?

dziekuje z calego serca ze napisales jak sie odwolac do rekordu tablicy(tablica[].imie), ale naprawdę to potrafię ;). Problem, wciąż nie rozwiązany, to jest w jaki sposób posegregować tablicę alfabetycznie.

Hmm może mała kombinacja z konwersją typów... -

Tu masz taką procedurę:

procedure Sort(var iArray : array of Integer); 
var 
I : Integer; 
Temp, J, X : Integer; 
begin 
{ procedura sortujaca - sortowanie przez wymianę } 
for I := 0 to High(iArray) do 
begin 
Temp := i; // przypisz numer tablicy do analizy 
for j := Temp to High(iArray) do 
if iArray[j] < iArray[Temp] then Temp := j; 

x := iArray[i]; 
iArray[i] := iArray[Temp]; 
iArray[Temp] := x; 
end; 
end;   // by Adam Boduch

Dane wejściowe to tablica elementów Integer, ale można przecież zamienić: dla każdej literki zrobić Ord('A'), Ord('B') itd... wykorzystując to + length(element tablicy) jako dane wejściowe do w/w procedury - czemu nie? Dużo pracy i kombinacji ale działa :)

Ja już sił nie mam...
W Demos\Threads znajdziesz coś takiego:

procedure TQuickSort.Sort(var A: array of Integer);

  procedure QuickSort(var A: array of Integer; iLo, iHi: Integer);
  var
    Lo, Hi, Mid, T: Integer;
  begin
    Lo := iLo;
    Hi := iHi;
    Mid := A[(Lo + Hi) div 2];
    repeat
      while A[Lo] < Mid do Inc(Lo);
      while A[Hi] > Mid do Dec(Hi);
      if Lo <= Hi then
      begin
        VisualSwap(A[Lo], A[Hi], Lo, Hi);
        T := A[Lo];
        A[Lo] := A[Hi];
        A[Hi] := T;
        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > Hi;
    if Hi > iLo then QuickSort(A, iLo, Hi);
    if Lo < iHi then QuickSort(A, Lo, iHi);
    if Terminated then Exit;
  end;

begin
  QuickSort(A, Low(A), High(A));
end;

A teraz niesamowicie trudna operacja przerobienia tego:

procedure Sort(var A: array of TTwojTyp);

  procedure QuickSort(var A: array of TTwojTyp; iLo, iHi: Integer);
  var
    Lo, Hi: Integer;
    Mid, T: TTwojTyp;
  begin
    Lo := iLo;
    Hi := iHi;
    Mid := A[(Lo + Hi) div 2];
    repeat
      while A[Lo].Imie < Mid.Imie do Inc(Lo);
      while A[Hi].Imie > Mid.Imie do Dec(Hi);
      if Lo <= Hi then
      begin
        T := A[Lo];
        A[Lo] := A[Hi];
        A[Hi] := T;
        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > Hi;
    if Hi > iLo then QuickSort(A, iLo, Hi);
    if Lo < iHi then QuickSort(A, Lo, iHi);
  end;

begin
  QuickSort(A, Low(A), High(A));
end;

hmmm... ten kod jest całkiem dobry jednak ma jeden minus - co z typowo polskimi znakami ????

Nie wiem co powiedzieć... dziękuję!!!!

hmmm... ten kod jest całkiem dobry jednak ma jeden minus - co z typowo polskimi znakami ????

To trzeba napisać własną procedurę porównującą łańcuchy lub użyć AnsiCompareStr i wstwić:
Zamist:

 while A[Lo].Imie < Mid.Imie do Inc(Lo);
 while A[Hi].Imie > Mid.Imie do Dec(Hi);

to:

 while AnsiCompareStr(A[Lo].Imie, Mid.Imie) < 0 do Inc(Lo);
 while AnsiCompareStr(A[Hi].Imie, Mid.Imie) > 0 do Dec(Hi);

wybaczcie moje lamerskie pytania, ale korzystajac z okazji: jak usunac z tablicy cala komorke (caly rekord) np: tablica[5] i wszystkie rekordy pozostale 'podniesc o jeden' (usuwam 5, a 6 idzie na puste miejsce po 5, 7 po 6 .....tak do length(tablica))

Cześć
właśnie sam wypróbowałem ten kod i działa pięknie, ale chyba ma nadal 1 błąd bo co się stanie jesli np. dane ktoś ma w pliku póżniej je odczytuje i sortuje wg. imienia, a będą powiedzmy 3 osoby o tym samym imieniu? To sortowanie ustawi wszystkich na tym samym miejscu (powiedzmy na 1) i w efekcie zostanie wyswietlone imię tylko 1 raz. Powinno być przecież wyświetlone 3 razy jedno pod drudim.

...jak usunac z tablicy cala komorke (caly rekord)...

http://4programmers.net/view_faq.html?id=424

Cześć
właśnie sam wypróbowałem ten kod i działa pięknie, ale chyba ma nadal 1 błąd bo co się stanie jesli np. dane ktoś ma w pliku póżniej je odczytuje i sortuje wg. imienia, a będą powiedzmy 3 osoby o tym samym imieniu? To sortowanie ustawi wszystkich na tym samym miejscu (powiedzmy na 1) i w efekcie zostanie wyswietlone imię tylko 1 raz. Powinno być przecież wyświetlone 3 razy jedno pod drudim.

Eh... QuickSort nie gubi danych. Będą co najwyżej pod rząd 3 takie same. Wadą QuickSorta (jak i większości szybkich metod sortowania), jest to, że jeżeli najpierw posortujesz wg. imienia, a potem nazwiska, to jeżeli będą dwa takie same nazwiska, to już imiona nie muszą być w kolejności alfabetycznej.
Ale o traceniu danych nie ma mowy!!

Witajcie! Wybaczcie, że znów zadaję pewnie proste pytania, ale przy kompilacji pewnego programu wywala mi błędy.... program wygląda tak:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, DBCtrls, CheckLst, Grids, DBGrids, Menus,
  DB, DBTables, ExtCtrls;

type
   kontakt = record
     imie:string;
     nick:string;
     email:string;
     numergg:string;
   end;

type
  TMainForm = class(TForm)
    pole: TRichEdit;
    pimie: TEdit;
    pnick: TEdit;
    pemail: TEdit;
    pggnumber: TEdit;
    Dodaj: TButton;
    generuj: TButton;
    sortuj: TButton;
    danebox: TGroupBox;
    imie: TLabel;
    nick: TLabel;
    email: TLabel;
    Label1: TLabel;
    pusun: TLabeledEdit;
    usun: TButton;
    MainMenu1: TMainMenu;
    mkontakty: TMenuItem;
    mOprbaz: TMenuItem;
    mWyjcie: TMenuItem;
    mZapiszBaz: TMenuItem;
    mWczytajBaz: TMenuItem;
    mN2: TMenuItem;
    mN3: TMenuItem;
    listbox: TListBox;
    procedure DodajClick(Sender: TObject);
    procedure generujClick(Sender: TObject);
    procedure sortujClick(Sender: TObject);
    procedure usunClick(Sender: TObject);
    procedure odswiezanie;
    procedure mOprbazClick(Sender: TObject);
    procedure mWyjcieClick(Sender: TObject);


  private
    { Private declarations }
  public
    { Public declarations }
  end;

type TKontakty = array of kontakt;

var
  MainForm: TMainForm;
  Tablica : TKontakty;
  indeks:integer;

procedure Sort(var A: array of kontakt);
function wielkalit(wyraz:string): string;
function szukaj(poszukiwany:string):integer;

implementation

{$R *.dfm}

function Concat(S1, S2: TKontakty): TKontakty;overload; //nie ma takiej konieczności, ale na wszelki wypadek jakby się chciało dopisać inne wersje.
begin
  SetLength(Result, Length(S1)+Length(S2));
  Move(S1[0], Result[0], Length(S1)*SizeOf(Kontakt));
  Move(S2[0], Result[Length(S1)], Length(S2)*SizeOf(Kontakt));
end;

procedure Delete(var S: string; index, Count:Integer);overload;
begin
  System.Delete(S, Index, Count);
end;

procedure Delete(var S: TKontakty; index, Count:Integer);overload;
begin
  S := Concat(Copy(S, 0, index), Copy(S, index+Count, Length(S)-index-Count));
end;

procedure TMainForm.odswiezanie;
var i:integer;
begin
listbox.Clear;
 for i:=0 to length(tablica) do
   begin
     listbox.AddItem(tablica[i].imie,listbox);
   end;
end;

procedure TMainForm.DodajClick(Sender: TObject);
begin

if pimie.Text='' then showmessage('Nie podałeś Imienia!');
if pnick.Text='' then showmessage('Nie podałeś Nicka!');
if pemail.Text='' then showmessage('Nie podałeś adresu E-mail!');
if ((pimie.Text<>'') and (pnick.Text<>'') and (pemail.Text<>'')) then
begin
pimie.Text:=wielkalit(pimie.Text);
SetLength(tablica,High(tablica)+2);
tablica[High(tablica)].imie:=pimie.Text;
tablica[High(tablica)].nick:=pnick.Text;
tablica[High(tablica)].email:=pemail.Text;
tablica[High(tablica)].numergg:=pggnumber.Text;
showmessage('dodano ' + pimie.Text);
pimie.Clear;pnick.Clear;pemail.Clear;pggnumber.Clear;
end;
TMainForm.odswiezanie;
end;

procedure TMainForm.generujClick(Sender: TObject);
var i:integer;
begin
pole.Text:='';
   for i:=0 to Length(tablica)-1 do
     begin
       if tablica[1].imie='' then break;
       pole.Text:=pole.Text + '<font color="#D0CC98">Imię: ' + tablica[i].imie + ' Nick: ' + tablica[i].nick + '<br>' + #13 + 'E-mail: <a href="mailto:' + tablica[i].email + '">' + tablica[i].email + '</a><br>' + #13 + 'Numer gg: ' + tablica[i].numergg + '</font><br><br>' + #13 + #13;
     end;

end;
procedure Sort(var A: array of kontakt);
 procedure QuickSort(var A: array of kontakt; iLo, iHi: Integer);
  var
    Lo, Hi: Integer;
    Mid, T: kontakt;
  begin
    Lo := iLo;
    Hi := iHi;
    Mid := A[(Lo + Hi) div 2];
    repeat
       while AnsiCompareStr(A[Lo].Imie, Mid.Imie) < 0 do Inc(Lo);
       while AnsiCompareStr(A[Hi].Imie, Mid.Imie) > 0 do Dec(Hi);

      if Lo <= Hi then
      begin
        T := A[Lo];
        A[Lo] := A[Hi];
        A[Hi] := T;
        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > Hi;
    if Hi > iLo then QuickSort(A, iLo, Hi);
    if Lo < iHi then QuickSort(A, Lo, iHi);
  end;
begin
  QuickSort(A, Low(A), High(A));
end;

function wielkalit(wyraz:string): string;
var
pierwsza:string;
koncowka:string;

begin
   pierwsza:=wyraz;
   koncowka:=wyraz;
   delete(pierwsza,2,length(pierwsza));
   StrUpper(pchar(pierwsza));
   delete(koncowka,1,1);
   wyraz:=pierwsza+koncowka;
   result:=wyraz;

end;

procedure TMainForm.sortujClick(Sender: TObject);
begin
Sort(tablica);
end;

function szukaj(poszukiwany:string):integer;
var i:integer;
begin
for i:=0 to length(tablica) do
 begin
      if tablica[i].imie=poszukiwany then indeks:=i;
 end;
 result:=indeks;
end;


procedure TMainForm.usunClick(Sender: TObject);
var cousun:integer;
begin
     if pusun.Text<>'' then
      begin
        cousun:=szukaj(pusun.Text);
        Delete(tablica, cousun,3);
      end;
MainForm.odswiezanie;
end;

procedure TMainForm.mOprbazClick(Sender: TObject);
begin
  setlength(tablica,0);
  pole.Clear;
  listbox.Clear;
  pimie.Clear;
  pnick.Clear;
  pemail.Clear;
  pggnumber.Clear;
end;

procedure TMainForm.mWyjcieClick(Sender: TObject);
begin
close;
end;

end.

Jeżeli będzie taka potrzeba mogę udostępnić cały projekt (z formą)... Z błędów to przede wszystkim fakt, że przy usuwaniu (wpisywaniu w EditTekście imienia i klikaniu na usun) wywala cały program... A wcześneij to jeszcze mi na każej procedurze MainForm.odswiez przy kompilowaniu wywala.... Byłbym dozgonnie wdzięczny za jakakolwiek pomoc...