,,,
. .417313
..
, , . , . . . , , ( ), , , , . , , , , . . , , , , .
, , , . ( ), , . ̻, , (, . .). .
. .
Delphi, , .
Delphi .
Delphi - :
.
- .
(, , ) .
- .
1.1.
Form1. (. 1):
- MainMenu1 , , , .
- BtnDel .
- txtSearch .
- btnSearch txtSearch.
- CheckBox1 .
- PageControl1 TabSheet 1÷4 ( Ĕ, ʔ, ʔ ).
TabSheet 1÷4 ( XDgrid, WTKgrid, BANKgrid NDgrid). , TabSheet 4 GroupBox1 c btnSort1 btnSort2 .
1.2 ,
:
Unit1 .
, :
- procedure LoadFromFiles .
- procedure InitGrids .
- procedure FillArrays .
- procedure SaveInFiles .
- procedure FillNDgrid .
- procedure Sort NDgrid .
- procedure Sort2 NDgrid .
- procedure SweepRows(r1,r2:word) - NDgrid .
- procedure SaveRow(var sr:SRow;r:word) .
2.
5 String[N] , N≤255.
XDar: array [1..70] of String[30];
WTKar: array [1..150] of String[30];
BANKar: array [1..50] of String[30];
SRow=array [0..5] of String[30];
s: array [0..5] of String[30];
XDar | String[N] | (30+1)*70=2170 |
WTKar | String[N] | (30+1)*150=4650 |
BANKar | String[N] | (30+1)*50=1550 |
SRow | String[N] | (30+1)*6=186 |
S | String[N] | (30+1)*6=186 |
, :
nCol, i, j, y, x, n, n1, n2, c integer ( 4 );
l, r word ( 2 );
st, code, s string[30] ( 30+1=31 ).
XDar, WTKar BANKar 70, 150 50 .
:
XDar: array [1..70] of String[30];
WTKar: array [1..150] of String[30];
BANKar: array [1..50] of String[30];
(array) . . , .
, ( ), .
XDar:
0 | 1 | 2 | 30 | ||
1 | |||||
2 | |||||
3 | |||||
70 |
1 . XDar (30+1)*70=2170 .
WTKar:
0 | 1 | 2 | 30 | ||
1 | |||||
2 | |||||
3 | |||||
150 |
1 . WTKar (30+1)*150=4650 .
BANKar:
0 | 1 | 2 | 30 | ||
1 | |||||
2 | |||||
3 | |||||
50 |
1 . BANKar (30+1)*50=1550 .
( ).
, , , . , , .
N∙Log2N . .
, , , , .. . , .
K[L], ..., K[R], ,
K[i] ≤ K[2i] & K[i] ≤ K[2i + 1], (1)
i = L, ..., R/2. [1], [2], ..., [R], 1, . R=10 2.
, 2, , i = 1, 2, ..., R/2 (1). , i = R/2+1, R/2+2, ...., R ( ), , .
. . (sift), - .
, [3], [4], ..., [10] [2] , - [2], [3], [4], ..., [10]. , , [3], ..., [10], 3, , [2] =44.
[2] : -, .. 15 28. - , , , . - , 44, , , .. 15. 44 [4], 15 - [2]. , - [4] - 44 18. , 4.
, -
. :
,
, .
: , .
:
1) temp,
2) - ,
3) q , ,
4) temp q,
5) temp:= q,
6) . 1.
Sift, R:
Procedure Sift (temp, R: Integer);
Var q: integer;
x: TElement;
Begin
q:==2*t;
If q > R Then Exit;
If q < R Then
If a[q-l].Key > a[q].Key Then q:= q + 1;
If a[temp-1].Key <= a[q-l].Key Then Exit;
x:= a[temp-1];
a [temp-1] := a[q-l];
a[q-l]:= x;
temp:= q;
Shift (temp, R);
End;
Shift .
[0], [1], a[Highlndex]. 0, 1. , a[N/2], a[N/2+1], ..., a[Highlndex] , i (i= N/2+1, N/2+2, ) j, , , j=2i ( j=2i+l). , . : . .
44 55 12 42 94 18 06 67
44 55 12 42 94 18 06 67
44 55 06 42 94 18 12 67
44 42 06 55 94 18 12 67
06 42 12 55 94 18 44 67
- ,
, N :
R:= N;
For i:= N Div 2 Downto 1 Do
Sift(i, R);
, , N , ( ). , ? : (, ), , [0] . :
06 42 12 55 94 18 44 67
12 42 18 55 94 67 44 06
18 42 44 55 94 67 12 06
42 55 44 67 94 18 12 06
44 55 94 67 42 18 12 06
55 67 94 44 42 18 12 06
67 94 55 44 42 18 12 0
94 67 55 44 42 18 12 06 -
Sift :
For R:= Highlndex Downto 1 Do Begin
x:=a[0]; a[0]:=a[R]; a[R]:=x;
Sift(1, R);
End;
, . , Sift ( If Sift, ). PyramidSort, :
Procedure PyramidSort;
Var R, i: integer;
x: TElement;
Begin
R:= N;
For i:= N Div 2 Downto 1 Do
Sift(i, R);
For R:= Highlndex Downto 1 Do Begin
x:=a[0]; a[0]:= a[R]; a[R]:= x;
Sift(l, R);
End;
|
|||
Borland Delphi.
. Ĕ (. .5).
(). DELPHI . .
, . .
1 . / .., .. .: , 2004 176 .
2 .. Delphi 6. . - .: ̻, 2001. - 1024 .
3 . . - : , 2001. 352 .
4 . IBM PC. . - : , 2003. - 928 .
5 .. , 1. . - .: , 2002. -720 .
6 .. , 3. . - .: , 2001. - 832 .
7 ., ., . . .: , 1989. 475 .
8 . DELPHI. -.: -, 2004. - 887 .
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, Grids, Menus, StdCtrls, ExtCtrls;
type
// NDgrid
SRow=array [0..5] of String[30];
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
XDgrid: TStringGrid;
TabSheet2: TTabSheet;
WTKgrid: TStringGrid;
TabSheet3: TTabSheet;
BANKgrid: TStringGrid;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
btnSearch: TButton;
txtSearch: TEdit;
TabSheet4: TTabSheet;
NDgrid: TStringGrid;
N4: TMenuItem;
CheckBox1: TCheckBox;
btnDel: TButton;
GroupBox1: TGroupBox;
btnSort1: TButton;
btnSort2: TButton;
procedure FormCreate(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure btnSearchClick(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure btnDelClick(Sender: TObject);
procedure btnSort2Click(Sender: TObject);
procedure btnSort1Click(Sender: TObject);
private
{ Private declarations }
XDar: array [1..70] of String[30]; { }
WTKar: array [1..150] of String[30]; { }
BANKar: array [1..50] of String[30]; { }
public
{ Public declarations }
procedure LoadFromFiles;
procedure InitGrids;
procedure FillArrays;
procedure SaveInFiles;
procedure FillNDgrid;
procedure Sort;
procedure Sort2;
procedure SweepRows(r1,r2:word);
procedure SaveRow(var sr:SRow;r:word);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{ }
procedure TForm1.LoadFromFiles;
var
F:TextFile;
i:integer;
begin
{ - 'XD.txt'}
//
AssignFile(F,'XD.txt');
Reset(F);
if IOResult <> 0 then
// !
begin
{$I+}
MessageBox(0,'!',' XD.txt!',MB_OK);
exit;
end;
{$I+}
// XDar
i:=1;
while not(SeekEof(F))do
begin
ReadLn(F,XDar[i]);
inc(i);
end;
CloseFile(F); //
{ - 'WTK.txt'}
{$I-}
//
AssignFile(F,'WTK.txt');
Reset(F);
if IOResult <> 0 then
// !
begin
{$I+}
MessageBox(0,'!',' WTK.txt!',MB_OK);
exit;
end;
{$I+}
// XDar
i:=1;
while not(SeekEof(F))do
begin
ReadLn(F,WTKar[i]);
inc(i);
end;
CloseFile(F); //
{ - 'BANK.txt'}
{$I-}
//
AssignFile(F,'BANK.txt');
Reset(F);
if IOResult <> 0 then
// !
begin
{$I+}
MessageBox(0,'!',' BANK.txt!',MB_OK);
exit;
end;
{$I+}
// XDar
i:=1;
while not(SeekEof(F))do
begin
ReadLn(F,BANKar[i]);
inc(i);
end;
CloseFile(F); //
end;
{ }
procedure TForm1.InitGrids;
var i,j:integer;
begin
XDgrid.Cells[0,0]:=' ';
XDgrid.Cells[1,0]:=' ';
XDgrid.Cells[2,0]:=' ';
XDgrid.Cells[3,0]:=' ';
XDgrid.Cells[4,0]:='';
XDgrid.Cells[5,0]:=' ';
XDgrid.Cells[6,0]:='C';
WTKgrid.Cells[0,0]:='';
WTKgrid.Cells[1,0]:='';
WTKgrid.Cells[2,0]:='';
WTKgrid.Cells[3,0]:=' ';
WTKgrid.Cells[4,0]:=' ';
WTKgrid.Cells[5,0]:='';
WTKgrid.Cells[6,0]:=' ';
WTKgrid.Cells[7,0]:=' ';
WTKgrid.Cells[8,0]:=' ';
WTKgrid.Cells[9,0]:=' ';
BANKgrid.Cells[0,0]:=' ';
BANKgrid.Cells[1,0]:='';
BANKgrid.Cells[2,0]:=' ';
BANKgrid.Cells[3,0]:=' ';
BANKgrid.Cells[4,0]:=' ';
NDgrid.Cells[0,0]:=' ';
NDgrid.Cells[1,0]:=' ';
NDgrid.Cells[2,0]:=' ';
NDgrid.Cells[3,0]:=' ';
NDgrid.Cells[4,0]:='';
NDgrid.Cells[5,0]:= '- ';
for i:=1 to 10 do
begin
for j:=1 to 7 do
XDgrid.Cells[j-1,i]:=XDar[(i-1)*7+j];
end;
for i:=1 to 15 do
begin
for j:=1 to 10 do
WTKgrid.Cells[j-1,i]:=WTKar[(i-1)*10+j];
end;
for i:=1 to 10 do
begin
for j:=1 to 5 do
BANKgrid.Cells[j-1,i]:=BANKar[(i-1)*5+j];
end;
end;
{ }
procedure TForm1.FillArrays;
var i:integer;
begin
for i:=0 to 69 do
begin
XDar[i+1]:=XDgrid.Cells[(i mod 7),(i div 7)+1];
end;
for i:=0 to 149 do
begin
WTKar[i+1]:=WTKgrid.Cells[(i mod 10),(i div 10)+1];
end;
for i:=0 to 49 do
begin
BANKar[i+1]:=BANKgrid.Cells[(i mod 5),(i div 5)+1];
end;
end;
{ }
procedure TForm1.SaveInFiles;
var
F:TextFile; //
i:integer;
begin
{XD.txt}
//
AssignFile(F,'XD.txt');
Rewrite(F);
//
for i:=1 to 70 do
WriteLn(F,XDar[i]);
CloseFile(F); //
{WTK.txt}
//
AssignFile(F,'WTK.txt');
Rewrite(F);
//
for i:=1 to 150 do
WriteLn(F,WTKar[i]);
CloseFile(F); //
{BANK.txt}
//
AssignFile(F,'BANK.txt');
Rewrite(F);
//
for i:=1 to 50 do
WriteLn(F,BANKar[i]);
CloseFile(F); //
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
LoadFromFiles; //
InitGrids; //
FillNDgrid; //
end;
{}
procedure TForm1.N2Click(Sender: TObject);
begin
Halt;
end;
{}
procedure TForm1.N3Click(Sender: TObject);
begin
FillArrays; //
SaveInFiles; //
end;
{}
procedure TForm1.btnSearchClick(Sender: TObject);
var
myRect: TGridRect;
Grid: TStringGrid;
nCol,i,j:integer;
st:String;
begin
st:=txtSearch.Text; //
//
case PageControl1.ActivePageIndex of
0: begin Grid:= XDgrid; nCol:=7; end;
1: begin Grid:=WTKgrid; nCol:=10; end;
2: begin Grid:=BANKgrid; nCol:=5; end;
end;
myRect.Left := 11;
myRect.Top := 11;
myRect.Right := 11;
myRect.Bottom := 11;
Grid.Selection:= myRect;
if(st=' ') or (st='') then exit;
//
for i:=1 to 10 do
for j:=0 to nCol-1 do
if Grid.Cells[j,i]=st then
begin
myRect.Left := j;
myRect.Top := i;
myRect.Right := j;
myRect.Bottom := i;
Grid.Selection := myRect;
exit;
end;
end;
{
XDgrid, WTKgrid, BANKgrid}
procedure TForm1.FillNDgrid;
var i,j,y,n:integer;
code:string;
st:string;
begin
j:=1;
for i:=1 to 10 do
if(XDGrid.Cells[5,i]='') then
begin
NDgrid.Cells[0,j]:=XDGrid.Cells[0,i];
NDgrid.Cells[1,j]:=XDGrid.Cells[1,i];
NDgrid.Cells[2,j]:=XDGrid.Cells[2,i];
NDgrid.Cells[3,j]:=XDGrid.Cells[3,i];
NDgrid.Cells[4,j]:=XDGrid.Cells[4,i];
//
code:= NDgrid.Cells[0,j]+'/'+ NDgrid.Cells[1,j][9]+ NDgrid.Cells[1,j][10];
//
n:=0;
for y:=1 to 15 do
if(WTKgrid.Cells[4,y]=code) then inc(n);
str(n,st);
NDgrid.Cells[5,j]:=st;
inc(j);
end;
end;
{ - }
procedure TForm1.N4Click(Sender: TObject);
var i,j:integer;
begin
for i:=1 to 10 do
for j:=0 to 5 do
NDgrid.Cells[j,i]:='';
FillNDgrid;
end;
{ }
procedure TForm1.CheckBox1Click(Sender: TObject);
var opt:TGridOptions;
begin
opt:=XDgrid.Options;
if CheckBox1.Checked=false then
begin
Include(opt,goRowSelect);
Exclude(opt,goEditing);
btnDel.Enabled := true;
end
else
begin
Exclude(opt,goRowSelect);
Include(opt,goEditing);
btnDel.Enabled := false;
end;
XDgrid.Options := opt;
WTKgrid.Options := opt;
BANKgrid.Options := opt;
end;
{}
procedure TForm1.btnDelClick(Sender: TObject);
var
myRect: TGridRect;
Grid: TStringGrid;
nCol,i,j:integer;
begin
//
case PageControl1.ActivePageIndex of
0: begin Grid:= XDgrid; nCol:=7; end;
1: begin Grid:=WTKgrid; nCol:=10; end;
2: begin Grid:=BANKgrid; nCol:=5; end;
end;
if(Grid.Row>0) and (Grid.Row<10) then
for i:=Grid.Row to 10 do
begin
for j:=0 to nCol-1 do
Grid.Cells[j,i]:=Grid.Cells[j,i+1];
end;
end;
{ NDgrid }
procedure TForm1.Sort;
var
l,r:word;
x,n,n1,n2,c,y:integer;
s:string;
sr:SRow;
procedure Sift;
label l3;
var i,j,y:word;
begin
i:=l;j:=2*i;s:=NDgrid.Cells[5,i];SaveRow(sr,i);
while j<=r do
begin
if j<r then
begin
Val(NDgrid.Cells[5,j],n1,c);
Val(NDgrid.Cells[5,j+1],n2,c);
if n1<n2 then j:=j+1;
end;
Val(s,n1,c);
Val(NDgrid.Cells[5,j],n2,c);
if n1>=n2 then goto l3;
for y:=0 to 5 do
NDgrid.Cells[y,i]:=NDgrid.Cells[y,j];
i:=j; j:=2*i;
end;
l3:
for y:=0 to 5 do
begin
NDgrid.Cells[y,i]:=sr[y];
end;
end; // Sift
begin
n:=0;
for y:=1 to 10 do
if (NDgrid.Cells[5,y]<>'') and (NDgrid.Cells[5,y]<>' ') then
inc(n);
l:=(n div 2)+1;r:=n;
while l>1 do
begin
l:=l-1; Sift;
end;
while r>1 do
begin
SaveRow(sr,1);
s:=NDgrid.Cells[5,1];
SweepRows(1,r);
r:=r-1; Sift;
end;
end; // Sort
{ NDgrid }
procedure TForm1.Sort2;
var
l,r:word;
x,n,n1,n2,c,y:integer;
s:string;
sr:SRow;
procedure Sift;
label l3;
var i,j,y:word;
begin
i:=l;j:=2*i;s:=NDgrid.Cells[5,i];SaveRow(sr,i);
while j<=r do
begin
if j<r then
begin
Val(NDgrid.Cells[5,j],n1,c);
Val(NDgrid.Cells[5,j+1],n2,c);
if n1>n2 then j:=j+1;
end;
Val(s,n1,c);
Val(NDgrid.Cells[5,j],n2,c);
if n1<=n2 then goto l3;
for y:=0 to 5 do
NDgrid.Cells[y,i]:=NDgrid.Cells[y,j];
i:=j; j:=2*i;
end;
l3:
for y:=0 to 5 do
begin
NDgrid.Cells[y,i]:=sr[y];
end;
end; // Sift
begin
n:=0;
for y:=1 to 10 do
if (NDgrid.Cells[5,y]<>'') and (NDgrid.Cells[5,y]<>' ') then
inc(n);
l:=(n div 2)+1;r:=n;
while l>1 do
begin
l:=l-1; Sift;
end;
while r>1 do
begin
SaveRow(sr,1);
s:=NDgrid.Cells[5,1];
SweepRows(1,r);
r:=r-1; Sift;
end;
end; // Sort2
{ r1 r2 NDgrid}
procedure TForm1.SweepRows(r1,r2:word);
var s: array [0..5] of String[30];
i:integer;
begin
for i:=0 to 5 do
s[i]:=NDgrid.Cells[i,r1];
for i:=0 to 5 do
NDgrid.Cells[i,r1]:=NDgrid.Cells[i,r2];
for i:=0 to 5 do
NDgrid.Cells[i,r2]:=s[i];
end;
{ r NDgrid sr}
procedure TForm1.SaveRow(var sr:SRow;r:word);
var i:integer;
begin
for i:=0 to 5 do
sr[i]:=NDgrid.Cells[i,r];
end;
procedure TForm1.btnSort2Click(Sender: TObject);
begin
Sort;
end;
procedure TForm1.btnSort1Click(Sender: TObject);
begin
Sort2;
end;
end.
Copyright (c) 2024 Stud-Baza.ru , , , .