Файлы .tpu

[kira[:D]]

В самоучителе паскаля в конце разбирается программа NOTEBOOK

вот её код

[QUOTE]Program Notebook;
Uses App,Objects,Menus,Drivers,Views,Std Dlg,DOS,Memory,Dialogs;
type
PWorkWin=^TWorkWin;
TWorkWin=object(TWindow)
Constructor Init(Bounds: TRect);
end;
PDlgWin =^TDlgWin;
TDlgWin =object(TDialog)
Procedure HandleEvent(var Event:TEvent);
Virtual;
end;
PInterior =^TInterior;
TInterior = object(TScroller)
PS:PStringCollection;
Location:Word;
Constructor Init(var Bounds: TRect; HS,VS: PScrollBar);
Procedure Draw;
Virtual;
Procedure ReadFile;
Destructor Done;
Virtual;
Procedure HandleEvent(var Event: TEvent);
Virtual;
end;
TNotebook=object(TApplication)
Procedure InitStatusLine;
Virtual;
Procedure InitMenuBar;
Virtual;
Procedure HandleEvent(var Event: TEvent);
Virtual;
Procedure FileSave;
Procedure ChangeDir;
Procedure DOSCall;
Procedure FileOpen;
Procedure Work;
end;
const
cmChDir = 202; {Сменить каталог}
cmWork = 203; {Обработать данные}
cmDOS= 204; {Временно выйти в ДОС}
cmCan= 205; {Команда завершения работы}
cmDelete= 206; {Уничтожить текущую запись}
cmSearch = 207;{Искать нужную запись}
cmEdit = 209;{Редактировать запись}
cmAdd = 208;{Добавить запись}
WinCom1:TCommandSet=[cmSave,cmWork];
WinCom2:TCommandSet=[cmOpen];
LName = 25; {Длина поля Name}
LPhone= 11; {Длина поля Phone}
LAddr =40; {Длина поля Addr}
LLine=LName+LPhone+LAddr; {Длина строки}
type
DataType=record {Тип данных в файле}
Name:String[LName]; {Имя}
Phone:String[LPhone]; {Телефон}
Addr:String[LAddr] {Адрес}
end;
var
DataFile: file of DataType; {Файловая переменная}
OpFileF:Boolean; {Флаг открытого файла}
Constructor TWorkWin.Init(Bounds: TRect);
var
HS,VS: PScrollBar; {Полосы-указатели}
Interior: PInterior; {Указатель на управляемое текстовое окно}
begin
TWindow.Init(Bounds,0);{Создаем новое окно с рамкой}
GetClipRect(Bounds); {Получаем в BOUNDS координаты минимальной перерисовываемой части окна}
Bounds.Grow(-1,-1);{Устанавливаем размеры окна с текстом}
VS:=StandardscrollBar(sbVertical+sb HandleKeyBoard) ;
HS:=StandardscrollBar(SbHorizontal+ sbHandleKeyBoard) ;
Interior:=New(PInterior, Init(Bounds, HS, VS)) ;
Insert(Interior) {Включаем его в основное окно}
end; {TWorkWin.Init}
Procedure TDlgWin.HandleEvent;
begin
Inherited HandleEvent(Event) ;
if Event.What=evCommand
then
EndModal(Event.Command)
end;
Procedure TNotebook.FileOpen;
var
PF: PFileDialog; {Диалоговое окно выбора файла}
Control: Word;
s: PathStr;
begin
New(PF, Init('*.dat','Выберите нужный файл:', 'Имя файла',fdOpenButton,0))
Control := DeskTop^.ExecView(PF);
case Control of
StdDlg.cmFileOpen,cmOk:
begin {Пользователь указал имя файла:}
PF^.GetFileName(s); {s содержит имя файла}
Assign(DataFile,s);
Reset(DataFile);
if IOResult <> 0 then
Rewrite(DataFile);
OpFileF := IOResult=0;
if OpFileF
then
begin
DisableCommands(WinCom2);
EnableCommands(WinCom1);
Work
end
end;
end; {case Control}
Dispose(PF,Done) {Уничтожаем экземпляр}
end; {FileOpen}
Procedure TNotebook.FileSave; {Закрывает файл данных} begin
Close(DataFile);
OpFileF := False;
EnableCommands(WinCom2);
DisableCommands(WinCom1) {Запрещаем работу и сохранение}
end;
Procedure TNotebook.ChangeDir;
var
PD: PChDirDialog; {Диалоговое окно смены каталога/диска}
Control: Word;
begin
New(PD, Init(cdNormal,0)); {Создаем диалоговое окно}
Control := DeskTop^.ExecView(PD); {Используем окно}
Choir(PD^.DirInput^.Data^); {Устанавливаем новый каталог}
Dispose(PD, Done) {Удаляем окно из кучи}
end; {TNotebook.ChangeDir}
Procedure TNotebook.DOSCall;
const
txt ='Для возврата введите EXIT в ответ'+ ' на приглашение ДОС...';
begin
DoneEvents; {Закрыть обработчик событий}
DoneVideo; {Закрыть монитор экрана}
DoneMemory; {Закрыть монитор памяти}
SetMemTop(HeapPtr); {Освободить кучу}
WriteLn(txt); {Сообщить о выходе}
SwapVectors; {Установить стандартные векторы}
Exec(GetEnv('COMSPEC'),''); {Вернуться из ДОС:}
SwapVectors; {Восстановить векторы}
SetMemTop(HeapEnd); {Восстановить кучу}
InitMemory;{Открыть монитор памяти}
InitVideo; {Открыть монитор экрана}
InitEvents; {Открыть обработчик событий}
InitSysError; {Открыть обработчик ошибок}
//остальной код смотрите в нижних сообщениях

