[fpc-pascal]Free Vision

Ivica Munitic imunitic at softhome.net
Tue Mar 4 11:55:16 CET 2003


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!



More information about the fpc-pascal mailing list