Sven,
On Thu, Feb 13, 2020 at 11:08:05AM +0100, Sven Barth via fpc-pascal wrote:
> I think saving and restoring streams should work as the textmode IDE uses
> that as well. Can you please provide an example that fails? Then we might
> be able to help you.
The example is from chapter 4 of the Turbo Vision Version 2.0 Programming
Guide:
http://www.BitSavers.org/pdf/borland/Turbo_Vision_Version_2.0_Programming_Guide_1992.pdf
I don't know if attachments can be sent to the list. I'll try to attach the
code I've keyed in from the book up to the point of that example.
--
Kevin
http://www.RawFedDogs.net
http://www.Lassie.xyz
http://www.WacoAgilityGroup.org
Bruceville, TX
What's the definition of a legacy system? One that works!
Errare humanum est, ignoscere caninum.
Program Tutor06b;
Uses App, Objects, Menus, MsgBox, Editors, StdDlg, Drivers, Views, Memory, TutConst;
Type
TTutorApp = object(TApplication)
ClipBoardWindow: PEditWindow;
Constructor Init;
Procedure InitStatusLine; Virtual; { Declare the new methods }
Procedure InitMenuBar; Virtual;
Procedure HandleEvent(Var Event: TEvent); Virtual;
Procedure DoAboutBox;
Procedure NewWindow;
Procedure OpenWindow;
Procedure SaveDesktop;
Procedure LoadDesktop;
End;
Procedure TutorStreamError(Var S: TStream);
Var ErrorMessage: String;
Begin
Case S.Status of
stError: ErrorMessage := 'Stream access error';
stInitError: ErrorMessage := 'Cannot initialize stream';
stReadError: ErrorMessage := 'Read beyond end of stream';
stWriteError: ErrorMessage := 'Cannot expand stream';
stGetError: ErrorMessage := 'Unregistered type read from stream';
stPutError: ErrorMessage := 'Unregistered type written to stream';
End;
ClearScreen;
PrintStr('Error: ' + ErrorMessage);
Halt(Abs(S.Status));
End;
Constructor TTutorApp.Init;
Var
R: TRect;
Begin
{ MaxHeapSize := 8192; x Set up the file edit buffer area above heap }
EditorDialog := @StdEditorDialog; { Use standard editor dialogs }
StreamError := @TutorStreamError;
RegisterObjects;
RegisterViews;
RegisterEditors;
RegisterApp;
Inherited Init;
Desktop^.GetExtent(R); { Get boundries for window }
ClipBoardWindow := New(PEditWindow, Init(R, '', wnNoNumber));
If ValidView(ClipBoardWindow) <> Nil Then { Make sure it worked }
Begin
ClipBoardWindow^.Hide; { Hide clipboard window }
InsertWindow(ClipBoardWindow); { Insert hidden clipboard window }
Clipboard := ClipBoardWindow^.Editor; { Make editor clipboard }
Clipboard^.CanUndo := False; { Can't undo in clipboard }
End;
DisableCommands([cmOrderWin, cmStockWin, cmSupplierWin]);
End;
Procedure TTutorApp.InitStatusLine;
Var R: TRect;
Begin
GetExtent(R);
R.A.Y := R.B.Y -1;
New(StatusLine, Init(R,
NewStatusDef(0, $EFFF, { This is the "normal" range }
NewStatusKey('~F3~ Open', kbF3, cmOpen, { Bind F3 }
NewStatusKey('~F4~ New', kbF4, cmNew, { and F4}
NewStatusKey('~Alt+F3~ Close', kbAltF3, cmClose, { and Alt+F3 }
StdStatusKeys(Nil)))),
NewStatusDef($F000, $FFFF, { Define another range }
NewStatusKey('~F6~ Next', kbF6, cmOrderNext,
NewStatusKey('~Shift+F6~ Prev', kbShiftF6, cmOrderPrev,
StdStatusKeys(Nil))),
Nil))));
End;
Procedure TTutorApp.InitMenuBar;
Var R: TRect;
Begin
GetExtent(R);
R.B.Y := R.A.Y + 1;
MenuBar := New(PMenuBar, Init(R,
NewMenu(
NewSubMenu('~F~ile', hcNoContext,
NewMenu(StdFileMenuItems(Nil)),
NewSubMenu('~E~dit', hcNoContext,
NewMenu(
StdEditMenuItems(
NewLine(
NewItem('~S~how clipboard', '', kbNoKey, cmClipShow,hcNoContext,
Nil)))),
NewSubMenu('~O~rders', hcNoContext,
NewMenu(
NewItem('~N~ew', 'F9', kbF9, cmOrderNew, hcNoContext,
NewItem('~S~ave', '', kbNoKey, cmOrderSave, hcNoContext,
NewLine(
NewItem('Next', 'PgDn', KbPgDn, cmOrderNext, hcNoContext,
NewItem('Prev', 'PgUp', kbPgUp, cmOrderPrev, hcNoContext,
Nil)))))),
NewSubMenu('O~p~tions', hcNoContext,
NewMenu(
NewItem('~T~oggle video', '', kbNoKey, cmOptionsVideo, hcNoContext,
NewItem('~S~ave desktop', '', kbNoKey, cmOptionsSave, hcNoContext,
NewItem('~L~oad desktop', '', kbNoKey, cmOptionsLoad, hcNoContext,
Nil)))),
NewSubMenu('~W~indow', hcNoContext,
NewMenu(
NewItem('Orders', '', kbNoKey, cmOrderWin, hcNoContext,
NewItem('Stock items', '', kbNoKey, cmStockWin, hcNoContext,
NewItem('Suppliers', '', kbNoKey, cmSupplierWin, hcNoContext,
NewLine(
StdWindowMenuItems(Nil)))))),
NewSubMenu('~H~elp', hcNoContext,
NewMenu(
NewItem('~A~bout...', '', kbNoKey, cmAbout, hcNoContext,
Nil)),
Nil)))))))));
End;
Procedure TTutorApp.HandleEvent(Var Event: TEvent);
Begin
Inherited HandleEvent(Event); { Call the inherited method first }
If Event.What = evCommand Then { If unhandled, check for commands }
Begin
Case Event.Command of { Check for known commands }
cmOptionsVideo:
Begin
{ SetScreenMode(ScreenMode xor smFont8x8); x Toggle mode bit }
ClearEvent(Event); { Mark the event as handled }
End;
cmAbout:
Begin
DoAboutBox;
ClearEvent(Event); { Mark the event as handled }
End;
cmNew:
Begin
NewWindow;
ClearEvent(Event); { Mark the event as handled }
End;
cmOpen:
Begin
OpenWindow;
ClearEvent(Event); { Mark the event as handled }
End;
cmClipShow:
With ClipBoardWindow^ Do
Begin
Select;
Show;
ClearEvent(Event); { Mark the event as handled }
End;
cmOptionsSave:
Begin
SaveDesktop;
ClearEvent(Event); { Mark the event as handled }
End;
cmOptionsLoad:
Begin
LoadDesktop;
ClearEvent(Event); { Mark the event as handled }
End;
End;
End;
End;
Procedure TTutorApp.DoAboutBox;
Begin
{ #3 centers a line, #13 is a line break }
MessageBox(#3'Turbo Vision Tutorial Application'#13 +
#3'Copyright 1992'#13#3'Borland International',
Nil, mfInformation or mfOKButton);
End;
Procedure TTutorApp.NewWindow;
Var
R: TRect;
TheWindow: PEditWindow;
Begin
R.Assign(0, 0, 60, 20); { Assign boundries for the window }
TheWindow := New(PEditWindow, { Construct the window }
Init(R, '', wnNoNumber));
InsertWindow(TheWindow); { Insert into the desktop }
End;
Procedure TTutorApp.OpenWindow;
Var
R: TRect; { Boundries for the edit window }
FileDialog: PFileDialog; { File selection dialong box }
TheFile: FNameStr; { String for the file name }
Const
FDOptions: Word = fdOKButton or fdOpenButton; { Dialog options }
Begin
TheFile := '*.*'; { Initial mask for file names }
New(FileDialog, Init(TheFile, 'Open File', '~F~ile name',
FDOptions, 1));
If ExecuteDialog(FileDialog, @TheFile) <> cmCancel Then
Begin
R.Assign(0, 0, 75, 20);
InsertWindow(New(PEditWindow, Init(R, TheFile, wnNoNumber)));
End;
End;
Procedure TTutorApp.SaveDesktop;
Var DesktopFile: TBufStream;
Begin
Desktop^.Delete(ClipBoardWindow);
DesktopFile.Init('Desktop.tut', stCreate, 1024);
DesktopFile.Put(Desktop);
DesktopFile.Done;
InsertWindow(ClipBoardWindow);
End;
Procedure TTutorApp.LoadDesktop;
Var
DesktopFile: TBufStream;
TempDesktop: PDesktop;
R: TRect;
Begin
DesktopFile.Init('Desktop.tut', stOpenRead, 1024);
TempDesktop := PDesktop(DesktopFile.Get);
DesktopFile.Done;
If ValidView(TempDesktop) <> Nil Then
Begin
Desktop^.Delete(ClipBoardWindow);
Delete(Desktop);
Dispose(Desktop, Done);
Desktop := TempDesktop;
Insert(Desktop);
GetExtent(R);
R.Grow(0, -1);
Desktop^.Locate(R);
InsertWindow(ClipBoardWindow);
End;
End;
Var
TutorApp: TTutorApp;
Begin { Main }
TutorApp.Init;
TutorApp.Run;
TutorApp.Done;
End.
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