В паскале ABC модули .tpu не находятся...В турбо паскале при компиляции получается окно Form1 ,но никакие значения в "записную книжку" не заносятся....(Запускал на виртуалке под турбо паскалем)....
Компилировал lazarus'ом....

В общем - Можно ли как-то настроить Pascal Abc на .tpu файлы чтобы видел или как-то Исправить код чтобы он реально представлял записную книгу..а то окошко ниочём...

p.s.При отправке были допущены следующие ошибки:
Вы ввели слишком длинный текст (14962 символов). Пожалуйста, сократите его до 5000 символов.

[kira[:D]]

Redraw {Восстановить вид экрана}
end; {DOSCall}
Constructor TInterior.Init;
begin
TScroller.Init(Bounds, Hs, VS);
ReadFile;
GrowMode := gfGrowHiX+gfGrowHiY;
SetLimit(LLine, РS^.Count)
end;
Destructor TInterior.Done;
begin
Dispose (PS, Done) ;
Inherited Done
end ;
Procedure TInterior.ReadFile;
var
k: Integer;
s: String;
Data: DataType;
f: text;
begin
PS := New(PStringGollection, Init (100, 10) );
seek(DataFile,0) ;
while not (EOF(DataFile) or LowMemory) do
begin
ReadfDataFile,data) ;
with data do
begin
s : = Name ;
while Length (s) < LName do
s : = s+ ' ' ;
s := s+Phone;
while Length (s) < LName+LPhone do
s : = s+ ' ' ;
s := s+Addr
end;
if so'' then PS^. insert (NewStr (S) )
end;
Location := 0;
end; {ReadFile}
Procedure TInterior.Draw;
var
n,k: Integer;
В:TDrawBuffer;
Color: Byte;
p: PString;
begin
if Delta.Y>Location then
Location := Delta.Y;
if Location>Delta.Y+pred(Size.Y) then
Location := Delta.Y+pred(Size.Y) ;
for n := 0 to pred(Size.Y) do
begin
k:=Delta.Y+n;
if k=Location then
Color := GetColor(2)
else
Color := GetColor(1);
MoveCharfB,' ', Color, Size. X) ;
if k < pred(PS^. count)
then
begin
p := PS^.At(k) ;
MoveStr(B, Copy (р^, Delta. X+1, Size. X) , Color) ;
end;
WriteLine(0,N,Size.X,1,B)
end
end; {Tlnterior.Draw}
Function Control: Word;
const X = 1;
L = 12;
DX= 13;
But: array [0..4] of String [13] = {Надписи на кнопках:}
('~l~ Выход ' , ' ~2~ Убрать ','~3~ Искать ','~4~ Изменить ','~5~ Добавить');
Txt: array [0..3] of String [52] = (
'Убрать - удалить запись, выделенную цветом ',
'Искать - искать запись, начинающуюся нужными буквами',
'Изменить - изменить поле (поля) выделенной записи',
'Добавить - добавить новую запись');
var
R: TRect;
D: PDlgWin;
k: Integer;
begin
R.Assign(7,6,74,15) ;
D := New(PDlgWin,Init(R, 'Выберите продолжение:'));
with D^ do begin
for k := 0 to 3 do{Вставляем поясняющий текст}
begin
R.Assign(1,1+k,65,2+k) ;
Insert (New(PStaticText,Init(R,#3+Txt[k])))
end;
for k := 0 to 4 do {Вставляем кнопки:}
begin
R.Assign(X+k*DX,6,X+k*DX+L,8) ;
Insert(New(PButton, Init(R,But[k] ,cmCan+k,bf Normal)))
end;
SelectNext False) ; {Активизируем первую кнопку}
end;
Control:=DeskTop^.ExecView(D) ; {Выполняем диалог}
end;
Procedure TInterior.HandleEvent;
Procedure DeleteItem;
var
D: Integer;
PStr: PString;
s: String;
Data: DataType;
begin
PStr := PS^.At(Location); {Получаем текущую запись}
s := copy(PStr^,1,LName);
seek(DataFile,0);
D := -1; {D - номер записи в файле}
repeat {Цикл поиска по совпадению поля Name:}
inc(D) ;
read(DataFile,Data);
with Data do while Length(Name) < LName do
Name := Name+' '
until Data.Name=s;
seek(DataFile,pred(FileSize(DataFil e)));
read(DataFile,Data); {Читаем последнюю запись}
seek(DataFile,D);
write(DataFile,Data); {Помещаем ее на место удаляемой}
seek(DataFile,pred(Filesize(DataFil e)));
truncate(DataFile); {Удаляем последнюю запись}
with PS^ do D := IndexOf(At(Location));
PS^.AtFree(D); {Удаляем строку из коллекции}
Draw {Обновляем окно}
end;
Procedure AddItemfEdit: Boolean);
{Добавляет новый или редактирует старый элемент данных}
const у = 1;
dy= 2;
L=LName+LPhone+LAddr;
var
Data: DataType;
R: TRect;
InWin: PDialog;
BName,BPhone,BAddr: PInputLine;
Control: Word;
OldCount: Word;
s: String;
p: PString;
begin
Seek(DataFile,Filesize(DataFile));{ Добавляем записи в конец файла}
repeat {Цикл ввода записей}
if Edit then {Готовим заголовок}
s := 'Редактирование:'
else
begin
Str(Filesize(DataFile)+1,s);
while Length(s) < 3 do
s := '0'+s;
s := 'Вводится запись N '+s
end;
FillChar(Data,SizeOf(Data),' ');{Заполняем поля пробелами}
R.Assign(15,5,65,16);
InWin := New(PDialog, Init(R, s));{Создаем окно}
with InWin^ do
begin
R.Assign(2,y+1,2+LName,y+2); {Формируем окно:}
BName := New(PInputLine, Init(R,LName))
Insert(BName); {Поле имени}
R.Assign(2,y,2+LName,y+1) ;
Insert(New(PLabel, Init(R, 'Имя',BName)));
R.Assign(2,y+dy+1,2+LPhone,y+dy+2);
BPhone := NewtPInputLine, Init(R,LPhone));
Insert(BPhone); {Поле телефон}
R.Assign(2,y+dy,2+LPhone,y+dy+1);
Insert(New(PLabel,Init(R,'Телефон', BPhone)));
R.Assign(2,y+2*dy+1,2+LAddr,y+2*dy+ 2) ;
BAddr := New(pinputLine,Init(R,LAddr));
Insert(BAddr); {Поле адреса}
R.Assign)2,y+2*dy,2+LAddr,y+2*dy+1) ;
Insert(New(PLabel, Init(R, 'Адрес',BAddr)));
R.Assign(2,y+3*dy+1,12,y+3*dy+3);
Insert(New(PButton, Init(R, 'Ввести',cmOK,bfDefault))) ;

