Borland Delphi 7.0

15.05.2014
1
0
#1
____________________ Блок 1 _____________________________
unit Transport;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms
Dialogs, Spin, QuickRpt, QRCtrls, StdCtrls, Grids, XPMan;
______________________Блок 2 _____________________________
const mm = 5; nn = 5;
type
TSetOmega = record
T,X:integer;
i,j:byte;
end;
TMatrix = array [1..mm,1..nn] of Integer;
TA = array [1..mm] of Integer;
ТБ = array [1..nn] of Integer;
TfmMainForm = class(TForm)
btnOKRes: TButton;
GroupBox1: TGroupBox;
m: TSpinEdit;
n: TSpinEdit;
Label1: TLabel;
Label2: TLabel;
btnOKPotr: TButton;

sgMatrix: TStringGrid;
Label5: TLabel;
XPManifest1: TXPManifest;
btnCount: TButton;
Label3: TLabel;
btnPrint: TButton;
procedure mChange(Sender: TObject);
procedure nChange(Sender: TObject);
procedure btnOKResClick(Sender: TObject);
procedure btnOKPotrClick(Sender: TObject);
procedure btnCountClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure sgMatrixDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure btnPrintClick(Sender: TObject);
private
SetOmega:array [1..mm*nn] of TSetOmega;
PrevPos:byte; //предидущая позіция мінімального елемента в мн-ві SetOmega
procedure szUgol;
procedure Init;
procedure Posled(FirstMember:TSetOmega);
procedure Otvet();
function minimT(Position:byte):byte;
function SummaVector(Ar:TA):Integer;
function SummaMatrix(Ar:TMatrix):Integer; overload;
function SummaMatrix(ArX,ArT:TMatrix):Integer; overload;

function SummaStrStlb(Ar:TMatrix;Str:boolean;ind:byte):Integer;
functionSearchInSetOmega(ValueT,ValueX:integer;indI,indJ:byte):
TSetOmega; overload;
function SearchInSetOmega(ind:byte;Str:boolean):
TSetOmega; overload;
function Min(а,b:integer):integer;
function OtmetkaStrStlb:TSetOmega;
public
A,AA,V,Mju:TA;
B,BB,W,Lyamda:TB;
T,X:TMatrix;
Tx:byte;//количество ітерацій
TbHeight:integer;
procedure PrintIshDan(TbTop:integer;Ar:TMatrix);
procedure PrintOtvet();
end;
var
fmMainForm: TfmMainForm;
implementation
uses uResPotr, uPrint;
{$R *.dfm}
____________________Блок 3 ____________________
procedure TfmMainForm.mChange(Sender: TObject);
begin
sgMatrix.RowCount:=m.Value+1;
sgMatrix.Cells[0,m.Value]:=IntToStr(m.Value);
end;

procedure TfmMainForm.nChange(Sender: TObject);
begin
sgMatrix.ColCount:=n.Value+1;
sgMatrix.Cells[n.Value,0]:=IntToStr(n.Value);
end;
______________________Блок 4 ________________________
//торба одномірного масива
function TfmMainForm.SummaVector(Ar:TAr):Integer;
var Sum:Integer; i:byte;
begin
Sum:=0;
for i:=1 to m.Value do
Sum:=Sum+Ar;
Result:=Sum;
end;
_____________________Блок 5 __________________
//торба двовимірного масиву
function TfmMainForm.SummaMatrix(Ar:TMatrix):Integer;
var S:Integer; i,j:byte;
begin
S:=0;
for i:=1 to m.Value do
for j:=1 to n.Value do
if (SearchInSetOmega(T[i,j],X[i,j],i,j).T<>-1) and(Ar[i,j]<>-1000) then
S:=S+Ar[i,j];
Result:=S;
end;

function TfmMainForm.SummaMatrix(ArX,ArT:TMatrix):Integer;
var S:Integer; i,j:byte;
begin
S:=0;
for i:=1 to m.Value do
for j:=1 to n.Value do
if (SearchInSetOmega(T[i,j],X[i,j],i,j).T<>-1) and(ARX[i,j]<>-1000) then
S:=S+ArX[i,j]*ArT[i,j];
Result:=S;
end;
_____________________Блок 6 _____________________________
//торба елементів X[i,j] по рядку (Str=true), по стовбцу (Str=false)
//ind - номер рядка (стовпца)
function TfmMainForm.SummaStrStlb(Ar:TMatrix;Str:boolean;ind:byte):Integer;
var S:Integer; i,j:byte;
begin
S:=0;
if Str then begin
for j:=1 to n.Value do
if (SearchInSetOmega(ind,Str).T<>-1) and(X[ind,j]<>-1000) then
S:=S+Ar[ind,j]
end
else begin
for i:=1 to m.Value do
if (SearchInSetOmega(ind,Str).T<>-1) and(Ar[i,ind]<>-1000) then

