Mega Code Archive
Neoturk forum - listbox içindeki elemanları sıralamak
<![CDATA[
"
9 Aralık 2005 15:01
Lidstbox'tekiler Harf sırasına göre
Selam arkadaşlar listbox'taki elemanları harf ve sayı sırasına göre
nasıl yaparım.Yardımcı olursanız çok sevinirim.
delphiibo
"
cevap:
merhaba delphiibo,
listbox içindeki elemanları sıralatman için,
listbox1.Sorted:=true;
not: bu sıralatma gerçek bir sıralatma değildir. harf sırasına göre sıralar.
sayıları gerçek olarak sıralamaz, alfabetik kurala göre sıralar.
gerçek sıralama yaptırabilmen için,
listbox1 içindeki elemanları bir diziye aktarıp, sıralatma algoritmasını kullanıp
(hangisini istersen) tekrar sıralanmış verilerden listbox1 içine yerleştirmen
aradığın tam çözüm olacaktır.
aşağıda veri sıralama yöntemleri ( bubblesort-quicksort-shellsort-selectionsort)
kodlarını gönderiyorum, biraz incele, kendine göre uyarlamaya çalış....
*********************************************************
***** delphinin kendi sıralama örnekleri ****************
***** kaynak: ****************
***** C:\Program Files\Borland\Delphi6\Demos\Threads ****
*********************************************************
unit SortThds;
interface
uses
Classes, Graphics, ExtCtrls;
type
{ TSortThread }
PSortArray = ^TSortArray;
TSortArray = array[0..MaxInt div SizeOf(Integer) - 1] of Integer;
TSortThread = class(TThread)
private
FBox: TPaintBox;
FSortArray: PSortArray;
FSize: Integer;
FA, FB, FI, FJ: Integer;
procedure DoVisualSwap;
protected
procedure Execute; override;
procedure VisualSwap(A, B, I, J: Integer);
procedure Sort(var A: array of Integer); virtual; abstract;
public
constructor Create(Box: TPaintBox; var SortArray: array of Integer);
end;
{ TBubbleSort }
TBubbleSort = class(TSortThread)
protected
procedure Sort(var A: array of Integer); override;
end;
{ TSelectionSort }
TSelectionSort = class(TSortThread)
protected
procedure Sort(var A: array of Integer); override;
end;
{ TQuickSort }
TQuickSort = class(TSortThread)
protected
procedure Sort(var A: array of Integer); override;
end;
procedure PaintLine(Canvas: TCanvas; I, Len: Integer);
implementation
procedure PaintLine(Canvas: TCanvas; I, Len: Integer);
begin
Canvas.PolyLine([Point(0, I * 2 + 1), Point(Len, I * 2 + 1)]);
end;
{ TSortThread }
constructor TSortThread.Create(Box: TPaintBox; var SortArray: array of Integer);
begin
FBox := Box;
FSortArray := @SortArray;
FSize := High(SortArray) - Low(SortArray) + 1;
FreeOnTerminate := True;
inherited Create(False);
end;
{ Since DoVisualSwap uses a VCL component (i.e., the TPaintBox) it should never
be called directly by this thread. DoVisualSwap should be called by passing
it to the Synchronize method which causes DoVisualSwap to be executed by the
main VCL thread, avoiding multi-thread conflicts. See VisualSwap for an
example of calling Synchronize. }
procedure TSortThread.DoVisualSwap;
begin
with FBox do
begin
Canvas.Pen.Color := clBtnFace;
PaintLine(Canvas, FI, FA);
PaintLine(Canvas, FJ, FB);
Canvas.Pen.Color := clRed;
PaintLine(Canvas, FI, FB);
PaintLine(Canvas, FJ, FA);
end;
end;
{ VisusalSwap is a wrapper on DoVisualSwap making it easier to use. The
parameters are copied to instance variables so they are accessable
by the main VCL thread when it executes DoVisualSwap }
procedure TSortThread.VisualSwap(A, B, I, J: Integer);
begin
FA := A;
FB := B;
FI := I;
FJ := J;
Synchronize(DoVisualSwap);
end;
{ The Execute method is called when the thread starts }
procedure TSortThread.Execute;
begin
Sort(Slice(FSortArray^, FSize));
end;
{ TBubbleSort }
***********************************************
********* BUBBLE SORT ÖRNEĞİ ******************
***********************************************
procedure TBubbleSort.Sort(var A: array of Integer);
var
I, J, T: Integer;
begin
for I := High(A) downto Low(A) do
for J := Low(A) to High(A) - 1 do
if A[J] > A[J + 1] then
begin
VisualSwap(A[J], A[J + 1], J, J + 1);
T := A[J];
A[J] := A[J + 1];
A[J + 1] := T;
if Terminated then Exit;
end;
end;
{ TSelectionSort }
***********************************************
********* SELECTION SORT ÖRNEĞİ ***************
***********************************************
procedure TSelectionSort.Sort(var A: array of Integer);
var
I, J, T: Integer;
begin
for I := Low(A) to High(A) - 1 do
for J := High(A) downto I + 1 do
if A[I] > A[J] then
begin
VisualSwap(A[I], A[J], I, J);
T := A[I];
A[I] := A[J];
A[J] := T;
if Terminated then Exit;
end;
end;
{ TQuickSort }
***********************************************
********* QUICK SORT ÖRNEĞİ ******************
***********************************************
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;
end.
***********************************************
******* bubblesort örnek **********************
***********************************************
////////////////////////////////////////////////////////////////////////////////
///////////////////(* Bubble Sorting Arrays - By Jason M. *)////////////////////
////////////////////////////////////////////////////////////////////////////////
(* This example was written at as a console app in delphi 6 if you want to use
it in Turbo Pascal All you have to do is delete {$APPTYPE CONSOLE}
and underneath Uses change SysUtils to Crt *)
program Bubble;
{$APPTYPE CONSOLE}
uses
SysUtils;
Var
Ary : array[1..10] of byte;
InnerLoop : integer;
Outerloop : integer;
temp : integer; {The reason I use this temp is so I can swap the value in the
array over. If I had the following:
x := y;
y := x; y will just wont get y because you assigned y to x
and variables can only hold one Value :)
So by using the Temp variable I can swap them over
temp := x;
x := y;
y := temp;}
begin
randomize;
for innerloop := 1 to 10 do
begin
ary[innerloop] := Random(100);
writeln(ary[innerloop]);
end; {assign some numbers to the array}
{start sorting the array}
for outerloop := 1 to 10 do
begin
for innerloop := outerloop to 10 do
begin
if ary[outerloop] > ary[innerloop] {To displa in decending order change
> to <}
then begin
temp := ary[outerloop]; {enables me to swap the values over}
ary[outerloop] := ary[innerloop]; {make the lowest value higher up in the
the array}
ary[innerloop] := temp;
end;{end IF}
end; {end inner loop}
end;{end outer loop}
writeln;
writeln('press ENTER to view data in asscending order');
readln;
for innerloop := 1 to 10 do
begin
writeln(ary[innerloop]);
end;
readln;
end.
***************************************************************
********** quicksort componenti ve uygulama örneği ************
***************************************************************
unit Qsort;
{TQSort by Mike Junkin 10/19/95.
DoQSort routine adapted from Peter Szymiczek's QSort procedure which
was presented in issue#8 of The Unofficial Delphi Newsletter.}
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs;
type
TSwapEvent = procedure (Sender : TObject; e1,e2 : word) of Object;
TCompareEvent = procedure (Sender: TObject; e1,e2 : word; var Action : integer) of Object;
TQSort = class(TComponent)
private
FCompare : TCompareEvent;
FSwap : TSwapEvent;
public
procedure DoQSort(Sender: TObject; uNElem: word);
published
property Compare : TCompareEvent read FCompare write FCompare;
property Swap : TSwapEvent read FSwap write FSwap;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Mikes', [TQSort]);
end;
procedure TQSort.DoQSort(Sender: TObject; uNElem: word);
{ uNElem - number of elements to sort }
procedure qSortHelp(pivotP: word; nElem: word);
label
TailRecursion,
qBreak;
var
leftP, rightP, pivotEnd, pivotTemp, leftTemp: word;
lNum: word;
retval: integer;
begin
retval := 0;
TailRecursion:
if (nElem <= 2) then
begin
if (nElem = 2) then
begin
rightP := pivotP +1;
FCompare(Sender,pivotP,rightP,retval);
if (retval > 0) then Fswap(Sender,pivotP,rightP);
end;
exit;
end;
rightP := (nElem -1) + pivotP;
leftP := (nElem shr 1) + pivotP;
{ sort pivot, left, and right elements for "median of 3" }
FCompare(Sender,leftP,rightP,retval);
if (retval > 0) then Fswap(Sender,leftP, rightP);
FCompare(Sender,leftP,pivotP,retval);
if (retval > 0) then Fswap(Sender,leftP, pivotP)
else
begin
FCompare(Sender,pivotP,rightP,retval);
if retval > 0 then Fswap(Sender,pivotP, rightP);
end;
if (nElem = 3) then
begin
Fswap(Sender,pivotP, leftP);
exit;
end;
{ now for the classic Horae algorithm }
pivotEnd := pivotP + 1;
leftP := pivotEnd;
repeat
FCompare(Sender,leftP, pivotP,retval);
while (retval <= 0) do
begin
if (retval = 0) then
begin
Fswap(Sender,leftP, pivotEnd);
Inc(pivotEnd);
end;
if (leftP < rightP) then
Inc(leftP)
else
goto qBreak;
FCompare(Sender,leftP, pivotP,retval);
end; {while}
while (leftP < rightP) do
begin
FCompare(Sender,pivotP, rightP,retval);
if (retval < 0) then
Dec(rightP)
else
begin
FSwap(Sender,leftP, rightP);
if (retval <> 0) then
begin
Inc(leftP);
Dec(rightP);
end;
break;
end;
end; {while}
until (leftP >= rightP);
qBreak:
FCompare(Sender,leftP,pivotP,retval);
if (retval <= 0) then Inc(leftP);
leftTemp := leftP -1;
pivotTemp := pivotP;
while ((pivotTemp < pivotEnd) and (leftTemp >= pivotEnd)) do
begin
Fswap(Sender,pivotTemp, leftTemp);
Inc(pivotTemp);
Dec(leftTemp);
end; {while}
lNum := (leftP - pivotEnd);
nElem := ((nElem + pivotP) -leftP);
if (nElem < lNum) then
begin
qSortHelp(leftP, nElem);
nElem := lNum;
end
else
begin
qSortHelp(pivotP, lNum);
pivotP := leftP;
end;
goto TailRecursion;
end; {qSortHelp }
begin
if Assigned(FCompare) and Assigned(FSwap) then
begin
if (uNElem < 2) then exit; { nothing to sort }
qSortHelp(1, uNElem);
end;
end; { QSort }
end.
{ demo }
***********************************************************
********* QUCIKSORT KULLANARAK STRINGGRIDI SIRALAR ********
***********************************************************
unit Unit1;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Grids, Qsort, StdCtrls;
type
TForm1 = class(TForm)
QSort1: TQSort;
StringGrid1: TStringGrid;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure QSort1Compare(Sender: TObject; e1, e2: Word; var Action: Integer);
procedure QSort1Swap(Sender: TObject; e1, e2: Word);
procedure Button1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
with StringGrid1 do
begin
Cells[1,1] := 'the';
Cells[1,2] := 'brown';
Cells[1,3] := 'dog';
Cells[1,4] := 'bit';
Cells[1,5] := 'me';
end;
end;
procedure TForm1.QSort1Compare(Sender: TObject; e1, e2: Word;
var Action: Integer);
begin
with Sender as TStringGrid do
begin
if (Cells[1, e1] < Cells[1, e2]) then
Action := -1
else if (Cells[1, e1] > Cells[1, e2]) then
Action := 1
else
Action := 0;
end; {with}
end;
procedure TForm1.QSort1Swap(Sender: TObject; e1, e2: Word);
var
s: string[63]; { must be large enough to contain the longest string in the grid }
i: integer;
begin
with Sender as TStringGrid do
for i := 0 to ColCount -1 do
begin
s := Cells[i, e1];
Cells[i, e1] := Cells[i, e2];
Cells[i, e2] := s;
end; {for}
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
QSort1.DoQSort(StringGrid1,STringGrid1.RowCount-1);
end;
end.
*****************************************
******* SHELL SORT ÖRNEK ****************
******************************************
Procedure Sort_Shell(var a: array of Word);
var
bis, i, j, k: LongInt;
h: Word;
begin
bis := High(a);
k := bis shr 1;// div 2
while k > 0 do
begin
for i := 0 to bis - k do
begin
j := i;
while (j >= 0) and (a[j] > a[j + k]) do
begin
h := a[j];
a[j] := a[j + k];
a[j + k] := h;
if j > k then
Dec(j, k)
else
j := 0;
end; // {end while]
end; // { end for}
k := k shr 1; // div 2
end; // {end while}
end;
saygılarımla_
neoturk_
]]>