Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

TSPST_1 / TSPST

.PAS
Скачиваний:
9
Добавлен:
09.04.2015
Размер:
15.71 Кб
Скачать
{************************************************}
{ }
{ Turbo Pascal 6.0 }
{ Їа®Ја ¬¬  "ђ бзҐв ®ЎкҐ¬  ўл­Ё¬ Ґ¬®© §Ґ¬«Ё" }
{************************************************}
{$X+}
{$F+,O+,S-}
{$M 32768,65536,655360}
USES Dos, Objects, Drivers, Memory, Views, Menus, Dialogs, StdDlg1, Mesag2, App,
Calc1,FViewer, HelpFile,Dialtsp,Tspmet,Gauges,TipTsp,Crt,Printer,tsphl;

Const

cmChangeDir = 1001;
cmAbout = 1002;
cmAbout2 = 1003;
cmAbout3 = 1013;
cmAbout4 = 1014;
cmCalculator = 1006;
cmNewFileOpen = 1012;
cmOldFileOpen = 1021;
cmNewFile = 1004;
cmOldFile = 1005;

cmPrin = 1022;
cmInstp = 1028;
{ cmInstp1 = 1029;}
{ cmInstpStelf = 1030;}

cmFileWin = 1033;

Type
striin=string[5];

PTPappl= ^TTPappl;
TTPappl=object(TApplication)
Clock: PClockView;
Heap: PHeapView;
constructor Init;
procedure Idle;virtual;
procedure InitMenuBar; virtual;
procedure InitStatusLine; virtual;
procedure HandleEvent(var Event: TEvent); virtual;
procedure FileOpen(WildCard: PathStr;Str1:String;Str2:String; var FileName: PathStr;var CC: Word);
function GetPalette:PPalette; virtual;
procedure GetEvent(var Event: TEvent); virtual;
procedure NewFileOpen(ssss:striin);
procedure OldFileOpen(ssss:striin);
procedure About1;
end;

PHintStatusLine = ^THintStatusLine;
THintStatusLine = Object(TStatusLine)
function Hint(AHelpCtrx: Word): string; virtual;
end;
{ TFileWindow }

PFileWindow = ^TFileWindow;
TFileWindow = object(TWindow)
constructor Init(var FileName: PathStr);
end;
var
DanFile:TDosStream;
DanParamStream:TDosStream;
FileName,FileNameOpen: PathStr;
ini:boolean;


constructor TTPappl.Init;
var
R: TRect;
I: Integer;
begin
TApplication.Init;
RegisterTypes;
RegisterFViewer;
RegistrationDan;
{StreamRegistration;}
RegisterHelpFile;
GetExtent(R);
R.A.X := R.B.X - 9; R.B.Y := R.A.Y + 1;
Clock := New(PClockView, Init(R));
Insert(Clock);

{ GetExtent(R);
R.A.X := R.B.X - 9; R.A.Y := R.B.Y - 1;
Heap := New(PHeapView, Init(R));
Insert(Heap); }
About1;
ini:=false;
FileNameOpen:='';
end;

{THintStatusLine}
function THintStatusLine.Hint(AHelpCtrx: Word): string;
begin
case AHelpCtrx of

1121..1357: Hint:='Tab/Shift-Tab - ЇҐаҐ¬ҐйҐ­ЁҐ ў­Ё§/ўўҐае ';
else Hint:='';
end;
end;