S:=S+Ar[i,ind];
end;
Result:=S;
end;
______________________Блок 7 ____________________________
procedure TfmMainForm.btnOKResClick(Sender: TObject);
var i:byte;
begin
//перепис з таблиці в масив A
Application.CreateForm(TfmResPotr, fmResPotr);
fmResPotr.Caption:='Ввод ресурсів (A)';
fmResPotr.sgResPotr.ColCount:=m.Value;
for i:=0 to m.Value do
fmResPotr.sgResPotr.Cells[i,0]:='A'+IntToStr(i+1);
fmResPotr.Show;
end;
procedure TfmMainForm.btnOKPotrClick(Sender: TObject);
var i:byte;
begin
//перепис з таблиці в масив B[j]
Application.CreateForm(TfmResPotr, fmResPotr);
fmResPotr.Caption:='Ввод потреб :)D';
fmResPotr.sgResPotr.ColCount:=n.Value;
for i:=0 to n.Value do
fmResPotr.sgResPotr.Cells[i,0]:='B'+IntToStr(i+1);
fmResPotr.Show;
end;

____________________Блок 8 ______________________________
//побудова плану за правилом північно -західного кута
procedure TfmMainForm.szUgol;
var i,j:byte;
SA,SB:integer;
begin
i:=1; j:=1; SA:=0; SB:=0;
AA:=A; BB:=B;
while (i<=m.Value) and(j<=n.Value) do
//як що елемент належить множині SetOmega, то працюємо з ним
if (SearchInSetOmega(T[i,j],X[i,j],i,j).T<>-1)
and (SetOmega[PrevPos].T=T[i,j]) then begin
SA:=A-SummaStrStlb(X,True,i);
SB:=B[j]-SummaStrStlb(X,False,j);
if (SA) >=(SB) then begin
X[i,j]:=SB;
inc(j);
end
else begin
X[i,j]:=SA;
inc(i);
end;
end
//якщо немає - те переходжувати далі
else
if i=m.Value then

begin
i:=1; inc(j);
end
else
inc(i);
A:=AA; B:=BB;
end;
____________________Блок 9 ______________________________
procedure TfmMainForm.btnCountClick(Sender: TObject);
var i,j:byte;
begin
Init();
sgMatrix.ColCount:=n.Value+4;
sgMatrix.RowCount:=n.Value+3;
sgMatrix.Cells[n.Value+2,0]:='v(i)';
sgMatrix.Cells[n.Value+3,0]:='м(i)';
//робимо все до тих пір, поки план не буде оптимальним
repeat
sgMatrix.Cells[0,m.Value+1+Tx*(m.Value+3)]:='b(i)';
for i:=1 to n.Value do
sgMatrix.Cells[i,m.Value+1+Tx*(m.Value+3)]:=IntToStr(B);
//пошук мінімального T
PrevPos:=minimT(PrevPos+1);
//побудова за правилом північно-західного кута
szUgol();
//відмітка рядків і стовпців
OtmetkaStrStlb();

inc(Tx);
//вивод матрици перевезень
Otvet();
//вивод промежуточних результатів в Grid
until (SummaMatrix(X) >=SummaVector(A));
Otvet();
//розраховуем загальну вартість перевезень
Label5.Caption:='Матрица вартості перевезень';
Label3.Caption:='Ответ:'+#13+'Smin= '+IntToStr(SummaMatrix(X,T))+#13+'Tx = '+IntToStr(Tx);
end;
____________________Блок 10 _____________________________
//вивод проміжних результатів в Grid
procedure TfmMainForm.Otvet();
var i,j:byte;
begin
for i:=1 to m.Value do begin
sgMatrix.RowCount:=sgMatrix.RowCount+1;
sgMatrix.Cells[n.Value+1,i+Tx*(m.Value+3)]:=IntToStr(A);
if V<>-1000 then sgMatrix.Cells[n.Value+2,i+Tx*(m.Value+3)]:=IntToStr(V);
if Mju<>-1000 then sgMatrix.Cells[n.Value+3,i+Tx*(m.Value+3)]:=IntToStr(Mju);
for j:=1 to n.Value do
if X[i,j]<>-1000 then
sgMatrix.Cells[j,i+Tx*(m.Value+3)]:=IntToStr(X[i,j])
else sgMatrix.Cells[j,i+Tx*(m.Value+3)]:='';

