home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 2
/
ctrom_ii_b.zip
/
ctrom_ii_b
/
PROGRAM
/
PASCAL
/
HSYS10
/
EXAMPLE
/
EXAPLE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-08-20
|
7KB
|
252 lines
program exaple;
uses objects, drivers, views, menus, app, dialogs, helpfile, msgbox,
example;
Type
{ ****************************************************************** }
{ ****************************************************************** }
{ Dialog }
{ ****************************************************************** }
{ ****************************************************************** }
pmyapp = ^tmyapp;
TMyApp = object(TApplication)
myhelpwin : phelpwindow;
constructor init;
procedure InitStatusLine; virtual;
procedure handleEvent( Var Event: TEvent ); virtual;
procedure GetEvent(VAR Event : TEvent ); virtual;
end;
Const cmakey = 100;
cmhindexcall = 101;
Var MyApp : TMyApp;
overridehelp : word;
{ ****************************************************************** }
{ ****************************************************************** }
{ Application }
{ ****************************************************************** }
{ ****************************************************************** }
constructor tmyapp.init;
Var R : TRect;
sc : word;
begin
inherited init;
GetExtent ( R );
R.B.Y := R.A.Y + 1;
MenuBar := pmenubar(New ( pMenuBar, Init ( R, NewMenu (
NewSubMenu ( '~A Menu~',hcmenu,
NewMenu (
NewItem ( 'A Menutitem ~1~', '', kbNoKey, cmakey, hcmenu,
NewItem ( 'A Menutitem ~1~', '', kbNoKey, cmakey, hcmenu,
NewItem ( 'A Menutitem ~1~', '', kbNoKey, cmakey, hcmenu,
NewItem ( 'A Menutitem ~1~', '', kbNoKey, cmakey, hcmenu,
NewItem ( 'A Menutitem ~1~', '', kbNoKey, cmakey, hcmenu,
nil)))))),
nil)))));
Insert(Menubar);
end;
Procedure Tmyapp.InitStatusLine;
Var R : TRect;
p : pstatusitem;
q : pstatusdef;
procedure stndhelp;
begin
p:=NewStatusKey('~F1~ Help', kbF1, cmhelp,p);
end;
Begin
GetExtent ( R );
R.A.Y := R.B.Y - 1;
q:=nil;
{defaulthelp, zuerst: }
p:=nil;
p:=NewStatusKey('', kbF10, cmMenu,p);
p:=NewStatusKey('', kbshiftf1, cmhindexcall,p);
p:=NewStatusKey('', kbf1, cmhelp,p);
p:=NewStatusKey('', kbctrlf5, cmresize,p);
p:=NewStatusKey('', kbf5, cmzoom,p);
p:=NewStatusKey('', kbf6, cmnext,p);
p:=NewStatusKey('', kbshiftf6, cmprev,p);
p:=NewStatusKey('~Alt+X~ Exit', kbAltX, cmQuit,p);
q:=NewStatusDef(0,$FFFF,p,q);
StatusLine := New(PStatusLine, Init(R,q));
Insert(statusline);
registerhelpfile;
end;
procedure tmyapp.handleEvent;
Const exdate = 9;
Var tmp : pointer;
begin
inherited HandleEvent(Event);
if (event.what=evcommand) then begin
clearevent(event);
end;
end;
procedure tmyapp.GetEvent;
var W : PHelpWindow;
HFile : PHelpFile;
HelpStrm : PDosStream;
helpfound : PHelpWindow;
hlpctx : word;
modal : boolean;
Const nonmodal : boolean = false;
helpopenerror : boolean = false;
function isdialoghelp:boolean;
begin
isdialoghelp:=(hlpctx>hc0firstcounterend) or (hlpctx<1);
end;
procedure openhelpstream;
begin
w:=nil;
{ you should use your helpfilename here... }
HelpStrm := New(PDosStream, Init('example.hlp',stOpenRead));
if (HelpStrm^.Status<>stOk) then begin
{ help not found or not opend }
MessageBox(^c'Unable to open help', nil, mfError+mfOkButton);
ClearEvent(Event);
helpopenerror:=true;
exit;
end;
HFile:=New(PHelpFile, Init(HelpStrm));
{ will be nil, if not REGISTERHELPFILE }
if (hfile<>nil) and (not hfile^.modified) then begin
W:=New(PHelpWindow,Init(HFile,HlpCtx,isdialoghelp));
disposestr(w^.title);
w^.title:=newstr('Demo Help');
end else begin
{ didn't look like a Turbo Vision help or not REGISTERHELPFILE }
MessageBox(^c'Not a valid helpfile!', nil, mfError+mfOkButton);
ClearEvent(Event);
helpopenerror:=true;
exit;
end;
end;
procedure callhelp;
Var deskcalc : byte;
procedure quickcalcdesktop(p : pview); far;
begin
inc(deskcalc);
end;
procedure findhelpfile(P: PView); far;
begin
{ if helpwindow already on desktop: focus and switch to page }
if (p<>nil) and (p^.Valid(cmClose)) and (typeof(p^)=typeof(thelpwindow)) and
(phelpwindow(p)=myhelpwin) then begin
helpfound:=phelpwindow(p);
phelpwindow(p)^.focus;
phelpwindow(p)^.phv^.SwitchToTopic(hlpctx);
end;
end;
procedure gotomodalpage(P: PView); far;
begin
{ if helpwindow already modal on desktop: switch to page }
if (p<>nil) and {(p^.Valid(cmClose)) and}
(typeof(p^)=typeof(thelpwindow)) and
(phelpwindow(p)^.ismodal) then begin
phelpwindow(p)^.phv^.SwitchToTopic(hlpctx);
end;
end;
begin
deskcalc:=0;
desktop^.foreach(@quickcalcdesktop);
{ desktop empty and no helpctx? }
if (deskcalc=1) and (hlpctx=0) then
hlpctx:=0{hcmenudesktop};
if (not nonmodal) and (not isdialoghelp) and (not helpopenerror) then begin { ein Fenster ruft...}
{ non modal }
helpfound:=nil;
desktop^.foreach(@findhelpfile);
if (helpfound=nil) or (helpfound<>myhelpwin) then begin
openhelpstream;
if (not helpopenerror) and (ValidView(W)<>nil) then begin
desktop^.insert(W);
ClearEvent(Event);
myhelpwin:=w;
end;
end else
ClearEvent(Event);
end else begin
{ modal }
if (not nonmodal) then begin
nonmodal:=true;
openhelpstream;
if (not helpopenerror) and (ValidView(W)<>nil) then begin
execview(W);
dispose(w,done);
end;
nonmodal:=false;
ClearEvent(Event);
end;
end;
end;
begin
inherited GetEvent(Event);
if (Event.What=evCommand) and (Event.Command = cmHelp) then begin
{ helpwindow open? }
if (desktop^.current<>nil) and (typeof(desktop^.current^)=typeof(thelpwindow))
{ yes: help about help }
then hlpctx:=hcabout
else
{ no: check overridehelp }
if (overridehelp<>0)
then hlpctx:=overridehelp
else begin
{ ok, get help. see Notice 2 }
if (desktop^.current=nil) and (myapp.current<>menubar)
then hlpctx:=0
else hlpctx:=gethelpctx;
end;
callhelp;
end;
{ open helpindex, if help not on desktop }
if ((Event.What=evkeydown) and (Event.keycode=kbshiftf1)) or
((Event.What=evcommand) and (Event.command=cmhindexcall)) then begin
hlpctx:=hcindexpage;
callhelp;
end;
end;
begin
overridehelp:=0;
myapp.init;
myapp.run;
myapp.done;
end.