[kira[:D]]

R.Assign(2+20,y+3*dy+1,12+20,y+3*dy +3) ;
Insert(NewfPButton, Init(R, 'Выход',cmCancel,bfNormal)
SelectNext(False) {Активизируем первую кнопку}
end; {Конец формирования окна}
if Edit then with Data do
begin {Готовим начальный текст:}
p := PS^.At(Location); {Читаем данные из записи}
s := p^;
Name := copy(s,1,LName);
Phone:= copy(s,succ(LName),LPhone);
Addr := copy(s,succ(LName+LPhone),LAddr);
InWin^.setData(Data) {Вставляем текст в поля ввода}
end;
Control := DeskTop^.ExecView(InWin); {Выполняем диалог}
if Control=cmOk then with Data do
begin
if Edit then
DeleteItem; {Удаляем старую запись}
Name := BName^.Data^;
Phone:= BPhone^.Data^;
Addr := BAddr^.Data^;
s[0] := chr(L) ;
FillChar(s [1] , L, ' ') ;
move (Name [1] ,s [1] ,Length (Name)) ;
move(Phone[1],s[succ(LName)],Length(Phone));
move(Addr[1],s[succ(LName+LPhone)],Length(Addr)
OldCount := PS^. Count; {Прежнее количество записей}
PS^.Insert(NewStr(s)) ; {Добавляем в коллекцию}
if OldCount <> PS^. Count then
Write (DataFile, Data) {Да - добавляем в файл}
end
until Edit or (Control=cmCancel) ;
Draw
end; {AddItem}
Procedure SearchItem;
Function UpString(s: String): String;
var
k: Integer;
begin
for k := 1 to Length(s) do
if s[k] in ['a'..'z'] then
s[k] := chr(ord('A')+ord(s[k])-ord('a') )
else if s[k] in ['a'..'n'] then
s[k]:= chr(ord('A')+ord(s[k])-ord('a') )
else if s[k] in ['p'..'я'] then
s[k] := chr(ord('P')+ord(s[k])-ord('p') )
UpString := s
end; {UpString}
var
InWin: PDialog;
R: TRect;
s: String;
p: PInputLine;
k: Word;
begin {SearchItem}
R.Assign(15,8,65,16) ;
InWin := New(PDialog,Init(R,'Поиск записи:'))
with InWin^ do
begin
R.Assign(2,2,47,3) ;
p := New(PInputLine,Init(R,50));
Insert(p) ;
R.Assign(1,1,40,2) ;
Insert(New(PLabel,Init(R,'Введите образец для поиска:',р)));
R.Assign(10,5,20,7) ;
Insert (New(PButton,Init(R,'Ввести',cmOk,b fDefault)));
R.Assign(25,5,35,7) ;
Insert (New(PButton,Init(R,' Выход' ,cmCancel,bf Normal)));
SelectNext(False)
end;
if DeskTop^.ExecView(InWin) = cmCancel then
exit;
s :=p^.Data^;
Location := 0;
while (UpString(s) >= UpString (PString(PS^. At (Location))^))
and (Location < pred(PS^.Count) ) do
inc(Location) ;
if (Location < Delta.Y) or (Location > Delta.Y+pred(Size.Y)) then
ScrollTo (Delta.X, Location)
else
Draw
end;
var
R: TPoint;
label Cls;
begin
TScroller.HandleEvent (Event) ;
case Event.What of
evCommand :
case Event.Command of
cmClose:
begin
Cls:
case Control of {Получить команду из основного диалогового окна}
cmCan,cmCancel: EndModal (cmCancel) ;
cmEdit : AddItem(True) ;
cmDelete: DeleteItem;
cmSearch: SearchItem;
cmAdd : AddItem(False);
end
end;
cmZoom: exit;
end;
evMouseDown: {Реакция на щелчок мышью}
begin
MakeLocal(MouseWhere, R);{Получаем в R локальные координаты указателя мыши}
Location := Delta.Y+R.Y;
Draw
end;
evKeyDown: {Реакция на клавиши + -}
case Event.KeyCode of

[kira[:D]]

kbEsc: goto Cls;
kbGrayMinus: if Location > Delta.Y then
begin
dec(Location); Draw
end;
kbGrayPlus: if Location < Delta.Y+pred(Size.Y)then
begin
inc(Location);
Draw
end;
end
end
end; {Tlnterior.HandleEvent}
Procedure TNotebook.Work;
var
R : TRect ;
PW : PWorkWin ;
Control: Word;
begin
R.Assign(0,0,80,23) ;
PW := New(PWorkWin,Init(R)) ;
Control := DeskTop^.ExecView(PW) ;
Dispose(PW,Done)
end;
Procedure TNOtebook.HandleEvent (var Event: TEvent) ;
begin {TNOtebook.HandleEvent}
TApplication.HandleEvent(Event) ;{Обработка стандартных команд cmQuit и cmMenu}
if Event.What = evCommand then
case Event.Command of
cmOpen: FileOpen; {Открыть файл}
cmSave: FileSave; {Закрыть файл}
cmChangeDir : ChangeDir; {Сменить диск}
cmDOSShell : DOSCall; {Временный выход в ДОС}
cmWork : Work; {Обработать данные}
else
exit {Не обрабатывать другие команды}
end;
ClearEvent(Event) {Очистить событие после обработки}
end; {TNOtebook.HandleEvent}
Procedure TNotebook.InitMenuBar;
var
R: TRect;
begin
GetExtent(R);
R.B.Y:=succ(R.A.Y); {R - координаты строки меню}
MenuBar := New(PMenuBar,Init(R,
NewMenu ( {Создаем меню}
{Первый элемент нового меню представляет собой подменю (меню второго уровня) . Создаем его} NewSubMenu ( '~F~/Файл' , hcNoContext,
{Описываем элемент главного меню}
NewMenu ( {Создаем подменю}
NewItem( {Первый элемент}
'~1~/ Открыть', 'F3 ', kbF3,cmOpen, hcNoContext,
NewItem( {Второй элемент}
'~2~/ Закрыть', 'F2',kbF2,cmSave,hcNoContext,
NewItem( {Третий элемент}
'~3~/ Сменить диск1 , ' ' , 0, cmChangeDir, hcNoContext,
NewLine( {Строка-разделитель}
NewItem( '~4~/ Вызов ДОС' , ' ' , 0, cmDOSShell, hcNoContext,
NewItem( '~5~/ Конец работы' , 'Alt-X' , kbAltX, cmQuit,hcNoContext,
NIL)))))) {Нет других элементов подменю} ),
NewItem('~W~/ Работа', ' ', kbF4,cmWork, hcNoContext,
NIL) {Нет других элементов главного меню}
))))
end; {TNotebook. InitMenuBar}
Procedure TNotebook. InitStatusLine;
var
R: TRect; {Границы строки статуса}
begin
GetExtent(R) ; {Получаем в R координаты всего экрана}
R.A.Y:=pred(R.B.Y) ;
StatusLine := New(PStatusLine,
Init(R, {Создаем строку статуса}
NewStatusDef(0, $FFFF, {Устанавливаем максимальный диапазон контекстной справочной службы}
NewStatusKey('~Alt-X~ Выход1, kbAltX, cmQuit,
NewStatusKey(I~F2~ Закрыть', kbF2, cmSaveFile,
NewStatusKey( '~F3~ Открыть', kbF3, cmOpenFile,
NewStatusKey( '~F4~ Работа', kbF4, cmWork,
NewStatusKey( '~F10~ Меню1, kbF10, craMenu,
NIL) ) ) ) ) , {Нет других клавиш}
NIL) {Нет других определений}
));
DisableCommands (WinCom1) {Запрещаем недоступные команды}
end; {TNotebook . InitStatusLine}
var
Nbook: TNotebook;
begin
Nbook.Init ;
Nbook.Run;
Nbook.Done
end.
[/QUOTE]

p.s.извините...программа не влезает..