sgMatrix.Cells[0,i+Tx*(m.Value+3)]:=IntToStr(i);
end;
sgMatrix.RowCount:=sgMatrix.RowCount+2;
sgMatrix.Cells[0,m.Value+1+Tx*(m.Value+3)]:='b(i)';
sgMatrix.Cells[0,m.Value+2+Tx*(m.Value+3)]:='щ(i)';
sgMatrix.Cells[0,m.Value+3+Tx*(m.Value+3)]:='л(i)';
for j:=1 to n.Value do begin
if W[j]<>-1000 then sgMatrix.Cells[j,m.Value+2+Tx*(m.Value+3)]:=IntToStr(W[j]);
if Lyamda[j]<>-1000 then sgMatrix.Cells[j,m.Value+3+Tx*(m.Value+3)]:=IntToStr(Lyamda[j]);
end;
end;
____________________Блок 11 ____________________
//пошук T в множині SetOmega
//VALUET - це елемент годині T
function TfmMainForm.SearchInSetOmega(ValueT,ValueX:integer;indI,indJ:byte):TSetOmega;
var i:byte;
HadFind:boolean;//найдено чи значення Value в множині SetOmega
begin
HadFind:=False;
for i:=1 to PrevPos do
if (ValueT=SetOmega.T) and
(indI=SetOmega.i) and

(indJ=SetOmega.j) then begin
HadFind:=True;
Result:=SetOmega;
end;
if not HadFind then begin
Result.T:=-1;
Result.X:=-1;
Result.i:=0;
Result.j:=0;
end;
end;
_____________________Блок 12 ____________________________
//пошук элементів T в рядку (Str=true) або стовпці (Str=false)
//у множині SetOmega
//ind - індекс рядка або стовпца
function TfmMainForm.SearchInSetOmega(ind:byte;Str:boolean):TSetOmega;
var i,j:byte;
HadFind:boolean;//найдено чи значення T в множині SetOmega
begin
HadFind:=False;
for i:=1 to PrevPos do
if Str then begin
for j:=1 to n.Value do
if (T[ind,j]=SetOmega.T) and(j=SetOmega.j) and(ind=SetOmega.i) then begin

HadFind:=True;
Result:=SetOmega;
end
end
else begin
for j:=1 to n.Value do
if (T[j,ind]=SetOmega.T) and(j=SetOmega.i) and(ind=SetOmega.j) then begin
HadFind:=True;
Result:=SetOmega;
end
end;
if not HadFind then begin
Result.T:=-1;
Result.X:=-1;
Result.i:=0;
Result.j:=0;
end;
end;
____________________Блок 13 _____________________________
//розрахунок мінімального елементу
function TfmMainForm.Min(а,b:integer):integer;
begin
if a<b then Result:=a
else Result:=b;
end;


____________________Блок 14 _____________________________
//відмітка рядків і стовпців
//ф-ція повертає елемент, находщийся на перетині останнього відміченого рядка
//і останнього відміченого стовпця
function TfmMainForm.OtmetkaStrStlb:TSetOmega;
var i,j
StrNum,StlbNum:byte;//номер відміченого рядка/стовпця
Continued:boolean; //продовження відмітки
ToDo:0..3;
SeveralStr,MinStr:0..5;//якщо відмічено кількість стовпцов/рядків
begin
for i:=1 to m.Value do begin
V:=-1000; W:=-1000;
Lyamda:=-1000; Mju:=-1000;
end;
StrNum:=0; StlbNum:=0; MinStr:=0;
//відмітка першого рядка, якщо такий є
for i:=1 to n.Value do
if (SearchInSetOmega(i,true).T<>-1)
and(SummaStrStlb(X,true,i) <A) then begin
V:=A-SummaStrStlb(X,True,i);
Mju:=0;
StrNum:=i;
end;
//якщо рядок відмічен, то шукаемо стовпци для відмітки

