Borland Delphi 7.0

Тема в разделе "Pascal and Delphi", создана пользователем Катерина, 15 май 2014.

  1. Катерина

    Катерина New Member

    Регистрация:
    15 май 2014
    Сообщения:
    1
    Симпатии:
    0
    ____________________ Блок 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[i];
    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[i]:=-1000; W[i]:=-1000;
    Lyamda[i]:=-1000; Mju[i]:=-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[i]) then begin
    V[i]:=A[i]-SummaStrStlb(X,True,i);
    Mju[i]:=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[i]=-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[i]=-1000) then begin
    inc(SeveralStr);
    if (SeveralStr>1)
    and(X[i,StlbNum]>X[StrNum,StlbNum]) then MinStr:=StrNum;
    V[i]:=Min(W[StlbNum],X[i,StlbNum]);
    Mju[i]:=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[i]<>-1000) and
    (W[P[2].j]=V[i])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].i,P[i].j]:=X[P[i].i,P[i].j]+Vmin
    else X[P[i].i,P[i].j]:=X[P[i].i,P[i].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[i].T:=1000;
    SetOmega[i].X:=0;
    SetOmega[i].i:=0; SetOmega[i].j:=0;
    end;
    for i:=1 to m.Value do begin
    V[i]:=-1000;
    Mju[i]:=-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[i]:=TQRShape.Create(nil);
    VLbl[i]:=TQRLabel.Create(nil);
    ALbl[i]:=TQRLabel.Create(nil);
    try
    //горизонтальні лінії
    HLine[i].Parent:=QuickRep1;

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

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

    Вложения:

Загрузка...

Поделиться этой страницей