Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла (страница 13)

Текст программы главного модуля

unit Main;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, ToolWin, ComCtrls, Grids, ExtCtrls;

const

Sep = #11#12;

type

TForm1 = class(TForm)

SG: TStringGrid;

ToolBar1: TToolBar;

btnDel: TButton;

btnAdd: TButton;

procedure FormCreate(Sender: TObject);

procedure btnDelClick(Sender: TObject);

procedure SGDrawCell(Sender: TObject; Col, Row: Integer; Rect: TRect;

State: TGridDrawState);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure btnAddClick(Sender: TObject);

procedure SGDblClick(Sender: TObject);

private

public

Contr : TStrings;

Index : Integer;

Function Data(J,N : Integer):String;

end;

var

Form1: TForm1;

implementation

uses Contrakt;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

Contr := TStringList.Create;

Try

Contr.LoadFromFile('KON.DAT');

Except

End;

If Contr.Count>0 Then SG.RowCount:=Contr.Count+1 Else SG.RowCount:=2;

btnDel.Enabled:=Contr.Count>0;

SG.Cells[0,0]:='№';

SG.Cells[1,0]:='Поставщик';

SG.Cells[2,0]:='Срок оплаты';

SG.Cells[3,0]:='Сумма к оплате';

SG.Cells[4,0]:='Погашено';

SG.Cells[5,0]:='Задолженность';

SG.ColWidths[0]:=24;

SG.ColWidths[1]:=233-GetSystemMetrics(SM_CXHSCROLL);

SG.ColWidths[2]:=70;

SG.ColWidths[3]:=85;

SG.ColWidths[4]:=85;

SG.ColWidths[5]:=85;

end;

Function TForm1.Data(J,N : Integer):String;

Var I,K : Integer;

Begin

Result:=Contr[N];

For I:=1 to J-1 do

Begin

K:=Pos(Sep,Result);

If K>0 Then Delete(Result,1,K+Length(Sep)-1);

End;

K:=Pos(Sep,Result);

If K>0 Then Delete(Result,K,Length(Result));

End;

procedure TForm1.SGDrawCell(Sender: TObject; Col, Row: Integer;

Rect: TRect; State: TGridDrawState);

Var S : String;

begin

If Row=0 Then

Begin

S:=SG.Cells[Col,0];

SG.Canvas.TextRect(Rect,Rect.Left+(SG.ColWidths[Col]-SG.Canvas.TextWidth(S)) div 2,Rect.Top+2,S);

End

Else If Contr.Count>0 Then

Begin

Case Col of

0 : S:=IntToStr(Row);

1 : S:=Data(2,Row-1);

2 : S:=Data(1,Row-1);

3 : S:=Data(3,Row-1);

4 : S:=Data(4,Row-1);

5 : S:=Data(5,Row-1);

End;

If StrToFloat(Data(5,Row-1))<=0 Then SG.Canvas.Brush.Color:=cl3DLight;

Case Col of

3,4,5 : SG.Canvas.TextRect(Rect,Rect.Left+SG.ColWidths[Col]-SG.Canvas.TextWidth(S)-4,Rect.Top+2,S);

1 : SG.Canvas.TextRect(Rect,Rect.Left+2,Rect.Top+2,S);

0,2 : SG.Canvas.TextRect(Rect,Rect.Left+(SG.ColWidths[Col]-SG.Canvas.TextWidth(S)) div 2,Rect.Top+2,S);

End;

End;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

Contr.SaveToFile('KON.DAT');

end;

procedure TForm1.btnAddClick(Sender: TObject);

begin

Index:=-1;

frmContract:=TfrmContract.Create(self);

frmContract.ShowModal;

btnDel.Enabled:=Contr.Count>0;

end;

procedure TForm1.btnDelClick(Sender: TObject);

begin

If MessageDlg('Удалить данные?',mtConfirmation,[mbYes,mbNo],0)=mrYes Then

Begin

Contr.Delete(SG.Row-1);

If SG.RowCount>2 Then SG.RowCount:=SG.RowCount-1 Else SG.Repaint;

End;

btnDel.Enabled:=Contr.Count>0;

end;

procedure TForm1.SGDblClick(Sender: TObject);

begin

Index:=SG.Row-1;

frmContract:=TfrmContract.Create(self);

frmContract.edtPost.Text:=Data(2,Index);

frmContract.edtDate.Text:=Data(1,Index);

frmContract.edtSum.Text:=Data(3,Index);

frmContract.edtPog.Text:=Data(4,Index);

frmContract.ShowModal;

end;

end.

ПРИЛОЖЕНИЕ 5

Текст программы модуля «Контракт».

unit Contrakt;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Buttons;

type

TfrmContract = class(TForm)

edtPost: TEdit;

Label1: TLabel;

btnOk: TBitBtn;

BitBtn2: TBitBtn;

Label2: TLabel;

Label3: TLabel;

edtDate: TEdit;

edtSum: TEdit;

edtPog: TEdit;

Label4: TLabel;

procedure edtSumChange(Sender: TObject);

procedure edtPostChange(Sender: TObject);

procedure edtDateChange(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure btnOkClick(Sender: TObject);

private

public

end;

var

frmContract: TfrmContract;

implementation

{$R *.DFM}

Uses Main;

procedure TfrmContract.edtSumChange(Sender: TObject);

begin

Try

StrToFloat(TEdit(Sender).Text);

TEdit(Sender).Font.Color:=clWindowText;

Except

TEdit(Sender).Font.Color:=clRed;

End;

btnOk.Enabled:=(edtSum.Font.Color=clWindowText)and(edtPost.Font.Color=clWindowText)and(edtDate.Font.Color=clWindowText);

end;

procedure TfrmContract.edtPostChange(Sender: TObject);

begin

If edtPost.Text<>'' Then edtPost.Font.Color:=clWindowText

Else edtPost.Font.Color:=clRed;

btnOk.Enabled:=(edtSum.Font.Color=clWindowText)and(edtPost.Font.Color=clWindowText)and(edtDate.Font.Color=clWindowText);

end;

procedure TfrmContract.edtDateChange(Sender: TObject);

begin

Try

StrToDate(edtDate.Text);

edtDate.Font.Color:=clWindowText;

Except

edtDate.Font.Color:=clRed;

End;

btnOk.Enabled:=(edtSum.Font.Color=clWindowText)and(edtPost.Font.Color=clWindowText)and(edtDate.Font.Color=clWindowText);

end;

procedure TfrmContract.FormCreate(Sender: TObject);

begin

edtDate.Text:=DateToStr(Now);

end;

procedure TfrmContract.btnOkClick(Sender: TObject);

Var S : String;

R : Real;

begin

S:=edtDate.Text+Sep+edtPost.Text+Sep+edtSum.Text+Sep;

If edtPog.Font.Color=clRed Then edtPog.Text:='0';

S:=S+edtPog.Text+Sep;

R:=StrToFloat(edtSum.Text)-StrToFloat(edtPog.Text);

S:=S+FloatToStr(R);

With Form1 do If Index=-1 Then

Begin

Contr.Add(S);

If Form1.Contr.Count>1 Then Form1.SG.RowCount:=Form1.SG.RowCount+1;

End Else Contr[Index]:=S;

Form1.SG.Repaint;

end;

end.

1 Охрана окружающей среды: Учеб. для техн. спец. вузов/ С. В. Белов, Ф.А. Барбинов, А.Ф. Козьяков и др. Под ред. С. В. Белова. 2-е изд., испр. и доп.‑ М.: Высш. шк., 1991, с. 57.

Характеристики

Список файлов ВКР