procedure TTPappl.About1;
var
D: PDialog;
Control: PView;
R: TRect;
B: PView;
begin
R.Assign(0, 0, 54, 20);
D := New(PDialog, Init(R, '‘Їа ўЄ '));
with D^ do
begin
Options := Options or ofCentered;
R.Grow(-1, -1);
Dec(R.B.Y, 1);
R.Assign(1, 1, 53, 5);
Insert(New(PStaticText, Init(R,
^C' ЙНННННННННН ‚ Ќ € Њ Ђ Ќ € … ! НННННННННН»'+
#13 + ^C' є ќв® ®Є­® Ї®пў«пҐвбп в®«мЄ® ®¤Ё­ а § - є'+
#13 + ^C' є ба §г Ї®б«Ґ § ЇгбЄ  ЏђЋѓђЂЊЊ› є'+
#13 + ^C' ИНННННННННННННННННННННННННННННННННННННННј')));
R.Assign(1, 5,53,7);
Insert(New(PStaticText, Init(R,
^C' 1. …б«Ё ‚л ўЇҐаўлҐ Ё¬ҐҐвҐ ¤Ґ«® б нв®© ЏђЋѓђЂЊЊЋ‰,'+
#13^C'в® ­ з­ЁвҐ б Ё§г祭Ёп ЏђЂ‚€‹ ђЂЃЋ’› ‘ Ќ…‰.')));
R.Assign(1, 7,53,9);
Insert(New(PStaticText, Init(R,
^C'„«п ўл§®ў  ЏђЂ‚€‹ Ї®б«Ґ¤®ў вҐ«м­® '+
#13 + ^C' ­ ¦¬ЁвҐ Є« ўЁиЁ <ENTER>, <F7>. ')));

R.Assign(1, 10, 53, 12);
Insert(New(PStaticText, Init(R,
^C' 2. €Ќ‘’ђ“Љ–€ћ Є Їа®Ја ¬¬Ґ ¬®¦­® ўл§ў вм'+
' Ё§ Њ…Ќћ Їа®Ја ¬¬л.')));
R.Assign(1, 13, 53, 17);
Insert(New(PStaticText, Init(R,
^C' 3. ЋЇЁб ­ЁҐ вҐе­ЁЄЁ а Ў®вл б ЋЉЌЂЊ€ ¤ ­® '+
#13^C'ў а §¤Ґ«Ґ "„€Ђ‹ЋѓЋ‚›… ЋЉЌЂ".'+
#13^C' …Ј® ¬®¦­® ўл§ў вм Ё§ Њ…Ќћ Ў«®Є  "1 ‘…ђ‚€‘".')));
R.Assign(22, 17, 33, 19);
Insert(New(PButton, Init(R, '~„~ «ҐҐ', cmOk, bfDefault)));
end;
if ValidView(D) <> nil then
begin
Desktop^.ExecView(D);
Dispose(D, Done);
end;
end;

{ TFileWindow }
constructor TFileWindow.Init(var FileName: PathStr);
const
WinNumber: Integer = 1;
var
R: TRect;
begin
Desktop^.GetExtent(R);
TWindow.Init(R, Filename, WinNumber);
Options := Options or ofTileable;
Inc(WinNumber);
GetExtent(R);
R.Grow(-1, -1);
Insert(New(PFileViewer, Init(R,
StandardScrollBar(sbHorizontal + sbHandleKeyboard),
StandardScrollBar(sbVertical + sbHandleKeyboard), Filename)));
end;

procedure TTPappl.FileOpen(WildCard: PathStr;Str1,Str2:string; var FileName: PathStr;var CC: Word);
var
D: PFileDialog;
begin
D := New(PFileDialog, Init(WildCard, Str1, Str2, fdOpenButton , 100));
{D^.HelpCtx:=hcFileOp;}
if ValidView(D) <> nil then
begin
CC:=Desktop^.ExecView(D);
if CC <> cmCancel then
D^.GetFileName(FileName);
if D<>nil then Dispose(D, Done);
end;
end;

function TTPappl.GetPalette:PPalette;
const
CNewColor = CColor + CHelpColor;
P: array[apColor..apMonochrome] of string[length(CNewColor)]=
(CNewColor, CBlackWhite, CMonochrome);
begin
P[apColor,37]:=#$74;
P[apColor,39]:=#$3E;
P[apColor,51]:=#$31;
P[apColor,50]:=#$3F;
GetPalette:=@P[AppPalette];
end;
procedure TTPappl.Idle;

function IsTileable(P: PView): Boolean; far;
begin
IsTileable := P^.Options and ofTileable <> 0;
end;

begin
TApplication.Idle;
Clock^.Update;
Heap^.Update;
end;


procedure TTPappl.OldFileOpen(ssss:striin);
var
k1,i,cod:integer;
par: record
pf:Pointer;
end;
cc:Word;
WWW : PWindow;
g:boolean;
pat:dirstr;
Tip:Extstr;
Nam:NameStr;
label 2,1,3,4;
begin
2: FileOpen('*.dat','€¬ҐойЁҐбп д ©«л','€¬п д ©«  ¤ ­­ле',FileName,CC);
if CC=CmCancel then goto 1;
if FSearch(FileName,'')='' then
begin
Par.pf:=@FileName;
MessageBox(^C'” ©« ¤ ­­ле б в ЄЁ¬ Ё¬Ґ­Ґ¬ %s ­Ґ бгйҐбвўгҐв', @par, mfError+mfOkButton);
goto 2;
end;
Fsplit(FileName,Pat,Nam,Tip);
FileNameOpen:=Nam+'.txt';
Par.pf:=@FileNameOpen;
CC:=MessageBox(#13+^C' ђҐ§г«мв в бзҐв  б®еа ­Ёвм Ї®¤ Ё¬Ґ­Ґ¬'+#13^C' %s ?', @par,
mfWarning+mfNoButton+mfYesButton);
FileNameOpen:=Pat+FileNameOpen;
if (CC=cmYes) then goto 4;
if (CC=cmCancel) then goto 1;

3: FileOpen('*.txt','€¬ҐойЁҐбп д ©«л','€¬п д ©«  १г«мв в®ў бзҐв ',FileNameOpen,CC);
if CC=cmCancel then goto 1;
if FSearch(FileNameOpen,'')<>'' then
begin
Par.pf:=@FileNameOpen;
CC:=MessageBox(#13+^C'” ©« б в ЄЁ¬ Ё¬Ґ­Ґ¬ %s 㦥 бгйҐбвўгҐв!'+#13+^C'‘®еа ­Ёвм Ї®¤ в ЄЁ¬ ¦Ґ Ё¬Ґ­Ґ¬?',
@par, mfWarning+mfYesButton+mfNoButton);
if (CC=cmNo) then goto 3;
if (CC=cmCancel) then goto 1;
end;
4: if ssss='TSP ' then oldtsp(FileName,FileNameOpen,g)
else
begin
CC:=MessageBox(#13+^C'” ©« ­Ґ ¤«п Їа®Ја ¬¬л а бзҐв  ®ЎкҐ¬  ўл­Ё¬ Ґ¬®© §Ґ¬«Ё!'
+#13+^C'‚Ґа­гвмбп Є ўлЎ®аг д ©« ?',
nil, mfWarning+mfYesButton+mfNoButton);
if (CC=cmYes) then goto 2;
if (CC=cmNo) then goto 1;
end;

if g then begin
WWW := PWindow(ValidView(New(PFileWindow,Init(FileNameOpen))));
if WWW <> nil then Desktop^.Insert(WWW); end;
1: end;


procedure TTPappl.NewFileOpen(ssss:striin);
var
WWW : PWindow;
par: record
pf:Pointer;
end;
CC:Word;
pat:dirstr;
Tip:Extstr;
Nam:NameStr;
g:boolean;
label 1,2,3,4;
begin

2: FileOpen('*.dat','€¬ҐойЁҐбп д ©«л','€¬п Ќ®ў®Ј® д ©« ',FileName,CC);
if CC=cmCancel then goto 1;
if FSearch(FileName,'')<>'' then
begin
Par.pf:=@FileName;
CC:=MessageBox(^C'” ©« ¤ ­­ле б в ЄЁ¬ Ё¬Ґ­Ґ¬ %s 㦥 бгйҐбвўгҐв!'+#13+
^C'‘®еа ­Ёвм Ї®¤ бв ал¬ Ё¬Ґ­Ґ¬?', @par, mfWarning+mfYesButton+mfNoButton);
if CC=cmNo then goto 2;
if CC=cmCancel then goto 1;
end;
Fsplit(FileName,Pat,Nam,Tip);
FileNameOpen:=Nam+'.txt';
Par.pf:=@FileNameOpen;
CC:=MessageBox(#13+^C' ђҐ§г«мв в бзҐв  б®еа ­Ёвм Ї®¤ Ё¬Ґ­Ґ¬'+#13^C' %s ?', @par,
mfWarning+mfNoButton+mfYesButton);
FileNameOpen:=Pat+FileNameOpen;
if (CC=cmYes) then goto 4;
if CC=cmCancel then goto 1;
3: FileOpen('*.txt','€¬ҐойЁҐбп д ©«л','€¬п д ©«  १г«мв в®ў бзҐв ',FileNameOpen,CC);
if CC=cmCancel then goto 1;
if FSearch(FileNameOpen,'')<>'' then
begin
Par.pf:=@FileNameOpen;
CC:=MessageBox(#13+^C'” ©« б в ЄЁ¬ Ё¬Ґ­Ґ¬ %s 㦥 бгйҐбвўгҐв!'+#13+^C'‘®еа ­Ёвм Ї®¤ в ЄЁ¬ ¦Ґ Ё¬Ґ­Ґ¬?',
@par, mfWarning+mfYesButton+mfNoButton);
if (CC=cmNo) then goto 3;
if CC=cmCancel then goto 1;
end;
4: if ssss='TSP ' then newtsp(FileName,FileNameOpen,g);

if g then begin
WWW := PWindow(ValidView(New(PFileWindow,Init(FileNameOpen))));
if WWW <> nil then Desktop^.Insert(WWW);end;
1: end;



procedure TTPappl.InitMenuBar;
var
R: TRect;
begin
GetExtent(R);
R.B.Y := R.A.Y+1;
MenuBar := New(PMenuBar, Init(R, NewMenu(
NewSubMenu('~1~ ‘ҐаўЁб', hcNoContext, NewMenu(
NewItem('~1~ ‘Їа ўЄ ', '', kbNoKey, cmAbout,hcNoContext,
NewItem('~2~ „Ё «®Ј®ўлҐ ®Є­ ', '', kbNoKey, cmAbout4,hcNoContext,
NewItem('~3~ Џа ўЁ«  ', 'F7', kbF7, cmAbout2, hcNoContext,
NewLine(
NewItem('~5~ ‘¬Ґ­Ёвм Є в «®Ј...', '', kbNoKey, cmChangeDir, hcNoContext,
NewLine(
NewItem('~4~ Љ «мЄг«пв®а', '', kbNoKey, cmCalculator, hcNoContext, nil)))))))),
NewSubMenu('~2~ ђ бзҐв ®ЎкҐ¬  ',hcNoContext, NewMenu(
NewItem('~1~ ‘ ­®ўл¬Ё ¤ ­­л¬Ё ...', 'F4', kbF4, cmNewFileOpen, hcN1,
NewItem('~2~ ‘® бв ал¬Ё ¤ ­­л¬Ё...', '', kbNoKey, cmOldFileOpen,hcN2,
NewLine(
NewItem('~3~ Џа®б¬®ва १г«мв в®ў ...', 'F6', kbF6, cmFileWin, hcNoContext,
NewItem('~4~ ЏҐз вм १г«мв в®ў...', 'F5', kbF5, cmPrin,hcNoContext,
NewLine(
NewItem('~5~ €­бвагЄжЁп ','F8', kbF8, cmInstp, hcNoContext,
NewLine(
NewItem('~6~ ‚лx®¤', 'Alt-X', kbAltX, cmQuit,hcNoContext, nil)))))))))),
NewSubMenu('~3~ ‚л室 ',hcNoContext, NewMenu(
NewItem('~1~ ‚лx®¤', 'Alt-X', kbAltX, cmQuit,hcNoContext, nil)),
nil))))));
end;

procedure TTPappl.InitstatusLine;
var
r : trect;
begin
getextent(r);
r.a.y:=pred(r.b.y);
statusline:=new(
phintstatusline,init(r,
newstatusdef(0,1120,
NewStatusKey('~F1~Џ®¬®йм', kbF1, cmHelp,
newstatuskey('~F10~ЊҐ­о',kbF10,cmMenu,
newstatuskey('~F4~Ќ®ўл©',kbF4,cmNewFileOpen,
newstatuskey('~F3~‘в ал©',kbF3,cmOldFileOpen,
newstatuskey('~F2~‡ Єалвм',kbF2, cmClose,
newstatuskey('~F5~ЏҐз вм',kbF5, cmPrin,
newstatuskey('~Alt-X~‚л室',kbAltX, cmquit, nil))))))),
newstatusdef(1121,1359,
NewStatusKey('~F1~ Џ®¬®йм', kbF1, cmHelp,nil),

newstatusdef(1360,$FFFF,
NewStatusKey('~F1~Џ®¬®йм', kbF1, cmHelp,
newstatuskey('~F10~ЊҐ­о',kbF10,cmMenu,
newstatuskey('~F4~Ќ®ўл©',kbF4,cmNewFileOpen,
newstatuskey('~F3~‘в ал©',kbF3,cmOldFileOpen,
newstatuskey('~F2~‡ Єалвм',kbF2, cmClose,
newstatuskey('~F5~ЏҐз вм',kbF5, cmPrin,
newstatuskey('~Alt-X~‚л室',kbAltX, cmquit, nil))))))),

nil)))));
end;
procedure TTPAppl.GetEvent(var Event: TEvent);
var
W:PWindow;
HFile:PHelpFile;
HelpStrm:PDosStream;
Par: record
PHelpF: Pointer;
end;
const
HelpInUse:Boolean=False;
HelpFile: string[10]='tsphl.hlp';
begin
TApplication.GetEvent(Event);
if (Event.What = evCommand) and (Event.Command=cmHelp) and
not HelpInUse then
begin
HelpInUse:=True;
HelpStrm:=New(PDosStream, Init(HelpFile, stOpenRead));
HFile:=New(PHelpFile, Init(HelpStrm));
if HelpStrm^.Status<>stOk then
begin
Par.PHelpF:=@HelpFile;
MessageBox(#13^C'ЌҐ«м§п ®вЄалвм д ©« Є®­вҐЄбв­®© Ї®¬®йЁ%s',
@Par, mfError+mfOkButton);
{ Dispose(HFile,Done);}
HFile^.Free;
end
else
begin
HelpInUse:=True;
W:=New(pHelpWindow, Init(HFile, GetHelpCtx));
if ValidView(W) <> nil then
begin
ExecView(W);
{ Dispose(W,Done);}
W^.Free;
end;
HelpInUse:=False;
ClearEvent(Event);
end;
end;

end;

procedure TTPappl.HandleEvent(var Event: TEvent);
procedure Instp(t:word);
label 1;
var
W: PWindow;
par: record
pf:Pointer;
end;
FileNam:PathStr;
begin
if t=1 then
FileNam:='tspInstr.doc';
if t=2 then
FileNam:='Pravitsp.doc' ;
if t=3 then
FileNam:='Instrtsp.doc' ;
if FSearch(FileNam,'')='' then
begin
Par.pf:=@FileNam;
MessageBox(#13^C'” ©« Ё­бвагЄжЁЁ %s ­Ґ бгйҐбвўгҐв', @par, mfError+mfOkButton);
end
else
begin
W := PWindow(ValidView(New(PFileWindow,Init(FileNam))));
if W <> nil then Desktop^.Insert(W);
end;
end;

procedure FileWin;
label 1;
var
W: PWindow;
{ FileName1: PathStr;}
par: record
pf:Pointer;
end;
CC:Word;
g:boolean;
begin
1: FileOpen('*.txt','€¬ҐойЁҐбп д ©«л १г«мв в®ў','€¬п д ©« ',FileNameOpen,CC);
if CC<>cmCancel then
if FSearch(FileNameOpen,'')='' then
begin
Par.pf:=@FileNameOpen;
MessageBox(#13^C'” ©« ¤ ­­ле б в ЄЁ¬ Ё¬Ґ­Ґ¬ %s ­Ґ бгйҐбвўгҐв', @par, mfError+mfOkButton);
goto 1;
end
else
begin
W := PWindow(ValidView(New(PFileWindow,Init(FileNameOpen))));
if W <> nil then Desktop^.Insert(W);
end;
end;

procedure prin;
label 1,2,3;
var
FileToView: Text;
Line: String;
cc:Word;
par: record
pf:Pointer;
end;
pp:boolean;
begin
if FileNameOpen<>'' then
begin
Par.pf:=@FileNameOpen;
CC:=MessageBox(#13+^C' ђ бЇҐз в вм १г«мв вл бзҐв  Ё§ д ©«  '+#13^C' %s ?', @par,
mfWarning+mfNoButton+mfYesButton);
if CC=cmYes then goto 2;
if CC=cmCancel then goto 3;
end;
1: FileOpen('*.txt','€¬ҐойЁҐбп д ©«л १г«мв в®ў','€¬п д ©«  ¤«п ЇҐз вЁ',FileNameOpen,CC);
if CC=cmCancel then goto 3;
2: if FSearch(FileNameOpen,'')='' then
begin
Par.pf:=@FileNameOpen;
MessageBox(#13^C'” ©« ¤ ­­ле б в ЄЁ¬ Ё¬Ґ­Ґ¬ %s ­Ґ бгйҐбвўгҐв', @par, mfError+mfOkButton);
goto 1;
end;

{$I-}
Assign(FileToView, FileNameOpen);
Reset(FileToView);
if IOResult <> 0 then
MessageBox(#13^C'ЌҐ ¬®Јг ®вЄалвм д ©« '+FilenameOpen+'.', nil, mfError + mfOkButton)
else
begin
pp:=false;
while not Eof(FileToView) and not LowMemory do
begin
Readln(FileToView, Line);
{ if Line='..' then pp:=true;
if pp and (Line[1]<>'*') then} writeln(lst,line);
end;
Close(FileToView);
end;
{$I+}
3:
end;

procedure ChangeDir;
var
D: PChDirDialog;
begin
D := New(PChDirDialog, Init(cdNormal {+ cdHelpButton}, 101));
{D^.HelpCtx:=hcChDir;}
if ValidView(D) <> nil then
begin
DeskTop^.ExecView(D);
Dispose(D, Done);
end;
end;

procedure Calculator;
var
P: PCalculator;
begin
P := New(PCalculator, Init);
if ValidView(P) <> nil then
Desktop^.Insert(P);
end;


begin
TApplication.HandleEvent(Event);
case Event.What of
evCommand:
begin
case Event.Command of
cmChangeDir: ChangeDir;
cmAbout: About;
{ cmAbout3: About3;}
cmAbout4: About4;
cmNewFileOpen: NewFileOpen('TSP ');
cmOldFileOpen: OldFileOpen('TSP ');
cmCalculator: Calculator;
cmAbout2: Instp(2);
cmInstp: Instp(1);
{ cmInstp1: Instp(3); }
cmPrin : Prin;
cmFileWin: FileWin;
else
Exit;
end;
ClearEvent(Event);
end;
end;
end;


var
Wapp: TTPappl;

begin
wapp.init;
wapp.run;
wapp.done;
end.
Соседние файлы в папке TSPST_1
  • #
    09.04.2015656 б6TSPHL.TPU
  • #
    09.04.2015638 б6TSPHL.TXT
  • #
    09.04.201528.16 Кб7TSPMET.PAS
  • #
    09.04.201539.98 Кб6TSPMET.TPU
  • #
    09.04.2015125 б6TSPST С руссификатором, мышкой и печатью.bat
  • #
    09.04.201515.71 Кб9TSPST.PAS
  • #
    09.04.2015247 б6ZZZ.BAK
  • #
    09.04.2015247 б6ZZZ.DAT
  • #
    09.04.20152.03 Кб7ZZZ.TXT