Hello guys!
I'm trying to learn Free Vision via TV Demos, and I have a problem with this
code:
Tutconst.pas
-----------------
************************************************}
{ }
{ Turbo Vision 2.0 Demo }
{ Copyright (c) 1992 by Borland International }
{ }
{************************************************}
unit TutConst; { Contains global constants for Turbo Vision Tutorial }
interface
const
cmOrderNew = 251;
cmOrderWin = 252;
cmOrderSave = 253;
cmOrderCancel = 254;
cmOrderNext = 255;
cmOrderPrev = 250;
cmClipShow = 260;
cmAbout = 270;
cmFindOrderWindow = 2000;
const
cmOptionsVideo = 1502;
cmOptionsSave = 1503;
cmOptionsLoad = 1504;
const
cmStockNew = 241;
cmStockWin = 242;
cmStockSave = 243;
cmStockCancel = 244;
cmStockNext = 245;
cmStockPrev = 240;
const
cmSupplierNew = 231;
cmSupplierWin = 232;
cmSupplierSave = 233;
cmSupplierCancel = 234;
cmSupplierNext = 235;
cmSupplierPrev = 230;
implementation
end.
END Tutconst.pas
---------------------
Tutor05.pas
----------------
{************************************************}
{ }
{ Turbo Vision 2.0 Demo }
{ Copyright (c) 1992 by Borland International }
{ }
{************************************************}
program Tutor05;
uses Memory, TutConst, Drivers, Objects, Views, Menus, App, MsgBox,
Editors, StdDlg;
type
TTutorApp = object(TApplication)
ClipboardWindow: PEditWindow;
constructor Init;
procedure DoAboutBox;
procedure HandleEvent(var Event: TEvent); virtual;
procedure InitMenuBar; virtual;
procedure InitStatusLine; virtual;
procedure NewWindow;
procedure OpenWindow;
end;
constructor TTutorApp.Init;
var
R: TRect;
begin
EditorDialog := @StdEditorDialog;
inherited Init;
DisableCommands([cmOrderWin, cmStockWin, cmSupplierWin]);
Desktop^.GetExtent(R);
ClipboardWindow := New(PEditWindow, Init(R, '', wnNoNumber));
if ValidView(ClipboardWindow) <> nil then
begin
ClipboardWindow^.Hide;
InsertWindow(ClipboardWindow);
Clipboard := ClipboardWindow^.Editor;
Clipboard^.CanUndo := False;
end;
end;
procedure TTutorApp.DoAboutBox;
begin
MessageBox(#3'Turbo Vision Tutorial Application'#13 +
#3'Copyright 1992'#13#3'Borland International',
nil, mfInformation or mfOKButton);
end;
procedure TTutorApp.HandleEvent(var Event: TEvent);
begin
inherited HandleEvent(Event);
if Event.What = evCommand then
begin
case Event.Command of
cmClipShow:
with ClipboardWindow^ do
begin
Select;
Show;
ClearEvent(Event);
end;
cmNew:
begin
NewWindow;
ClearEvent(Event);
end;
cmOpen:
begin
OpenWindow;
ClearEvent(Event);
end;
{cmOptionsVideo:
begin
//SetScreenMode(ScreenMode xor smFont8x8);
ClearEvent(Event);
end;}
cmAbout:
begin
DoAboutBox;
ClearEvent(Event);
end;
end;
end;
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.InitStatusLine;
var
R: TRect;
begin
GetExtent(R);
R.A.Y := R.B.Y - 1;
New(StatusLine, Init(R,
NewStatusDef(0, $EFFF,
NewStatusKey('~F3~ Open', kbF3, cmOpen,
NewStatusKey('~F4~ New', kbF4, cmNew,
NewStatusKey('~Alt+F3~ Close', kbAltF3, cmClose,
StdStatusKeys(nil)))),
NewStatusDef($F000, $FFFF,
NewStatusKey('~F6~ Next', kbF6, cmOrderNext,
NewStatusKey('~Shift+F6~ Prev', kbShiftF6, cmOrderPrev,
StdStatusKeys(nil))), nil))));
end;
procedure TTutorApp.NewWindow;
var
R: TRect;
TheWindow: PEditWindow;
begin
R.Assign(0, 0, 60, 20);
TheWindow := New(PEditWindow, Init(R, '', wnNoNumber));
InsertWindow(TheWindow);
end;
procedure TTutorApp.OpenWindow;
var
R: TRect;
FileDialog: PFileDialog;
TheFile: FNameStr;
const
FDOptions: Word = fdOKButton or fdOpenButton;
begin
TheFile := '*.*';
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;
var
TutorApp: TTutorApp;
begin
TutorApp.Init;
TutorApp.Run;
TutorApp.Done;
end.
END Tutor05.pas
--------------------
When I try to open a file the OutOfMemory dialog pops up with the message:
Not enough memory for this operation
I also get the same error when I try to write a new file.
File/New...
The window pops up but i can't write anything. On any key pressed it pops up
the error dialog with the same message.
I tried this on Linux and Windows
The Platforms are:
1)
Windows 2k Service Pack 3
FPC 1.0.7 (from CVS) (win32 version compiled)
Free Vision (from CVS)
2)
Debian GNU/Linux Woody 3.0r1 2.4.18-bf24 kernel
FPC 1.0.7 (from CVS)
Free Vision (from CVS)
Tnx in advanced!
_______________________________________________
fpc-pascal maillist - [EMAIL PROTECTED]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