if StrNum<>0 then begin
repeat
Continued:=False; ToDo:=0; SeveralStr:=0;
//відмічаемо стовпец, якщо він не відмічен
for j:=1 to n.Value do
if (SearchInSetOmega(T[StrNum,j],X[StrNum,j],StrNum,j).T<>-1)
and(W[j]=-1000) then begin
if (SummaStrStlb(X,False,j) <B[j]) then ToDo:=1;
W[j]:=V[StrNum];
Lyamda[j]:=StrNum;
StlbNum:=j;
Result.T:=T[StrNum,j];
Result.X:=X[StrNum,j];
Result.i:=StrNum;
Result.j:=j;
end;
if ToDo<>1 then begin
for j:=1 to n.Value do
if (SummaStrStlb(X,False,j) <B[j]) and
(SummaStrStlb(X,False,j) >0) then Continued:=True;
for j:=1 to n.Value do begin
if (SearchInSetOmega(T[StrNum,j],X[StrNum,j],StrNum,j).T<>-1)
and(SummaStrStlb(X,False,j)=B[j]) and(Continued) then begin ToDo:=2; break; end;
if (SearchInSetOmega(T[StrNum,j],X[StrNum,j],StrNum,j).T<>-1)
and(SummaStrStlb(X,False,j)=B[j]) and(not Continued) then begin ToDo:=3; break; end;

end;
end;
case ToDo of
1:begin Posled(Result); break; end;
2:begin
//знаходимо мин. стовп, який вже відмічений
i:=m.Value;
while i>=1 do begin
if V=-1000 then
for j:=1 to n.Value do
if (SearchInSetOmega(T[i,j],X[i,j],i,j).T<>-1)
and (X[i,j]>0) and(W[j]<>-1000) and(X[i,j]<X[i,StlbNum])
then begin StlbNum:=j; i:=1; break; end;
i:=i-1;
end;
//відмічаемо рядок,якщо вона не відмічена
if Tx=5 then StlbNum:=4;
for i:=1 to m.Value do
if (SearchInSetOmega(T[i,StlbNum],X[i,StlbNum],i,StlbNum).T<>-1)
and (X[i,StlbNum]>0) and(V=-1000) then begin
inc(SeveralStr);
if (SeveralStr>1)
and(X[i,StlbNum]>X[StrNum,StlbNum]) then MinStr:=StrNum;
V:=Min(W[StlbNum],X[i,StlbNum]);
Mju:=StlbNum;
StrNum:=i;
end;

if MinStr>0 then StrNum:=MinStr;
end;
3:break;
end;
until 1>2;
end;
end;
_____________________Блок 15 _______________
//выделення послідовністі
procedure TfmMainForm.Posled(FirstMember:TSetOmega);
var i,j:byte;
P:array [1..3] of TSetOmega;
Vmin:integer;
begin
Vmin:=0;
//т.к. перший член послід-ті був переданий
//у кач-ве параметра FirstMember, то
P[1]:=FirstMember;
//шукаємо другий член посл-ті
for j:=1 to n.Value do
if (W[j]<>-1000) and
(V[FirstMember.i]=min(W[j],X[FirstMember.i,j]))and
(Mju[FirstMember.i]=j) then begin
P[2].T:=T[FirstMember.i,j];
P[2].X:=X[FirstMember.i,j];
P[2].i:=FirstMember.i;
P[2].j:=j;

end;
//шукаемо третій член посл-ті
for i:=1 to m.Value do
if (V<>-1000) and
(W[P[2].j]=V)and(Lyamda[P[2].j]=i) then begin
P[3].T:=T[i,P[2].j];
P[3].X:=X[i,P[2].j];
P[3].i:=i;
P[3].j:=P[2].j;
end;
//улучшення плану
Vmin:=min(W[FirstMember.j](B[FirstMember.j]-SummaStrStlb(X,False,FirstMember.j)));
for i:=1 to 3 do
if ((i mod 2)=1) then X[P.i,P.j]:=X[P.i,P.j]+Vmin
else X[P.i,P.j]:=X[P.i,P.j]-Vmin;
end;
_____________________Блок 16 ____________________________
//пошук мінімального T і додавання його в множину SetOmega
//Position - позиція елементу, з якого починаеться пошук
//ф-ція повертає номер позиції останнього знайденого мінімального елементу
//для даної ітерації Tx
function TfmMainForm.minimT(Position:byte):byte;
var i,j,Temp:byte;
begin

