написанные программы / задание №7 — 1 / LAB7S

Program Lab7;
uses Memory, Drivers, Objects, Dialogs, Views, Menus, App,Editors,StdDlg,Crt,Dos;

Const
Com1 : TCommandSet = [cmPaste];
Com2 : TCommandSet = [cmOpen];

type
PSWindow = ^TSWindow;
TSWindow = object(TDialog)
constructor Init;
procedure HandleEvent(var Event : TEvent); Virtual;
destructor Done;virtual;
end;

PPickWindow = ^TPickWindow;
TPickWindow = object(TDialog)
constructor Init;
procedure HandleEvent(var Event : TEvent); Virtual;
destructor Done;virtual;
end;

TProg = object(TApplication)
PickWindow: PPickWindow;
procedure InitMenuBar; Virtual;
procedure InitStatusLine; Virtual;
procedure HandleEvent(var Event : TEvent); Virtual;
procedure Paste;
Procedure Look;
Procedure Window;
Procedure Add;
end;

var
Prog : TProg;
f : Text;
InfoList : PStringCollection;
i,y : Byte;
kol : Integer;
s : String;
Control: PView;
SWindow : PSWindow;
IName, IUPok, IUProd, IDPok, IDProd, IFPok, IFProd : PInputLine;
Name, UPok, UProd, DPok, DProd, FPok, FProd : String;

constructor TPickWindow.Init;
var
R: TRect;
Control: PView;
ScrollBar: PScrollBar;
begin
y := 16;
R.Assign(0, 0, 75, 16);
inherited Init(R, '‘ЇЁб®Є Є®¬Ї ­Ё©');
Options := Options or ofCentered;
R.Assign(69, 4, 70, 12);
New(ScrollBar, Init(R));
Insert(ScrollBar);
R.Assign(5, 4, 69, 12);
Control := New(PListBox, Init(R, 1, ScrollBar));
Insert(Control);
PListBox(Control)^.NewList(InfoList);
R.Assign(5, 3, 14, 4);
Insert(New(PLabel, Init(R, 'Љ®¬Ї ­Ёп', Control)));
for i := 1 to 3 do begin
R.Assign(y, 3, y+8, 4);
Insert(New(PLabel, Init(R, 'Џ®ЄгЇЄ ', Control)));
y := y +18;
end;
y := 26;
for i := 1 to 3 do begin
R.Assign(y, 3, y+8, 4);
Insert(New(PLabel, Init(R, 'Џа®¤ ¦ ', Control)));
y := y + 17;
end;
R.Assign(23, 2, 28, 3);
Insert(New(PLabel, Init(R, 'USD', Control)));
R.Assign(41, 2, 44, 3);
Insert(New(PLabel, Init(R, 'DM', Control)));
R.Assign(58, 2, 61, 3);
Insert(New(PLabel, Init(R, 'FM', Control)));
R.Assign(32, 13, 42, 15);
Insert(New(PButton, Init(R, '~O~k', cmOk, bfDefault)));
end;

Destructor TPickWindow.Done;
begin
Inherited Done;
EnableCommands(Com1);
EnableCommands(Com2);
end;



procedure TPickWindow.HandleEvent(var Event: TEvent);
begin
inherited HandleEvent(Event);
if Event.What = evCommand then
begin
case Event.Command of
cmOk:
begin
Done;
end;
end;
end;
end;

constructor TSWindow.Init;
var
R: TRect;
Control : PView;
begin
{ R.Assign(0, 0, 70, 15);
inherited Init(R, '‚бв ўЄ ');
Options := Options or ofCentered;
R.Assign(1, 5, 60, 6);
Insert(New(PLabel, Init(R, 'Ќ®¬Ё­ «', Control)));
R.Assign(2, 6, 60, 7);
INominal := New(PInputLine, Init(R,5));
Insert(INominal);
R.Assign(1, 8, 60, 9);
Insert(New(PLabel, Init(R, 'Љгаб', Control)));
R.Assign(2, 9, 60, 10);
ICurs := New(PInputLine, Init(R,5));
Insert(ICurs);
R.Assign(30, 12, 40, 14);
Insert(New(PButton, Init(R, '~O~k', cmOk, bfDefault)));
R.Assign(1, 2, 60, 3);
Insert(New(PLabel, Init(R, 'Ќ §ў ­ЁҐ Є®¬Ї ­ЁЁ', Control)));
R.Assign(2, 3, 60, 4);
IName := New(PInputLine, Init(R,28));
Insert(IName);}
end;

Destructor TSWindow.Done;
begin
Inherited Done;
EnableCommands(Com1);
EnableCommands(Com2);
end;

procedure TSWindow.HandleEvent(var Event: TEvent);
var
R: TRect;
i,j,k : Integer;
s: String;
begin
{ inherited HandleEvent(Event);
if Event.What = evCommand then
begin
case Event.Command of
cmOk:
begin
Name := IName^.Data^;
DPok := IDpok^.Data^;
DProd := IDprod^.Data^;
UPok := IUPok^.Data^;
UProd := IUProd^.Data^;
FPok := IFPok^.Data^;
FProd := IFProd^.Data^;
if (Name = '') or (Dprod = '') or (DPok = '') then Done
else begin i := (36-length(Upok)) - length(name);
s := Name;
for j := 1 to i do s := s + ' ';
s := s + UPok;
i := 56 - (length(Dprod)+length(s));
for j:= 1 to i do s := s+ ' ';
s := s + Uprod;
InfoList^.Insert(NewStr(S));
Done;
end;
end;
end;
end; }
end;

procedure TProg.HandleEvent(var Event: TEvent);
begin
inherited HandleEvent(Event);
if Event.What = evCommand then
begin
case Event.Command of
cmPaste:
begin
Paste;
ClearEvent(Event);
end;
cmOpen:
begin
Look;
ClearEvent(Event);
end;
end;
end;
end;

procedure TProg.InitMenuBar;
var
R: TRect;
begin
GetExtent(R);
R.B.Y := R.A.Y + 1;
MenuBar := New(PMenuBar, Init(R, NewMenu(NewItem
('Џа®б¬®ва','',kbF9, cmOpen, hcNoContext,
NewItem('“¤ «Ґ­ЁҐ','',kbF10, cmPaste, hcNoContext,nil)))));
end;

procedure TProg.InitStatusLine;
var
R: TRect;
begin
GetExtent(R);
R.A.Y := R.B.Y - 1;
New(StatusLine, Init(R,
NewStatusDef(0, $EFFF,
NewStatusKey('~F10~ ЊҐ­о', kbF10, cmMenu,
NewStatusKey('~Alt-X~ ‚л室', kbAltX, cmQuit,nil)),nil)));
end;



procedure TProg.Add;
begin
SWindow := New(PSWindow, Init);
InsertWindow(SWindow);
end;

procedure TProg.Window;
begin
PickWindow := New(PPickWindow, Init);
InsertWindow(PickWindow);
end;



procedure TProg.Paste;
begin
DisableCommands(Com1);
DisableCommands(Com2);
Add;
end;

procedure TProg.Look;
begin
{DisableCommands(Com1);}
DisableCommands(Com2);
Window;
end;

begin
kol := 0;
clrscr;
assign(f,'hwpc.txt');
Reset(f);
InfoList := New(PStringCollection, Init(100, 10));
for i := 1 to 5 do readln(f,s);
While NOT Eof(f) do begin
Readln(f, s);
if s <> '' then InfoList^.Insert(NewStr(S));
inc(kol);
end;
Prog.Init;
Prog.Run;
Prog.Done;
close(f);
end.