ReportForm. ListBox1. Items. Add(St);
end;
end;
ReportForm. ShowModal;
end;
end.
unit Unit2;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ComCtrls, ExtCtrls;
type
TReportForm = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
OKBtn: TButton;
CancelBtn: TButton;
ListBox1: TListBox;
private
{Private declarations}
public
{Public declarations}
end;
var
ReportForm: TReportForm;
implementation
{$R *.DFM}
end.
unit MyTypes;
interface
uses Sysutils, Contnrs;
const MaxN = 100;
type
TVarType = Variant; //TVarRec;
TVarMas = array [1..MaxN] of TVarType;
TVector = class (TInterfacedObject)
private
{Private declarations}
FArr: array [1..MaxN] of TVarMas; //source data
FNum: integer; //number of items
FCols: integer; //number of columns
FNames: array [1..MaxN] of String[MaxN]; //names of columns
function GetSize: Integer;
procedure SetSize (value: Integer);
function GetCols: Integer;
procedure SetCols (value: Integer);
procedure SetX (Index1, Index2: integer; value: TVarType);
function GetX (Index1, Index2: integer): TVarType;
procedure SetName (Index: integer; value: String);
function GetName (Index: integer): String;
public
SortId: integer; // Текущийсортируемыйстолбец
SortMode: integer; // Текущийрежимсортировки
constructor Create;
property X [Index1, Index2: Integer]: TVarType read GetX write SetX;
property Names [Index: Integer]: String read GetName write SetName;
property Size: Integer read GetSize write SetSize;
property Cols: Integer read GetCols write SetCols;
procedure Sort (xMode: integer = 0);
procedure Add();
procedure AddCopy (Index: integer);
procedure Delete (Index: integer);
function Find (Col, Row: integer; Value: Variant): integer;
end;
implementation
constructor TVector. Create;
begin
FNum:= 0; SortId:= 0; SortMode:= 1;
end;
function TVector. GetSize: Integer;
begin result:= FNum; end;
procedure TVector. SetSize (value: Integer);
begin FNum:= value; end;
function TVector. GetCols: Integer;
begin result:= FCols; end;
procedure TVector. SetCols (value: Integer);
begin FCols:= value; end;
procedure TVector. SetX (Index1, Index2: integer; value: TVarType);
begin
FArr[Index1] [Index2]:= value;
end;
function TVector. GetX (Index1, Index2: integer): TVarType;
begin
result:= FArr[Index1] [Index2];
end;
function TVector. GetName (Index: integer): String;
begin
result:= FNames[Index];
end;
procedure TVector. SetName (Index: integer; value: String);
begin
FNames[Index]:= Value;
end;
procedure TVector. Add();
begin
FNum:= FNum + 1;
end;
procedure TVector. AddCopy (Index: integer);
begin
FNum:= FNum + 1;
FArr[FNum]:= FArr[Index];
end;
procedure TVector. Delete (Index: integer);
var i: integer;
begin
if FNum=0 then exit; // Вродекакнечегоудалять
for i:=Index+1 to FNum do // Перенесемстроки
FArr [I-1]:= FArr[I];
FNum:= FNum -1; // уменьшаем количество
end;
// Процедура сортировки вектора данных по индексу SortId с режимом xMode
// xMode = 1 – по возрастанию
// xMode = 2 – по убыванию
// xMode = 0 – использовать текущий режим SortMode и затем поменять его
procedure TVector. Sort (xMode: integer = 0);
procedure QSort (l, r: Integer);
function Less (var x, y: Variant): boolean;
begin
if (X < Y) and (SortMode=1) // повозрастанию
then Less:=true
else Less:=false;
end;
var
i, j, x: integer;
y: TVarMas; //Variant;
begin
i:= l; j:= r; x:= (l+r) DIV 2;
repeat
while Less (FArr[i] [SortId], FArr[x] [SortId]) do i:= i + 1;
while Less (FArr[x] [SortId], FArr[j] [SortId]) do j:= j – 1;
if i <= j then
begin
y:= FArr[i];
FArr[i]:= FArr[j];
FArr[j]:= y;
i:= i + 1; j:= j – 1;
end;
until i > j;
if l < j then QSort (l, j);
if i < r then QSort (i, r);
end;
begin {QuickSort};
if xMode<>0
then SortMode:= xMode;
QSort (1, Size);
if xMode=0 then // Поменяем режим сортировки
begin
if SortMode = 1
then SortMode:=2 else SortMode:=1;
end;
end;
// Процедура поиска значения Value в столбце Col с позиции Row
// возвращает индекс найденой строки или 0 если ничего не найдено
function TVector. Find (Col, Row: integer; Value: Variant): integer;
var i: integer;
begin
result:= 0;
for i:=Row to FNum do
if FArr[I] [Col] = Value then
begin result:= i; exit; end;
end;
end.