for i:=1 to m.Value do
for j:=1 to n.Value do
if (Tx=0) and(SetOmega[Position].T>T[i,j]) then begin
SetOmega[Position].T:=T[i,j];
SetOmega[Position].X:=X[i,j];
SetOmega[Position].i:=i; SetOmega[Position].j:=j;
end
else
if (SetOmega[Position-1].T<T[i,j])
and(SetOmega[Position].T>T[i,j]) then begin
SetOmega[Position].T:=T[i,j];
SetOmega[Position].X:=X[i,j];
SetOmega[Position].i:=i; SetOmega[Position].j:=j;
end;
//коли точно відомий мінімальний елемент
//шукаемо елементи рівні йому (коли таки є)
Temp:=Position;
for i:=1 to m.Value do
for j:=1 to n.Value do begin
if (SetOmega[Position].T=T[i,j])
and(SetOmega[Temp].i<>i)
and(SetOmega[Temp].j<>j) then begin
inc(Position);
SetOmega[Position].T:=T[i,j];
SetOmega[Position].X:=X[i,j];
SetOmega[Position].i:=i; SetOmega[Position].j:=j;
end;

end;
Result:=Position;
end;
______________________Блок 17 __________________
procedure TfMmainForm.Init;
var i,j:byte;
begin
for j:=1 to n.Value do begin
W[j]:=-1000;
Lyamda[j]:=-1000;
end;
PrevPos:=0; Tx:=0;
for i:=1 to m.Value*n.Value do begin
SetOmega.T:=1000;
SetOmega.X:=0;
SetOmega.i:=0; SetOmega.j:=0;
end;
for i:=1 to m.Value do begin
V:=-1000;
Mju:=-1000;
for j:=1 to n.Value do begin
T[i,j]:=StrToInt(sgMatrix.Cells[j,i]);
X[i,j]:=-1000;
end;
end;
end;


_____________________Блок 18 _____________________
procedure TfmMainForm.FormShow(Sender: TObject);
begin
sgMatrix.Cells[0,1]:='1';
sgMatrix.Cells[1,0]:='1';
end;
procedure TfmMainForm.sgMatrixDrawCell(Sender: TObject; ACol
ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
if (sgMatrix.Cells[0,ARow]='b(i)') or
(sgMatrix.Cells[0,ARow]='щ(i)')or
(sgMatrix.Cells[0,ARow]='л(i)') then with sgMatrix.Canvas do begin
Brush.Color:=clSkyBlue;
Rect.Right:=Rect.Right+(sgMatrix.ColCount*
*sgMatrix.DefaultColWidth);
Rect.Bottom:=Rect.Bottom+sgMatrix.DefaultRowHeight;
FillRect(Rect);
TextOut(Rect.Left+5,Rect.Top,sgMatrix.Cells[ACol,ARow]);
end;
if ACol>=n.Value+1 then with sgMatrix.Canvas do begin
Brush.Color:=clSkyBlue;
Rect.Right:=Rect.Right+(sgMatrix.ColCount*
*sgMatrix.DefaultColWidth);
Rect.Bottom:=Rect.Bottom+sgMatrix.DefaultRowHeight*5;
FillRect(Rect);
TextOut(Rect.Left+5,Rect.Top,sgMatrix.Cells[ACol,ARow]);
end;

end;
____________________Блок 19 _____________________________
procedure TfmMainForm.PrintOtvet();
var OtvL:TQRLabel;
begin
//========= відповідь ============
with fmPrint do begin
OtvL:=TQRLabel.Create(nil);
OTVL.Parent:=QuickRep1;
OTVL.Left:=QRLabel2.Left;
OTVL.Top:=70+TbHeight+25;
OTVL.Caption:='Ответ: Smin = '+IntToStr(SummaMatrix(X,T))+
' Tx = '+IntToStr(Tx);
end;
end;
//============ вивод ісходних даних ==============
procedure TfmMainForm.PrintIshDan(TbTop:integer;Ar:TMatrix);
var
Tb:TQRShape;//рамка таблиці
HLbl,BLbl:array [1..nn+1] of TQRLabel; //гориз. Label
VLbl,ALbl:array [1..mm+1] of TQRLabel; //вертик. Label
HLine:array [1..mm+1] of TQRShape; //гориз. лінії
VLine:array [1..nn+1] of TQRShape; //верт. лінії
ArLbl:array [1..mm,1..nn] of TQRLabel; //вывод Cij
i,j:byte;
begin
with fmPrint do begin

//================ рамка =====================
Tb:=TQRShape.Create(nil);
Tb.Parent:=QuickRep1;
Tb.Left:=(QuickRep1.Width div 2)-((nn+2)*40 div 2);
Tb.Top:=TbTop;
Tb.Height:=(mm+2)*40;
TbHeight:=Tb.Height;
Tb.Shape:=qrsRectangle;
Tb.Width:=(nn+2)*40;
//========= вивод по горизонталі ===============
for j:=1 to nn+1 do begin
VLine[j]:=TQRShape.Create(nil);
HLbl[j]:=TQRLabel.Create(nil);
BLbl[j]:=TQRLabel.Create(nil);
try
//вертикальні лінії
VLine[j].Parent:=QuickRep1;
VLine[j].Left:=Tb.Left+j*40;
VLine[j].Top:=Tb.Top;
VLine[j].Height:=Tb.Height;
VLine[j].Width:=0;
VLine[j].Shape:=qrsVertLine;
//1,2,3,4,5..... по горизонталі
HLbl[j].Parent:=QuickRep1;
HLbl[j].AutoSize:=True;
HLbl[j].Font.Style:=[fsBold];
HLbl[j].Left:=VLine[j].Left+15;

HLbl[j].Top:=Tb.Top+15;
if (j<>(nn+1)) then
HLbl[j].Caption:=inttostr(j)
else HLbl[j].Caption:='A(i)';
HLbl[j].Parent:=QuickRep1;
HLbl[j].AutoSize:=True;
//=======B[j]==========
BLbl[j].Parent:=QuickRep1;
BLbl[j].AutoSize:=True;
BLbl[j].Font.Style:=[fsBold];
BLbl[j].Left:=HLbl[j].Left-5;
BLbl[j].Top:=Tb.Top+Tb.Height-25;
if (j<>(nn+1)) then
BLbl[j].Caption:=IntToStr(fmMainForm.B[j])
except
HLbl[j].Free;
VLine[j].Free;
end;
end;
//========= вивід по вертикалі ==================
for i:=1 to mm+1 do begin
HLine:=TQRShape.Create(nil);
VLbl:=TQRLabel.Create(nil);
ALbl:=TQRLabel.Create(nil);
try
//горизонтальні лінії
HLine.Parent:=QuickRep1;

HLine.Left:=Tb.Left;
HLine.Top:=Tb.Top+i*40;
HLine.Shape:=qrsHorLine;
HLine.Height:=0;
HLine.Width:=Tb.Width;
//1,2,3,4,5..... по вертикалі
VLbl.Parent:=QuickRep1;
VLbl.AutoSize:=True;
VLbl.Font.Style:=[fsBold];
VLbl.Top:=HLine.Top+15;
VLbl.Left:=Tb.Left+15;
if (i<>(mm+1)) then
VLbl.Caption:=inttostr(i)
else VLbl.Caption:='B(j)';
//====== виведення A===========
ALbl.Parent:=QuickRep1;
ALbl.AutoSize:=True;
ALbl.Font.Style:=[fsBold];
ALbl.Left:=Tb.Left+Tb.Width-30;
ALbl.Top:=VLbl.Top;
if (i<>(mm+1)) then
ALbl.Caption:=IntToStr(fmMainForm.A)
except
HLine.Free;
VLbl.Free;
end;
end;

//============ виведення Cij ======================
for i:=1 to mm do
for j:=1 to nn do begin
ArLbl[i,j]:=TQRLabel.Create(nil);
ArLbl[i,j].Parent:=QuickRep1;
ArLbl[i,j].AutoSize:=True;
ArLbl[i,j].Top:=HLine.Top+15;
ArLbl[i,j].Left:=VLine[j].Left+10;
if Ar[i,j]<>-1000 then
ArLbl[i,j].Caption:=IntToStr(Ar[i,j]);
end;
end;
end;
procedure TfmMainForm.btnPrintClick(Sender: TObject);
begin
fmPrint.QuickRep1.Preview;
end;
end;

и на выходе получить:
 

Вложения