Output of file : OOP.SWG contained in archive :
ALLSWAGS.ZIP
SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00037 OOP/TVISION ROUTINES 1 05-28-9313:53ALL SWAG SUPPORT TEAM CENTRDLG.PAS IMPORT 7 d¢ {ã > The title says it all. What is the accepted way of bringing up a dialogã > box in the centre of the screen.ã}ãProcedure CenterDlg (HWindow : HWnd);ãVarã R : TRect;ã X : Integer;ã Y : Integer;ã Frame : Integer;ã Caption : Integer;ãbeginã Frame := GetSystemMetrics (sm_CxFrame) * 2;ã Caption := GetSystemMetrics (sm_CyCaption);ã GetClientRect (HWindow, R);ã With R doã beginã X := ((GetSystemMetrics (sm_CxScreen) - (Right - Left)) div 2);ã Y := ((GetSystemMetrics (sm_CyScreen) - (Bottom - Top)) div 2);ã MoveWindow (HWindow, X, Y - ((Caption + Frame) div 2),ã Right + Frame, Bottom + Frame + Caption, False);ã end;ã end;ãend;ã{ã Execute this Function from the dialog's SetupWindow method.ã} 2 05-28-9313:53ALL SWAG SUPPORT TEAM COUNTDLG.PAS IMPORT 15 d¸# {ã> Some trouble-shooting With Turbo Vision, AGAIN!ã> If i want to impelement this source code toã> show x in a Window, how do i do that!!ãã> For x:=1 to 100 doã> WriteLn (x);ãã> That means that i want show x counting in theã> Window..........ããHere a simple method you can use to get started. It has been tested, and itãdoes not do much, except show a counting dialog box.ã}ããUnit CountDlg;ããInterfaceãUsesã Objects, dialogs, views, drivers;ãTypeã KDialog = Object(TDialog)ã Count : Word;ã ps : PStaticText;ã Constructor Init(Var bounds:Trect;ATitle:TTitleStr);ã Procedure HandleEvent(Var Event:TEvent); virtual;ã end;ã PKDialog = ^KDialog;ããImplementationããFunction NumStr(n:Word):String;ãVarã S : String;ãbeginã Str(n,s);ã NumStr := s;ãend;ããConstructor KDialog.Init(Var Bounds:TRect;ATitle:TTitleStr);ãVarã r : TRect;ãbeginã inherited init(Bounds,ATitle);ã Count := 0;ã GetExtent(r);ã r.grow(-1,-2); r.b.y := r.a.y + 1;ã new(ps,init(r,' Cyclycal counter := '+NumStr(Count)));ã insert(ps);ãend;ããProcedure KDialog.HandleEvent(Var Event:TEvent);ãbeginã inc(Count);ã if count > 10000 then count := 0;ã DisposeStr(ps^.Text);ã ps^.Text := NewStr(' Cyclycal count := '+NumStr(Count));ã ps^.Draw;ã Inherited HandleEvent(Event);ãend;ããend.ãã{ãAnd... the associated application to try it With ...ã}ããProgram GenApp;ãUsesã Objects, App, Views, Dialogs, CountDlg;ãTypeã GenericApp = Object(TApplication)ã Procedure Run; Virtual;ã end;ããProcedure GenericApp.Run;ãVarã r : TRect;ãbeginã GetExtent(R);ã R.Grow(-26,-10);ã ExecuteDialog(new(PKDialog,init(r,'Test Counter')),nil);ãend;ããVar MyApp : GenericApp;ããbeginã MyApp.Init;ã MyApp.Run;ã MyApp.Done;ãend.ã 3 05-28-9313:53ALL SWAG SUPPORT TEAM DELAYDLG.PAS IMPORT 11 db {ã±Hello. I was toying around With TVision, trying to make derive an Object frã±TDialog which would be a simple 'Delay box' (i.e. a message would display, tã±the box would cmOK itself after two seconds). I tried a simple Delay() commã±in HandleEvent, which seemed to work fine, but when I held down the mouse buã±on the menu, it locked up and sometimes my memory manager woudl report crazyã±error messages. Can anyone offer a suggestion on how to do this safely? Thã±are certain situations when clicking an 'OK' button is just a hassle. ThankããTry trapping the mouse events in the HandleEvent method of the dialogãbox.ã}ããTypeã tDelayDialog = Object(tDialog)ã Procedure HandleEvent(Var Event : tEvent); VIRTUAL;ã end;ããProcedure tDelayDialog.HandleEvent(Var Event : tEvent);ãConstã cDelay = 2000;ãbeginã if Event.What and evMouse <> 0 then (* This filters out mouse *)ã (* events before they reach *)ã (* the parent *)ã ELSEã beginã Delay(cDelay);ã Event.Command := cmOK; (* Set up the command *)ã INHERITED HandleEvent(Event); (* Let the parent handle it *)ã end;ãend;ã 4 05-28-9313:53ALL SWAG SUPPORT TEAM FILEDLG1.PAS IMPORT 6 d= {ã> In particular a collection of Filenames in the current directory sortedã> and the ability to scroll these Strings vertically.ããCCompiled and tested under BP7. All Units are standard Units available withãboth TP6 and BP7 packagesã}ããProgram ListDirProg;ãUsesã Objects,App,StdDlg;ããTypeã MyApp = Object(TApplication)ã Procedure run; Virtual;ã end;ããProcedure myapp.run;ãVarã p : PFileDialog;ãbeginã New(P,init('*.*','Directory Listing', '~S~earch Specifier', fdokbutton,0));ã if p <> nil thenã beginã execview(p);ã dispose(p,done);ã end;ãend;ããVarã a : myapp;ããbeginã a.init;ã a.run;ã a.done;ãend.ã 5 05-28-9313:53ALL SWAG SUPPORT TEAM FILEDLG2.PAS IMPORT 22 d^® {ã>Really like to see is a Real world example. In particular aã>collection of Filenames in the current directory sorted and theã>ability to scroll these Strings vertically. I don't want to goããI don't know if this will help that much, but it does what you requestedã
... This Compiled in Real mode under BP7 and ran without problems. Althoughãuntested in TP6, it should run fine.ã}ãProgram Example;ããUsesã App,ã Dialogs,ã Drivers,ã Menus,ã MsgBox,ã Objects,ã StdDlg,ã Views;ããConstã cmAbout = 101;ããTypeã TExampleApp = Object(TApplication)ã Procedure CM_About;ã Procedure CM_Open;ã Procedure HandleEvent(Var Event: TEvent); Virtual;ã Constructor Init;ã Procedure InitStatusLine; Virtual;ã end;ããProcedure TExampleApp.CM_About;ãbeginã MessageBox(ã ^C'Example O-O Program' + #13 + #13 +ã ^C'by Bill Himmelstoss (1:112/57)', nil, mfInFormation + mfOkButtonã );ãend;ããProcedure TExampleApp.CM_Open;ãVarã FileDialog: PFileDialog;ã Filename: FNameStr;ã Result: Word;ãbeginã FileDialog := New(PFileDialog, Init('*.*', 'Open a File', '~N~ame',ã fdOpenButton, 100));ã {$ifDEF VER70}ã Result := ExecuteDialog(FileDialog, @Filename);ã {$endif}ã {$ifDEF VER60}ã Result := cmCancel;ã if ValidView(FileDialog) <> nil thenã Result := Desktop^.ExecView(FileDialog);ã if Result <> cmCancel thenã FileDialog^.GetFilename(Filename);ã Dispose(FileDialog, Done);ã {$endif}ã if Result <> cmCancel thenã MessageBox(^C'You chose '+Filename+'.', nil, mfInFormation + mfOkButton);ãend;ããProcedure TExampleApp.HandleEvent(Var Event: TEvent); beginã {$ifDEF VER60}ã TApplication.HandleEvent(Event);ã {$endif}ã {$ifDEF VER70}ã inherited HandleEvent(Event);ã {$endif}ãã Case Event.What ofã evCommand:ã beginã Case Event.Command ofã cmAbout: CM_About;ã cmOpen: CM_Open;ã elseã Exit;ã end;ã ClearEvent(Event);ã end;ã end;ãend;ããConstructor TExampleApp.Init;ãVarã Event: TEvent;ãbeginã {$ifDEF VER60}ã TApplication.Init;ã {$endif}ã {$ifDEF VER70}ã inherited Init;ã {$endif}ãã ClearEvent(Event);ã Event.What := evCommand;ã Event.Command := cmAbout;ã PutEvent(Event);ãend;ããProcedure TExampleApp.InitStatusLine;ãVarã R: TRect;ãbeginã GetExtent(R);ã R.A.Y := R.B.Y - 1;ã StatusLine := New(PStatusLine, Init(R,ã NewStatusDef($0000, $FFFF,ã NewStatusKey('~F3~ Open', kbF3, cmOpen,ã NewStatusKey('~Alt+X~ Exit', kbAltX, cmQuit,ã nil)),ã nil)));ãend;ããVarã ExampleApp: TExampleApp;ããbeginã ExampleApp.Init;ã ExampleApp.Run;ã ExampleApp.Done;ãend.ã 6 05-28-9313:53ALL SWAG SUPPORT TEAM NUMVIEW.PAS IMPORT 8 dÖ¶ Unit NumView;ããInterfaceããUsesã Views, Objects, Drivers;ããTypeã PNumView = ^TNumView;ã TNumView = Object(TView)ã Number : LongInt;ãã Constructor init(Var Bounds: Trect);ã Procedure update(num:LongInt);ã Procedure draw; Virtual;ã Destructor done; Virtual;ã end;ããImplementationãã{---------------------------}ã{ }ã{ TNumView Methods }ã{ }ã{---------------------------}ãConstructor TNumView.Init(Var Bounds: Trect);ãbeginã inherited init(Bounds);ãend;ããProcedure TNumView.Update(num:LongInt);ãbeginã Number := num; Draw;ãend;ããProcedure TNumView.Draw; Varã B: TDrawBuffer;ã C: Word;ã Display : String;ãbeginã C := GetColor(6);ã MoveChar(B, ' ', C, Size.X);ã Str(Number,Display);ã MoveStr(B, Display,C);ã WriteLine(0, 0, Size.X,Length(Display), B);ãend;ããDestructor TNumView.Done;ãbeginã inherited done;ãend;ããend.ãã 7 05-28-9313:53ALL KEN BURROWS OBJ-DESC.PAS IMPORT 34 d? {ãKEN BURROWSããWell, here I go again. There have been a few messages here and there regardingãcollections and Objects and streams. I've been trying to grapple With howãthings work, and sometimes I win and sometimes I lose. The following code is myãrendition of a useful TObject Descendent. It is completely collectable andãstreamable. Feel free to dismiss it offhand if you like.ã}ããUnit TBase3; {BP 7.0}ã {released to the public domain by ken burrows}ãInterfaceãUsesã Objects, memory;ãTypeã TBase = Object(TObject)ã Data : Pointer;ã Constructor Init(Var Buf;n:LongInt);ã Constructor Load(Var S:TStream);ã Procedure Store(Var S:TStream); virtual;ã Destructor Done; virtual;ã Privateã Size : LongInt;ã end;ã PBase = ^TBase;ããConstã RBaseRec : TStreamRec = (ObjType : 19560;ã VMTLink : Ofs(TypeOf(TBase)^);ã Load : @TBase.Load;ã Store : @TBase.Store);ããProcedure RegisterTBase;ããImplementationããConstructor TBase.Init(Var Buf; n : LongInt);ãbeginã Data := MemAlloc(n);ã if Data <> Nil thenã beginã size := n;ã move(Buf,Data^,size);ã endã elseã size := 0;ãend;ããConstructor TBase.Load(Var S : TStream);ãbeginã size := 0;ã S.Read(size,4);ã if (S.Status = StOk) and (size <> 0) thenã beginã Data := MemAlloc(size);ã if Data <> Nil thenã beginã S.read(Data^,size);ã if S.Status <> StOk thenã beginã FreeMem(Data,size);ã size := 0;ã end;ã endã elseã size := 0;ã endã elseã Data := Nil;ãend;ããProcedure TBase.Store(Var S : TStream);ãbeginã S.Write(size, 4);ã if Data <> Nil thenã S.Write(Data^, Size);ãend;ããDestructor TBase.Done;ãbeginã if Data <> Nil thenã FreeMem(Data, size);ãend;ããProcedure RegisterTBase;ãbeginã RegisterType(RBaseRec);ãend;ããend.ããããProgram TestTBase3; {bare bones make/store/load/display a collection}ã {collected Type defined locally to the Program}ããUsesã Objects, tbase3;ããProcedure ShowStuff(P : PCollection);ãã Procedure ShowIt(Pb : PBase); Far;ã beginã if Pb^.Data <> Nil thenã Writeln(PString(Pb^.Data)^);ã end;ããbeginã P^.ForEach(@ShowIt);ãend;ããVarã A_Collection : PCollection;ã A_Stream : TDosStream;ã S : String;ã m : LongInt;ããbeginã m := memavail;ã RegisterTBase;ã New(A_Collection,init(5,2));ã Repeatã Writeln;ã Write('enter some String : ');ã Readln(S);ã if S <> '' thenã A_Collection^.insert(New(PBase,init(S,Length(S)+1)));ã Until S = '';ã Writeln;ã Writeln('Storing the collection...');ã A_Stream.init('Test.TB3',stCreate);ã A_Collection^.Store(A_Stream);ã Writeln;ã Writeln('Storing Done. ');ã dispose(A_Collection,done);ã A_Stream.done;ã Writeln;ã Writeln('Disposing of Stream and Collection ...');ã if m = memavail thenã Writeln('memory fully released')ã elseã Writeln('memory not fully released');ã Write('Press [ENTER] to [continue] ...');ã readln;ã Writeln;ã Writeln('Constructing a new collection using the LOAD Constructor');ã A_Stream.init('Test.TB3',stOpenRead);ã New(A_Collection,Load(A_Stream));ã A_Stream.done;ã Writeln;ã ShowStuff(A_Collection);ã Writeln;ã Writeln('Disposing of Stream and Collection ...');ã dispose(A_Collection,done);ã if m = memavail thenã Writeln('memory fully released')ã elseã Writeln('memory not fully released');ã Write('Press [ENTER] to [EXIT] ...');ã readln;ãend.ãã{ãThe above code has been tested and works just fine. By defining what I put intoãthe Object and Typecasting it when I take it out, I can collect and store andãload just about anything Without ever haveing to descend either theãTCollection, TBase or the TDosStream Objects. In the Case of the above Program,ãI elected to collect simple Strings. It might just as well have been any otherãType of complex Record structure.ããThis Program was written solely For the purpose of discovering how the Objectsãbehave and possibly to even learn something. Any comments, discussions orãflames are always welcome.ã}ã 8 05-28-9313:53ALL SWAG SUPPORT TEAM OOP-EXMP.PAS IMPORT 13 d°ñ {ã I am trying to teach myself about Object orientated Programming and aboutã'inheritence'. This is my code using Records.ããHave a look at 'Mastering Turbo Pascal 6' by tom Swan, pg. 584 and on.ãBriefly, without Objects, code looks like this:ã}ããDateRec = Recordã Month: Byte;ã day: Byte;ã year: Word;ãend;ããVarã today: DateRec;ããbeginã With today doã beginã month:= 6;ã day := 6;ã year := 1992;ã end;ã...ãmore code..ãend.ããWith Objects, code looks like this:ããTypeã DateObj = Objectã month: Byte; {note data and methods are all}ã day: Byte; {part of the Object together }ã year: Word;ã Procedure Init(MM, DD, YY: Word);ã Function StringDate: String;ã end;ããVarã today: DateObj;ããProcedure DateObj.Init(MM, DD, YY: Word); {always need to initialise}ãbeginã Month:= MM;ã Day := DD;ã year := YY;ãend;ããFunction DateObj.StringDate: String;ãVarã MStr, Dstr, YStr: String[10];ãbeginã Str(Month, MStr);ã Str(Day, DStr);ã Str(Year, YStr);ã StringDate := MStr + '/' + DStr + '/' + YStrãend;ããbegin {begin main Program code}ã today.Init(6,6,1992);ã Writeln('The date is ', today.StringDate)ã Readlnã..ãother code..ãend.ããHope this helps. Read all the example code you can, and try the Turbo-ãvision echo (not yet on Fidonet, but nodes were listed on hereãrecently). You can fidonet sysop Pam Lagier at TurboCity BBS 1:208/2ãFor a node list.ã 9 05-28-9313:53ALL SWAG SUPPORT TEAM OOP-HTKY.PAS IMPORT 30 dýÆ {ã> Yes, event oriented Programming is very easy using OOP, but as itã> comes to TVision, if you need to add your own events, you're stuck. Iã> just wanted to implement the Windows-style ALT-Press-ALT-Releaseã> event, that activates the Window menu, and I'd had to modify theã> Drivers.pas sourceFile to implement it, so I have to find other keysã> to activate the menu bar :-(ããthis Really stimulated me so I sat down and implemented the following *without*ãmessing around in DRIVERS.PAS in -believe it or not- 15 minutes! :-)))ã}ãProgram tryalt;ããUses drivers,Objects,views,menus,app,Crt;ããConst altmask = $8;ãVar k4017 : Byte Absolute $40:$17;ããType tmyapp = Object (TApplication)ã AltPressed,ã IgnoreAlt: Boolean;ã Constructor Init;ã Procedure InitMenuBar; Virtual;ã Procedure GetEvent (Var Event: TEvent); Virtual;ã Procedure Idle; Virtual;ã end;ãã{ low-level Function; returns True when is being pressed }ãFunction AltDown: Boolean;ãbeginã AltDown := (k4017 and altmask) = altmaskãend;ããConstructor tmyapp.Init;ãbeginã inherited init;ã AltPressed := False;ã IgnoreAlt := Falseãend;ããProcedure Tmyapp.InitMenuBar;ãVarã R: TRect;ãbeginã GetExtent(R);ã R.B.Y := R.A.Y + 1;ã MenuBar := New (PMenuBar, Init(R, NewMenu (ã NewSubMenu ('~ð~', hcNoConText, NewMenu (ã NewItem ('~A~bout LA-Copy...', '', kbNoKey, cmQuit, hcNoConText,ã NewLine (ã NewItem ('~D~OS Shell', '', kbNoKey, cmQuit, hcNoConText,ã NewItem ('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoConText,ã nil))))),ã NewSubMenu ('~R~ead', hcNoConText, NewMenu (ã NewItem ('~D~isk...', 'F5', kbF5, cmQuit, hcNoConText,ã NewItem ('~I~mage File...', 'F6', kbF6, cmQuit, hcNoConText,ã NewItem ('~S~ector...', 'F7', kbF7, cmQuit, hcNoConText,ã NewLine (ã NewItem ('~F~ree up used memory', 'F4', kbF4, cmQuit, hcNoConText,ã nil)))))),ã (* more menus in the original 🙂 *)ã nil)))));ãend;ãã{ modified GetEvent to allow direct usage of Alt-Hotkey }ãProcedure tmyapp.GetEvent (Var Event: TEvent);ãbeginã inherited GetEvent (Event);ã if (Event.What and (evKeyboard or evMessage)) <> evnothing thenã IgnoreAlt := True { in Case of keypress or command ignore }ãend; { Until next time released }ããProcedure tmyapp.Idle;ãVar Event: TEvent;ãbeginã inherited Idle;ã if AltDown then { key is down }ã AltPressed := True { remember this }ã else begin { is released (again?) }ã if AltPressed then begin { yes, again. }ã if not IgnoreAlt then begin { but: did they use Alt-Hotkey? }ã Event.What := evCommand; { no, let's activate the menu! }ã Event.Command := cmMenu;ã PutEvent (Event)ã end;ã end;ã AltPressed := False; { however, is up again }ã IgnoreAlt := False { so we don't need to ignore it }ã end; { the next time is released }ãend;ããVar myapp: tmyapp; { create an Object of class 'tmyapp' }ããbeginã myapp.init; { you know these three lines, don't you? }ã myapp.run;ã myapp.done;ãend.ãã{ãFor convenience I copied the first three menus from my diskcopy clone so don'tãget confused about the items :-). This Program does not emulate CompletelyãWindows' behaviour, however, it's a good start. Tell me if this is what youãwanted! I didn't test it excessively but it does work in this fairly simpleãProgram For activating menus by . The only thing not implemented isã'closing' the menu bar by a second stroke.ã} 10 05-28-9313:53ALL LARRY HADLEY OOP-STRG.PAS IMPORT 44 dgæ {ãLARRY HADLEYãã>Right now, I have an Array of Pointers that point to the beginningã>of each page. The entire File is loaded into memory using BlockRead.ã>To jump to a page, it checks the current page number, jumps to thatã>offset (as specified by the Page Array) and dumps the contentsã>to the screen Until it reaches the bottom.ãã I think I see. You have a monolithic block of memory...problem!ãã> There are a lot of ways to do it. One way would be to store theã> File as Arrays of *Pointers* to Strings...this would allow 64k ofã> *sentences*, not just 64k of Text. It's a Variation on the oldãã Actually, this is wrong. Since TP use 4 Byte Pointers, you canã only store 16k of sentences in a single Array, but evenã though that should still be plenty, you can use linked lists toã overcome that limitation!ãã>I have an Array of Pointers to the offset of each page. Could youã>provide a short code fragment?ãã Instead of treating the Pointers as offsets, you should be usingã them as actual data collections.ãã{ã *****************************************************************ãã Strings Unit With StrArray Object. Manage linked lists of Stringsã transparently.ãã By Larry Hadley - May be used freely, provided credit is givenã wherever this code is used.ãã *****************************************************************ã}ãUnit Strings;ããInterfaceããTypeã PString = ^String;ãã PStringList = ^StringList;ã StringList = Recordã P : PString;ã Next : PStringList;ã end;ãã pStrArray = ^oStrArray;ã oStrArray = Objectã Root : PStringList;ã total : Word;ã eolist : Boolean; {end of list - only valid after calling At,ã AtInsert, and AtDelete}ã Constructor Init;ã Destructor Done;ãã Procedure Insert(s : String);ã Procedure Delete;ã Function At(item : Word) : PString;ã Procedure AtInsert(item : Word; s : String);ã Procedure AtDelete(item : Word);ã Function First : PString;ã Function Last : PString;ãã Privateã Procedure NewNode(N : PStringList);ã Function AllocateS(s : String) : PString;ã Procedure DeallocateS(Var P : PString);ã end;ããImplementationããConstructor oStrArray.Init;ãbeginã Root := NIL;ã total := 0;ã eolist := False;ãend;ããDestructor oStrArray.Done;ãVarã T : PStringList;ãbeginã While Root <> NIL doã beginã T := Root^.Next;ã if Root^.P <> NIL thenã DeallocateS(Root^.P);ã Dispose(Root);ã Root := T;ã end;ãend;ããProcedure oStrArray.Insert(s : String);ãVarã T, T1 : PStringList;ãbeginã NewNode(T1);ã T1^.P := AllocateS(s);ã Inc(total);ã if Root <> NIL thenã beginã T := Root;ã While T^.Next <> NIL doã T := T^.Next;ã T^.Next := T1;ã endã elseã Root := T1;ãend;ããProcedure oStrArray.Delete;ãVarã T, T1 : PStringList;ãbeginã T := Root;ã if T <> NIL thenã While T^.Next <> NIL doã beginã T1 := T;ã T := T^.Next;ã end;ã T1^.Next := T^.Next;ã if T^.P <> NIL thenã DeallocateS(T^.P);ã Dispose(T);ã Dec(total);ãend;ããFunction oStrArray.At(item : Word) : PString;ãVarã count : Word;ã T : PStringList;ãbeginã if item>total thenã eolist := Trueã elseã eolist := False;ã count := 1; {1 based offset}ã T := Root;ã While (count < item) and (T^.Next <> NIL) doã beginã T := T^.Next;ã Inc(count);ã end;ã At := T^.P;ãend;ããProcedure oStrArray.AtInsert(item : Word; s : String);ãVarã count : Word;ã T, T1 : PStringList;ãbeginã if item > total thenã eolist := Trueã elseã eolist := False;ã NewNode(T1);ã T1^.P := AllocateS(s);ã Inc(total);ã count := 1;ã if Root <> NIL thenã beginã T := Root;ã While (count < Item) and (T^.Next <> NIL) doã beginã T := T^.Next;ã Inc(count);ã end;ã T1^.Next := T^.Next;ã T^.Next := T1;ã endã elseã Root := T1;ãend;ããProcedure oStrArray.AtDelete(item : Word);ãVarã count : Word;ã T, T1 : PStringList;ãbeginã if item > total then { don't delete if item bigger than list total -ã explicit only! }ã beginã eolist := True;ã Exit;ã endã elseã eolist := False;ãã count := 1;ã T := Root;ã T1 := NIL;ãã While (count < item) and (T^.Next <> NIL) doã beginã T1 := T;ã T := T^.Next;ã Inc(count);ã end;ã if T1 = NIL thenã Root := Root^.Nextã elseã T1^.Next := T^.Next;ã DeallocateS(T^.P);ã Dispose(T);ã Dec(total);ãend;ããFunction oStrArray.First : PString;ãbeginã First := Root^.P;ãend;ããFunction oStrArray.Last : PString;ãVarã T : PStringList;ãbeginã T := Root;ã if T <> NIL thenã While T^.Next <> NIL doã T := T^.Next;ã Last := T^.P;ãend;ããProcedure oStrArray.NewNode(N : PStringList);ãVarã T : PStringList;ãbeginã New(T);ã T^.Next := NIL;ã T^.P := NIL;ã if N = NIL thenã N := Tã elseã beginã T^.Next := N^.Next;ã N^.Next := T;ã end;ãend;ããFunction oStrArray.AllocateS(s : String) : PString;ãVarã P : PString;ãbeginã GetMem(P, Ord(s[0]) + 1);ã P^ := s;ã AllocateS := P;ãend;ããProcedure oStrArray.DeallocateS(Var P : PString);ãbeginã FreeMem(P, Ord(P^[0]) + 1);ã P := NIL; {for error checking}ãend;ããend. {Unit StringS}ããã{ãCode fragment :ããVarã TextList : pStrArray;ãã...ãã New(TextList, Init);ãã...ãã Repeatã ReadLn(TextFile, s);ã TextList^.Insert(s);ã Until Eof(TextFile) or LowMemory;ãã...ãã For Loop := 1 to PageLen doã if Not(TextList^.eolist) thenã Writeln(TextList^At(PageTop + Loop)^);ã...ããetc.ã} 11 05-28-9313:53ALL SWAG SUPPORT TEAM OOP-WIND.PAS IMPORT 32 dÁS {ã I'm still rather new (hence unexperienced) to this developmentãenvironment. Since the number of users of the Pascal For Windows productãis very limited in Belgium, I have little opportUnity to exchange ideasãand talk about problems. ThereFore, I dare to ask the following questionãdirectly on the US-BBS.ãã I contacted Borland Belgium With the following question:ãIs it possible to create an MDI-Interface, which consists of TDlgWindow'sã(Even of different Types of DialogWindows).ãThe Program printed below was their answer. However, possibly because ofãmy limited experience in the field, this Program does not seem to work onãmy Computer running the Borland Pascal 7.0 .ãã Could someone explain why the Program below does not create dialog-ãWindows as MDI client Windows of the main MDI Window (when I select theã"create"-menu element), but instead only normal client Windows.ã}ãã{********************************************************}ã{ MDI - Programm of TDlgWindow - ChildWindows }ã{ }ã{ This is an adapted version of the Borland demo }ã{ Programm MDIAPP.PAS of Borland Pascal 7.0 }ã{********************************************************}ãProgram MDI;ã{$R MDIAPP.RES}ãUsesã WinTypes, WinProcs, Strings, OWindows, ODialogs;ããTypeã { Define a TApplication descendant }ã TMDIApp = Object(TApplication)ã Procedure InitMainWindow; Virtual;ã end;ãã PMyMDIChild = ^TMyMDIChild;ã TMyMDIChild = Object(TDlgWindow)ã Num : Integer;ã CanCloseCheckBox : PCheckBox;ã Constructor Init(AParent: PWindowsObject; AName: PChar);ã Procedure SetupWindow; Virtual;ã Function CanClose: Boolean; Virtual;ã end;ãã PMyMDIWindow = ^TMyMDIWindow;ã TMyMDIWindow = Object(TMDIWindow)ã Procedure SetupWindow; Virtual;ã Function CreateChild: PWindowsObject; Virtual;ã end;ãã {********************** MDI Child ************************}ã Constructor TMyMDIChild.Init(AParent: PWindowsObject; AName: PChar);ã beginã inherited Init(AParent, AName);ã New(CanCloseCheckBox, Init(@Self, 102, 'Can Close',ã 10, 10, 200, 20, nil));ã end;ãã Procedure TMyMDIChild.SetupWindow;ã beginã inherited SetupWindow;ã CanCloseCheckBox^.Check;ã ShowWindow(HWindow, CmdShow);ã end;ãã Function TMyMDIChild.CanClose;ã beginã CanClose := CanCloseCheckBox^.GetCheck = bf_Checked;ã end;ãã {***************** MDI Window ******************}ã Procedure TMyMDIWindow.SetupWindow;ã Varã NewChild : PMyMDIChild;ã beginã inherited SetupWindow;ã CreateChild;ã end;ãã Function TMyMDIWindow.CreateChild: PWindowsObject;ã beginã CreateChild := Application^.MakeWindow(New(PMyMDIChild,ã Init(@Self, PChar(1))));ã end;ããProcedure TMDIApp.InitMainWindow;ãbeginã MainWindow := New(PMDIWindow, Init('MDI ConFormist',ã LoadMenu(HInstance, 'MDIMenu')));ãend;ããVarã MDIApp: TMDIApp;ãã{ Run the MDIApp }ãbeginã MDIApp.Init('MDIApp');ã MDIApp.Run;ã MDIApp.Done;ãend.ãã{ã***************************************************************************ã Content of the MDIAPP.RES Fileã***************************************************************************ã}ãMDIMENU MENUãbeginã POPUP "&MDI Children"ã beginã MENUITEM "C&reate", 24339ã MENUITEM "&Cascade", 24337ã MENUITEM "&Tile", 24336ã MENUITEM "Arrange &Icons", 24335ã MENUITEM "C&lose All", 24338ã endãendãã1 DIALOG 18, 18, 142, 92ãSTYLE DS_SYSMODAL | WS_CHILD | WS_VISIBLE | WS_CAPTION |ã WS_MinIMIZEBOX | WS_MAXIMIZEBOXãCLASS "BorDlg"ãCAPTION "TEST"ãbeginã CHECKBOX "Text", 101, 26, 25, 28, 12ã LText "Text", -1, 34, 48, 16, 8ã CONTROL "Text", 102, "BorStatic", 0 | WS_CHILD |ã WS_VISIBLE, 33, 70, 66, 8ãENDã 12 05-28-9313:53ALL ANDRES CVITKOVICH OOPCOPY.PAS IMPORT 86 d"E {************************************************}ã{ }ã{ Turbo Pascal 6.0 }ã{ Turbo Vision Utilities }ã{ Written (w) 1993 by Andres Cvitkovich }ã{ }ã{ Public Domain }ã{ }ã{************************************************}ããUnit TVUtis;ãã{$F+,O+,S-,D-,B-}ããInterfaceããUses Dos, Objects, Views, App;ããTypeã PProgressBar = ^TProgressBar;ã TProgressBar = Object (TView)ã empty, filled: Char;ã total: LongInt;ã percent: Word;ã Constructor Init (Var Bounds: TRect; ch_empty,ã ch_filled: Char; totalwork: LongInt);ã Procedure Draw; virtual;ã Procedure SetTotal (newtotal: LongInt);ã Procedure Update (nowdone: LongInt); virtual;ã Procedure UpdatePercent (newpercent: Integer); virtual;ã end;ãã PFileCopy = ^TFileCopy;ã TFileCopy = Objectã bufsize: Word;ã buffer: Pointer;ã ConstRUCTOR Init (BufferSize: Word);ã Destructor Done; VIRTUAL;ã Function SetBufferSize (newsize: Word): Word; VIRTUAL;ã Function CopyFile (File1, File2: PathStr): Integer; VIRTUAL;ã Procedure Progress (Bytesdone, Bytestotal: LongInt;ã percent: Integer); VIRTUAL;ã Function Error (code: Word): Integer; VIRTUAL;ã end;ããImplementationããUses drivers;ããConstructor TProgressBar.Init (Var Bounds: TRect; ch_empty, ch_filled: Char;ãtotalwork: LongInt);ãbeginã TView.Init (Bounds);ã total := totalwork;ã empty := ch_empty;ã filled := ch_filled;ã percent := 0;ãend;ããProcedure TProgressBar.Draw;ãVarã S: String;ã B: TDrawBuffer;ã C: Byte;ã y: Byte;ã newbar: Word;ãbeginã if (Size.X * Size.Y) = 0 then Exit; { Exit if no extent }ã C := GetColor (6);ã MoveChar (B, empty, C, Size.X);ã MoveChar (B, filled, C, Size.X * percent div 100);ã WriteLine (0, 0, Size.X, Size.Y, B);ãend;ãããProcedure TProgressBar.SetTotal (newtotal: LongInt);ãbeginã total := newtotalãend;ããProcedure TProgressBar.Update (nowdone: LongInt);ãVar newpercent: Word;ãbeginã if total=0 then Exit;ã newpercent := 100 * nowdone div total;ã if newpercent > 100 then newpercent := 100;ã if percent <> newpercent then beginã percent := newpercent;ã DrawViewã end;ãend;ããProcedure TProgressBar.UpdatePercent (newpercent: Integer);ãbeginã if newpercent > 100 then newpercent := 100;ã if percent <> newpercent then beginã percent := newpercent;ã DrawViewã end;ãend;ããã{ã TFileCopy.Initã ÄÄÄÄÄÄÄÄÄÄÄÄÄÄãã initializes the Object and allocates memoryãã BufferSize size of buffer in Bytes to be allocated For disk i/oãã}ãConstRUCTOR TFileCopy.Init (BufferSize: Word);ãbeginã If MaxAvail < BufferSize Thenã bufsize := 0ã Elseã bufsize := BufferSize;ã If bufsize > 0 Then GetMem (buffer, bufsize);ãend;ããã{ã TFileCopy.Doneã ÄÄÄÄÄÄÄÄÄÄÄÄÄÄãã Destructor, free up buffer memoryãã}ãDestructor TFileCopy.Done;ãbeginã If bufsize > 0 Then FreeMem (buffer, bufsize);ã { bufsize := 0; } { man weiá ja nie... }ãend;ããã{ã TFileCopy.SetBufferSizeã ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄãã change buffer sizeãã NewSize = new size of disk i/o buffer in Bytesãã}ãFunction TFileCopy.SetBufferSize (newsize: Word): Word;ãbeginã If MaxAvail >= newsize Then beginã If bufsize > 0 Then FreeMem (buffer, bufsize);ã bufsize := newsize;ã If bufsize > 0 Then GetMem (buffer, bufsize);ã end;ã SetBufferSize := bufsizeãend;ããã{ã TFileCopy.CopyFileã ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄãã copy a File onto another; no wildcards allowedã calls Progress and Errorãã File1 source Fileã File2 target Fileãã Error code returned:ãã 1 low on buffer memoryã 2 error opening source Fileã 3 error creating destination Fileã 4 error reading from source Fileã 5 error writing to destination Fileã 6 error writing File date/time and/or attributesãã}ãFunction TFileCopy.CopyFile (File1, File2: PathStr): Integer;ãVar fsrc, fdest: File;ã fsize, ftime, cnt, cnt1: LongInt;ã fattr, rd, wr, iores: Word;ãbeginã {$I-}ã If bufsize = 0 then begin CopyFile := 1; Exit end;ã Assign (fsrc, File1);ã Repeatã Reset (fsrc, 1);ã iores := IOResult;ã If iores <> 0 Thenã If Error (iores) = 1 Then beginã CopyFile := 2;ã Exitã end;ã Until iores = 0;ã Assign (fdest, File2);ã Repeatã ReWrite (fdest, 1);ã iores := IOResult;ã If iores <> 0 Thenã If Error (iores) = 1 Then beginã Close (fsrc);ã CopyFile := 3;ã Exitã end;ã Until iores = 0;ã fsize := FileSize (fsrc);ã GetFTime (fsrc, ftime);ã GetFAttr (fsrc, fattr);ã Repeatã Repeatã cnt := FilePos (fsrc);ã BlockRead (fsrc, buffer^, bufsize, rd);ã iores := IOResult;ã If iores <> 0 Then beginã If Error (iores) = 1 Then begin {abort?}ã Close (fsrc); {* }ã Close (fdest); {* hier knnte man auch}ã Erase (fdest); {* Error aufrufen, naja...}ã CopyFile := 4;ã Exit;ã end;ã Seek (fsrc, cnt); {step back on retry!}ã end;ã Until iores = 0;ã if rd > 0 thenã Repeatã cnt1 := FilePos (fdest);ã BlockWrite (fdest, buffer^, rd, wr);ã iores := IOResult;ã If (rd <> wr) or (iores <> 0) Then beginã If Error (iores) = 1 Then begin {abort?}ã Close (fsrc); {* }ã Close (fdest); {* hier knnte man auch}ã Erase (fdest); {* Error aufrufen, naja...}ã CopyFile := 5;ã Exit;ã end;ã Seek (fdest, cnt1); {step back on retry!}ã end;ã Until (rd = wr) and (iores = 0);ã Progress (cnt, fsize, cnt * 100 div fsize);ã Until (rd = 0) or (rd <> wr);ã Close (fsrc);ã Repeatã Close (fdest); {close&flush}ã iores := IOResult;ã If iores <> 0 Then If Error (iores) = 1 Then Exit;ã Until iores = 0;ã Reset (fdest);ã If IOResult <> 0 Then begin CopyFile := 6; Exit end;ã SetFTime (fdest, ftime);ã SetFAttr (fdest, fattr);ã If IOResult <> 0 Then begin Close (fdest); CopyFile := 6; Exit end;ã Close (fdest);ãend;ããã{ã TFileCopy.Progressã ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄãã is called by CopyFile to allow displaying a progress bar or s.e.ãã Bytesdone Bytes read in and writtenã Bytestotal Bytes to read&Write total (that is, File size)ã percent amount done in percentãã}ãProcedure TFileCopy.Progress (Bytesdone, Bytestotal: LongInt; percent:ãInteger);ãbeginã {abstract - inherit For use!}ãend;ãã{ã TFileCopy.Errorã ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄãã is called by CopyFile if an error occured during the copy processãã code the IOResult code <> 0ãã should return an Integer value:ãã 0 Repeat actionã 1 abortãã Note: TurboVision installs it's own Dos critical error handler, so youã don't need to overWrite Error (only called if Abort is chosen fromã the TV Error Msg) if you use CopyFile in a TV Program.ãã}ãFunction TFileCopy.Error (code: Word): Integer;ãbeginã Error := 1;ãend;ãããend.ããã{ã> Unit TVUtis;ã>ã> Wow...never seen so much code just to copy a File! =)ããwell, it's a quite extendable Object, and there's a lot of error-checking,ãtoo. just see below... :-)ãã> I haven't tried OOP yet, and probably was lucky toãã> Anyways, I see you left out a progress display inã> TFileCopy.Progress, but the Unit also has an a progress barã> Object. Any way to marry the two?ããof course, that's why I put them together!ãbut I didn't want to have the progress bar (and along With this Turbo Vision)ãbeing an essential part of the FileCopy Object, since some guys might want toãWrite their own ProgressBars or use the whole Object in a non-TV Program.ãã> I implemented your TCopyFile like so...ã>ã> Uses Dos, TVUtis;ã> Varã> DoCopy: TFileCopy;ã> F1, F2: PathStr;ã> R: Integer;ã> beginã> F1 := 'C:\tp\copyf.pas';ã> F2 := 'C:\copyf.pas';ã> DoCopy.Init(4096);ã> R := DoCopy.CopyFile(F1, F2);ã> DoCopy.Done;ã> Writeln(R);ã> end.ããAbsolutely correct, no doubt. But poor Graphics... ;-)ãã> How would one modify that and TFileCopy.Progress to useã> TProgressBar? From what I can surmise, you'd initã> TProgressBar and then TFilecopy.Progress wouldã> call it somehow, like TProgressBar.Update?ã> I don't see what I should put For the totalwork ofã> TProgressBar.Init; the size of the File? Then thatã> means I must cal TProgress.Init from insideã> TFileCopy.CopyFile (after we have the size of theã> File.) And TFileCopy.Progress would callã> TProgressBar.Update.ããfirst of all: The TProgressBar Object is written For Turbo Vision, you can'tãuse it within a non-TV Program. Next, you have to derive your own Object fromãTFileCopy and overWrite the method Progress that calls TProgressBar. Take theãfollowing as an example:ã}ããTypeã PXFileCopy = ^TXFileCopy;ã TXFileCopy = Object (TFileCopy)ã AProgressBar: PProgressBar;ã ConstRUCTOR Init (BufferSize: Word; ProgBar: PProgressBar);ã Procedure Progress (Bytesdone, Bytestotal: LongInt;ã percent: Integer); VIRTUAL;ã end;ããConstRUCTOR TXFileCopy.Init (BufferSize: Word; ProgBar: PProgressBar);ãbeginã inherited Init (BufferSize); { or TFileCopy.Init For TP 6 }ã AProgressBar := ProgBar;ãend;ããProcedure TXFileCopy.Progress (Bytesdone, Bytestotal: LongInt;ã percent: Integer);ãbeginã if AProgressBar <> NIL thenã AProgressBar^.UpdatePercent (percent);ãend;ã{ãYou then would use this Object (in a Turbo Vision Program) as follows:ã}ããFunction TMyApp.CopyFile (source, dest: PathStr): Integer;ãVarã Dlg: TDialog;ã MyBar: PProgressBar;ã R: TRect;ã DoCopy: TXFileCopy;ãbeginã R.Assign (0,0,40,8);ã Dlg.Init (R, 'Copying File...');ã Dlg.Options := Dlg.Options or ofCentered;ã Dlg.Flags := Dlg.Flags and not wfClose;ã R.Assign (2,2,38,4);ã Dlg.Insert (New (PStaticText, Init (R, ^C'copying '+source+#13+ã ^C'to '+dest+', please wait...')));ã R.Assign (2,5,38,6);ã Dlg.Insert (New (PStaticText, Init (R,ã '0% 50% 100%')));ã R.Move (0, 1);ã MyBar := New (PProgressBar, Init (R, '°', '²', 0));ã Dlg.Insert (MyBar);ã Desktop^.Insert (@Dlg);ã DoCopy.Init (4096, MyBar);ã ErrorCode := DoCopy.CopyFile (source, dest);ã DoCopy.Done;ã Dlg.Done;ã if ErrorCode <> 0 thenã MessageBox ('Error copying File!', NIL, mfError+mfOkButton);ãend;ãã{ãIf you don't want to have any progress bar at all, just pass NIL instead ofãMyBar to DoCopy.Init. And maybe you want to add this Functionality directly toãTFileCopy rather than deriving a new Object.ã}ã 13 05-28-9313:53ALL SWAG SUPPORT TEAM OOPINFO.PAS IMPORT 240 dp My understanding of OOP revolves around three principles:ãã ENCAPSULATION: All data-Types, Procedures, Functions are placedã within a new Type of wrapper called an Object.ãã This new wrapper is very simillar to a standardã Record structure, except that it also containsã the routines that will act on the data-Typesã within the Object.ãã The Object-oriented style of Programming requiresã that you should ONLY use the routines within theã Object to modify/retrieve each Object's data-Types.ã (ie: Don't access the Variables directly.)ããã Structured Style OOP Styleã ================ =========ã MyRecord = Record MyObject = Objectã 1st Variable; 1st Variable;ã 2nd Variable; 2nd Variable;ã 3rd Variable 3rd Variable;ã end; Procedure One;ã Procedure Two;ã Function One;ã Function Two;ã end;ãã inHERITANCE: This gives you the ability to make a new Object byã cloning an old Object. The new Object will containã all the abilities of the old Object.ã (ie: Variables, Procedures/Functions).ãã You can add additional abilities to this new Object,ã or replace old ones.ãã +--------------+ã | New Object |ã | +--------+ |ã | | Old | |ã | | Object | |ã | +--------+ |ã +--------------+ãã With Inheritance, you don't have to go back andã re-Write old routines to modify them into newã ones. Instead, simply clone the old Object andã add or replace Variables/Procedures/Functions.ãã This makes the whole process of rewriting/modifyingã a Program MUCH faster/easier. Also there is lessã chance of creating new bugs from your old bug-freeã source-code.ããã POLYMorPHISM: The name Sounds intimidating, but the concept isã simple.ãã Polymorphism allows one Procedure/Function toã act differently between one Object and all itsã descendants. (Clones)ãã These Type of "polymorphic" Procedures/Functionsã know which Object they are working on, and actã accordingly. For example:ãã Say you've created an Object (Object-1) thatã contains a Procedure called DrawWindow, to drawã the main screen of a Program.ãã DrawWindow relies on another Procedure SetBorderã within Object-1, to set the borders used in theã main screen.ãã Now you clone Object-2 from Object-1.ãã You want to use Object-2 to handle pop-up Windows,ã but you want the pop-ups to have a different borderã style.ãã if you call the DrawWindow Procedure that Object-2ã inherited from Object-1, you'll end up With a Windowã With the wrong border-style.ãã to get around this you could change the SetBorderã Procedure to a "Virtual" Procedure, and add aã second identically named "Virtual" Procedureã (SetBorder) within Object-2.ãã A "Virtual" Procedure relies on a "Virtual Table"ã (Which is basicly a Chart to indicate whichã "Virtual" routine belongs to which Object)ã to, indicate which version of the identicallyã named Procedures should be used within differentã Objects.ãã So within Object-1, the DrawWindow routine willã use the SetBorder Procedure within Object-1.ãã Within Object-2, the inherited DrawWindow routineã will use the other SetBorder Procedure that belongsã to Object-2.ãã This works because the "Virtual Table" tells theã DrawWindow routine which SetBorder Procedure toã use For each different Object.ãã So a call to the SetBorder Procedure now actsã differently, depending on which Object called it.ã This is "polymorphism" in action.ããã OOP LANGUAGE LinGO: The following are some of the proper names Forã OOP syntax.ãã Structured Programming OOP Programmingã ====================== ===============ã Variables Instancesã Procedures/Functions Methodsã Types Classesã Records Objectsãã{ã> i have a parent Object defined With Procedure a and b.ã> i have a child Object With Procedure a, b and c.ãã> when i declare say john being a child, i can use a, b, or c With noã> problem. when i declare john as being a parent, i can use a or b.ãã> if i declare john as being a parent and initialise it withã> new (childPTR,init) it seems i have access to the parent fieldsããAfter reading twice, I understand you mean Object classes dealing With humans,ãnot trees (happen to have parents & childs too).ãã> parent a,b,c,d,e,fã (bad)ã> parent a,bã (good)ã> child a,b,cã> child2 a,b,dã> child3 a,b,e,fã (redefine a, b For childs as Far as they differ from parent a,b)ããNext example could be offensive For christians, atheists and media-people.ã}ããTypeã TParent = Object { opt. (tObject) For Stream storage }ã Name : String;ã Constructor Init(AName: String);ã Procedure Pray; { your A,ã they all do it the same way }ã Procedure Decease; Virtual; { your B, Virtual, some instancesã behave different (Heaven/Hell) }ã Destructor Done; Virtual;ã end;ã TChild1 = Object(TParent)ã Disciples : Byte;ã Constructor Init(AName: String; DiscipleCount: Byte);ã { do not override Decease } { calling it will result in aã call to TParent.Decease }ã Procedure Resurrection; { your C }ã end;ã TChild2 = Object(TParent)ã BulletstoGo : LongInt;ã Constructor Init(DisciplesCount: Byte; Ammo: LongInt);ã Procedure Decease; Virtual; { override }ã Procedure Phone(Who: Caller); { your D }ã end;ãã Constructor TParent.Init(AName: String);ã beginã Name := AName;ã end;ã Destructor TParent.Done;ã beginã {(...)}ã end;ã Procedure TParent.Pray;ã beginã ContactGod;ã end;ã Procedure TParent.Decease;ã beginã GotoHeaven;ã end;ãã Constructor TChild1.Init(AName: String; DiscipleCount: Byte);ã beginã inherited Init(AName);ã Disciples := DiscipleCount;ã end;ã Procedure TChild1.Resurrection;ã beginã RiseFromTheDead;ã end;ãã Constructor TChild2.Init(AName: String;ã DiscipleCount: Byte; Ammo: LongInt);ã beginã inherited Init(DiscipleCount);ã BulletstoGo := Ammo;ã end;ã Procedure TChild2.Decease;ã beginã EternalBurn;ã end;ã Procedure TChild2.Phone(Who: Caller);ã beginã Case Who ofã AFT : Ventriloquize;ã Media : Say('Burp');ã end;ã end;ã{ãIn the next fragment all three Types of instances are put into a collection.ã}ãVarã Christians : PCollection;ããbeginã Christians := New(PCollection, Init(2,1));ã With Christians^ do beginã Insert(PParent, Init('Mary'));ã Insert(PParent, Init('John'));ã Insert(PChild1, Init('Jesus', 12));ã Insert(PChild2, Init('Koresh', 80, 1000000));ã end;ã{ãNow you can have all instances pray ...ã}ã Procedure DoPray(Item: Pointer); Far;ã beginã { unTyped Pointers cannot have method tables. The PParentã Typecast Forces a lookup of Pray in the method table.ã All instances With a TParent ancestor will point toã the same (non-Virtual) method }ã PParent(Item)^.Pray;ã end;ã { being sure all Items in Christians are derived from TParent }ã Christians^.ForEach(@DoPray);ã{ãand because all mortals will die...ã}ã Procedure endVisittoEarth(Item: Pointer); Far;ã beginã { Decease is a Virtual method. The offset of a location inã the VMT With the address of a Virtual method is determined byã the Compiler. At run-time, For each Type of instance 1 VMTã will be created, it's method-fields filled With theã appropriate addresses to call.ã Each instance of an Object derived from TParent will have theã address of it's VMT at the same location. Calling a Virtualã method results inã 1) retrieving that VMT address at a known offset inã the instance's data structureã 2) calling a Virtual method at a known offset in theã VMT found in 1)ã ThereFor mr. Koresh will go to hell: PChild2's VMT containsã at the offset For Decease the address of the overriddenã method. Mr. Jesus, a PChild1 instance, simply inherits theã address of PParent's Decease method at that offset in theã VMT. }ã PParent(Item)^.Decease;ã end;ã Christians^.ForEach(@endVisittoEarth);ãããã-> ...I've no problem posting my code, but I'm still not Really happyã-> With it's present Implementation. I also don't think that dynamicã-> Array Objects are very good examples of OOP. (For example, whatã-> do extend the dynamic-Array Object into, via inheiritance???)ã->ã-> ...Something more like a generic "Menu" or "Line-Editor" Objectã-> might be a better example.ããWell I don't know exactly what you are trying to do With your dynamicãArray but it can be OOP'ed. Linked lists are a prime example (I hopeãthis is close) By using OOP to Write link lists you can come up withãObjects such as:ããTypeã ListPtr = ^List;ã NodePtr = ^ListNode;ãã List (Object)ã TNode : Pointer; {Pointer to the top Record}ã BNode : Pointer; {Pointer ro the bottom Record}ã CurNode : Pointer; {Current Pointer}ãã Constructor Init; {Initializes List Object}ã Destructor Done; Virtual; {Destroys the list and all its nodes}ãã Function top (Var Node : ListNode) : NodePtr;ã Function Bottom (Var Node : ListNode) : NodePtr;ã Function Next (Var Node : ListNode) : NodePtr;ã Function Prev (Var Node : ListNode) : NodePtr;ã Function Current(Var Node : ListNode) : NodePtr;ãã Procedure AttachBeFore (Var Node : ListNode);ã Procedure AttachAfter (Var Node : ListNode);ã Procedure Detach (Var NodePtr : Pointer);ãã end;ãã ListNode = Object;ã Prev : NodePtr;ã Next : NodePtr;ãã Constructor Init;ã Destructor Done; Virtual;ãã end;ããThe list Object is just that. It has the basic operations you would doãwith a list. You can have more than one list but only one set ofãmethods will be linked in. The List node Dosn't have much other thanãthe Pointers to link them into a list and an Init, done methods. Soundsãlike a ton of work just to implement a list but there is so much you canãdo easely With OOP that you would have a hard time doing conventionally.ãOne example, because the ListNode's Done Destructor is Virtual the Doneãof the list can accually tranvirs the list and destroy all Objects inãthe list. One list can accually contain Objects that are not theãsame!!! Yep it sure can. As long as an Object is dirived from ListNodeãthe list can handel it. Try to do that using conventional methods!!ããI'm assuming that your dynamic Array will do something similar which isãwhy I suggested it. A Menu and Line editor Objects are High levelãObjects that should be based on smaller Objects. I'd assume that a lineãeditor would be a Complex list of Strings so the list and ListNodeãObjects would need to be built. See what I mean???ããthen you get into Abstract Objects. These are Objects that defineãcommon methods For its decendants but do not accually have any code toãsuport them. This way you have set up a standard set of routines thatãall decendants would have and Programs could be written using them. THeãresults of which would be a Program that could handel any Object basedãon the abstract.ãã-> RM>I have mixed feeling on this. I see OOP and Object as tools For aã-> RM>Program to manipulate.ã->ã-> RM> IE: File Objects, Screen Objects, ect then bind them togetherã-> RM> in a Program using conventional style coding.ã->ã-> ...to my understanding of the OOP style of Programming, this wouldã-> be a "NO-NO".ããOK well With the exception of TApplication Object in Turbo Vision aãProgram is a speciaized code that more than likely can't be of any useãFor decendants. That was my reasioning at least. and the Tapp Objectãisn't a Program eather. YOu have to over ride a ton of methods to getãit to do anything.ãUnit OpFile; {******* Capture this For future referance *******}ããInterfaceããTypeããDateTimeRec = Recordã {Define the fields you want For date and time routines}ã end;ããAbstractFile = Objectãã Function Open : Boolean; Virtual;ã {Opens the File in the requested mode base on internal Variables }ã {Returns True if sucessfull }ãã Procedure Close; Virtual;ã {Flush all buffers and close the File }ãã Function Exists : Boolean; Virtual;ã {Returns True is the File exists }ãã Function Create : Boolean; Virtual;ã {Will create the File or overWrite it if it already exists }ãã Procedure Delete; Virtual;ã {Will delete the File. }ãã Function Rename : Boolean; Virtual;ã {Will rename the File returns True if successfull }ãã Function Size : LongInt; Virtual;ã {Returns the size of the File. }ãã Procedure Flush; Virtual;ã {Will flush the buffers without closing the File. }ãã Function Lock : Boolean; Virtual;ã {Will attempt to lock the File in a network enviroment, returns }ã {True if sucessfull }ãã Procedure Unlock; Virtual;ã {Will unlock the File in a network enviroment }ãã Function Copy (PathName : String) : Boolean; Virtual;ã {Will copy its self to another File, returns True is successfull.}ãã Function GetDateTime (Var DT : DateTimeRec) : Boolean; Virtual;ã {Will get the File date/time stamp. }ãã Function SetDateTime (Var DT : DateTimeRec) : Boolean; Virtual;ã {Will set the File date stamp. }ãã Function GetAttr : Byte; Virtual;ã {Will get the File attributes. }ãã Function SetAttr (Atr : Byte) : Boolean; Virtual;ã {Will set a File's attributes. }ããend; {of AbstractFile Object}ããImplementationãã Procedure Abstract; {Cause a run time error of 211}ã beginã Runerror (211);ã end;ãã Function AbstractFile.Open : Boolean;ã beginã Abstract;ã end;ãã Procedure AbstractFile.Close;ã beginã Abstract;ã end;ãã Function AbstractFile.Exists : Boolean;ã beginã Abstract;ã end;ãã Function AbstractFile.Create : Boolean;ã beginã Abstract;ã end;ãã Procedure AbstractFile.Delete;ã beginã Abstract;ã end;ãã Function AbstractFile.Rename : Boolean;ã beginã Abstract;ã end;ããOk theres a few things we have to talk about here.ãã1. This is an ABSTRACT Object. It only defines a common set ofãroutines that its decendants will have.ãã2. notice the Procedure Abstract. It will generate a runtime errorã211. This is not defined by TP. Every Method of an Object has to doãsomthing. if we just did nothing we could launch our Program intoãspace. By having all methods call Abstract it will error out theãProgram and you will know that you have called and abstract method.ãã3. I'm sure some may question why some are Procedures and some areãFunctions ie Open is a Function and close is a Boolean. What I basedãthem on is if an error check a mandatory it will be a Function Boolean;ãThis way loops will be clean. Open in a network Open will require aãcheck because it may be locked. Which brings up point 4.ãã4. We are not even finished With this Object yet. We still have toãdefine a standard error reporting / checking methods and also lock loopãcontrol methods. not to mention some kind of common data and methods toãmanipulate that data. Moving to point 5.ãã5. Where does it end??? Well we hvae added quite a few Virtual methodsãWhile thsi is not bad it does have a negative side. All Virtual methodsãwill be linked in to the final EXE weather it is used or not. There areãvalid reasions For this but you don't want to make everything Virtual ifãit Dosn't have to be. My thinking is this. if it should be a standardãroutine For all decendants then it should be Virtual. if requiredãmethods call a method then why not make it Virtual (this will becomeãmore apparent in network methods and expanding this Object)ããNow personally I get a feeling that the DateTime and Attr methodsãshouldnn't be there or at least not Virtual as the vast majority ofãPrograms will not need them and its pushing the limits of Operatingãsystem spisific methods. SO it will probly be a Dos only Object. (Yesãthere are others that have this but I think its over kill) The sameãgoes For the copy and rename methods so I would lean to removing themãfrom this Object and define them in decendants.ããSo what do you think we need to have For error checking / reportingãmethods??? Do you think we could use more / different methods???ããã{ã DW> I am trying to teach myself about Object orientated Programming andã DW> about 'inheritence'. This is my code using Records.ããThe idea of Object oriented Programing is what is refered to asãencapsulation. Your data and the Functions that manipulate it areãgrouped together. As an example, in a traditional Program, a linkedãlist would look something like:ã}ããTypeã Linked_List =ã Recordã Data : Integer; {Some data}ã Next : ^Linked_List; {Next data}ã Prev : ^Linked_List; {Prev data}ã end;ããthen you would have a whole slew of Functions that took Linked_List as aãparameter. Under OOP, it would look more likeããTypeã Linked_List =ã Objectã Data : Integer;ã Next : ^Linked_List;ã Prev : ^Linked_List;ãã Constructor Init(); {Initializes Linked_List}ã Destructor DeInit(); {Deinitializes Linked_List}ã Procedure AddItem(aData : Integer);ã Procedure GetItem(Var aData : Integer);ã end;ããthen, to add an item to a particular list, the code would look like:ãThis_Linked_List.AddItem(10);ããThis is easier to understand. An easy way to think about this is thatãan Object is an entity sitting out there. You tell it what you want toãdo, instead of calling a Function you can't identify. Inheritanceãallows you to make a linked list that holds a different Type, but Usesãthe same Interface funtions. More importantly, using the same methodãand Pointers, you could have both Types in the same list, depending onãhow you implemented it.ããIt helps debugging time, because if you wanted to add a Walk_ListãFunction, you could add it and get it working For the parent Object, andã(since the mechanics of it would be the same For ANY Linked List), youãcould Write it once and use it without problems. That is a clearãadvantage. Other Uses include:ãã(For a door Type Program) and Input/Output Object that serves as a baseãFor a console Object and a modem Object, and thusly allows you to treatãthe two as the same device, allowing you to easily use both.ãã(For a BBS Message base kit) a Generic Message Object that serves as aãbase For a set of Objects, each of which implements a different BBS'ãdata structures. Using this kit, a Program could send a message to anyãof the BBSes just by knowing the core Object's mechanics.ãã(For Windows) a Generic Object represents a Generic Window. Byãinheritance, you inherit the Functionality of the original Window. Byãcreating an Object derived from the generic Window, you can addãadditional Functionality, without having to first Write routines toãmirror existing Functionality.ãã(For Sound) a Generic Object represents a generic Sound device.ãSpecific child Object translate basic commands (note on, note off, etc)ãto device specific commands. Again, the Program doesn't have to knowãwhether there is a PC speaker or an Adlib or a SoundBlaster--all it hasãto know is that it calls note_on to start a note and note_off to end aãnote.ããThere are thousands on thousands of other examples. if you read throughãthe turbo guides to turbovision or to Object oriented Programming, theyãwill help you understand. Also, a good book on Object orientedãProgramming doesn't hurt ;>.ããããã{ã> Now, the questions:ã> 1. How do I discretly get the Lat & Long into separateã> Collections? In other Words (psuedocode):ããNo need For seperate collections, put all the inFormation in a Singleãcollection.ãã> Any hints would be appreciated. Thanks!ããI'll not give any help With parsing the Text File, there will probably be a tonãof advice there, but here is a little Program that I threw together (andãtested) that will list the inFormation and present the additional data.ãHave fun With it.ã}ããProgram Test;ãUses Objects,dialogs,app,drivers,views,menus,msgbox;ããTypeã (*Define the Data Element Type*)ã Data = Recordã Location : PString;ã Long,Lat : Real;ã end;ã PData = ^Data;ãã (*Define a colection of the data elements*)ã DataCol = Object(TCollection)ã Procedure FreeItem(Item:Pointer); Virtual;ã end;ã PDC =^DataCol;ãã (*Define a list to display the collection*)ã DataList = Object(TListBox)ã Function GetText(item:Integer;maxlen:Integer):String; Virtual;ã Destructor done; Virtual;ã end;ã PDL = ^DataList;ãã (*Define a dialog to display the list *)ã DataDlg = Object(TDialog)ã Pc : PDC;ã Pl : PDL;ã Ps : PScrollBar;ã Constructor Init(Var bounds:Trect;Atitle:TTitleStr);ã Procedure HandleEvent(Var Event:TEvent); Virtual;ã end;ã PDD = ^DataDlg;ããConstã CmCo = 100;ã CmGo = 101;ãããProcedure DataCol.FreeItem(Item:Pointer);ã beginã disposeStr(PString(PData(Item)^.Location));ã dispose(PData(Item));ã end;ããFunction DataList.GetText(item:Integer;maxlen:Integer):String;ã beginã GetText := PString(PData(List^.At(item))^.Location)^;ã end;ããDestructor DataList.Done;ã beginã Dispose(PDC(List),Done);ã TListBox.Done;ã end;ããConstructor DataDLG.Init(Var bounds:Trect;Atitle:TTitleStr);ã Varã r : trect;ã pd : pdata;ã beginã TDialog.Init(bounds,ATitle);ã geTextent(r); r.grow(-1,-1); r.a.x := r.b.x - 1; dec(r.b.y);ã new(ps,init(r)); insert(ps);ãã geTextent(r); r.grow(-1,-1); dec(r.b.x); dec(r.b.y);ã new(pl,init(r,1,ps)); insert(pl);ãã geTextent(r); r.grow(-1,-1); r.a.y := r.b.y - 1;ã insert(new(pstatusline,init(r,ã newstatusdef(0,$FFFF,ã newstatuskey('~[Esc]~ Quit ',kbesc,CmGo,ã newstatuskey(' ~[Alt-C]~ Co-ordinates ',kbaltc,CmCo,ã newstatuskey('',kbenter,CmCo,nil))),nil))));ãã new(Pc,init(3,0));ã With pc^ do (*parse your File and fill the*)ã begin (*collection here *)ã new(pd);ã pd^.location := newstr('Port Arthur, Texas');ã pd^.long := 29.875; pd^.lat := 93.9375;ã insert(pd);ã new(pd);ã pd^.location := newstr('Port-au-Prince, Haiti');ã pd^.long := 18.53; pd^.lat := 72.33;ã insert(pd);ã new(pd);ã pd^.location := newstr('Roswell, New Mexico');ã pd^.long := 33.44118; pd^.lat := 104.5643;ã insert(pd);ã end;ã Pl^.newlist(pc);ã end;ããProcedure DataDlg.HandleEvent(Var Event:TEvent);ã Varã los,las : String;ã beginã TDialog.HandleEvent(Event);ã if Event.What = EvCommand thenã Case Event.Command ofã CmGo : endModal(Event.Command);ã CmCo : beginã str(PData(Pl^.List^.At(Pl^.Focused))^.Long:3:3,los);ã str(PData(Pl^.List^.At(Pl^.Focused))^.Lat:3:3,las);ã MessageBox(ã #3+PString(PData(Pl^.List^.At(Pl^.Focused))^.Location)^ +ã #13+#3+'Longitude : '+los+#13+#3+'Latitude : '+las,ã nil,mfinFormation+mfokbutton);ã end;ã end;ã end;ããType (*the application layer *)ã myapp = Object(Tapplication)ã Procedure run; Virtual;ã end;ããProcedure myapp.run;ã Var r:trect;ã p:PDD;ã beginã geTextent(r);ã r.grow(-20,-5);ã new(p,init(r,'Dialog by ken burrows'));ã if p <> nil thenã beginã desktop^.execview(p);ã dispose(p,done);ã end;ã end;ããVarã a:myapp;ããbeginã a.init;ã a.run;ã a.done;ãend.ããããã> I am having a problem. I would like to Write an editor. Theã> problem is I dont understand a thing about Pointers (which everyoneã> seems to use For editors).ãã I'm certainly no TP expert, but I might be able to help out With theãPointers. Pointers are just special 4-Byte Variables that contain (ãpoint to) a specific position in memory. You can also make a Pointerãact like the thing to which it is pointing is a particular Type ofãVariable (Byte, String, etc). Unlike normal Var Variables, however, theseãVariables are what's referred to as Virtual -- they aren't fixed in theã.EXE code like Var Vars, so you can have as many of them as you like,ãwithin memory Constraints. Each is created when needed using the GetMemãstatement. This statement makes a request For some more memory to beãused in the heap (all left-over memory when the Program loads usually).ããWhat you need in a editor is to be able to somehow link the Stringsãthat make up the document into what's called a list (first line, next,ã... , last line). The easiest way to visualize this is a bunch of peopleãin a line holding hands, each hand being a Pointer. The hand is not theãentire person, it just connects to the next one. So, what you do isãuse a Record that contains one String For one line of Text, a Pointer toãthe previous line of Text in the document, and a Pointer to the next lineãin the document. A Record like this should do it:ã {+------------------------- Usually used in starting a Type of Pointer}ã {|+------------------------ Points to a String in the document }ã {|| +----------- This is usedto mean that PStringItem is }ã || | to be a Pointer pointing to a Record }ã || | known as TStringItem }ã {vv vãType PStringItem = ^TStringItem;ã TStringItem : Recordã LineOText : String [160]; {Double the screen width should do it}ã NextLine : PStringItem; {Points to the next line in memory}ã PrevLine : PStringItem; {Points to the previous line in memory}ã end;ããIn your editor main Program, useããVar FirstLine, LastLine, StartLine, CurrLine : PStringItem;ããto create Varibles giving you `bookmarks' to the first line in theãFile, last in the File, the one the cursor is on, and the one thatãstarts the screen. All of these will change.ããto create the first line in the document, use:ããGetMem (FirstLine, Sizeof (TStringItem)); {get memory enough For one line}ãCurrLine := FirstLine; {of course, only one line in the doc so Far!}ãLastLine := FirstLine;ãStartLine := FirstLine;ãFirstLine^.NextLine := nil; {nil means no particular place-- there's no}ãFirstLine^.PrevLine := nil; {line beFore of after FirstLine yet }ããNow the Variable FirstLine will contain the address of the newly createdãVariable. to address that Variable, use the carrot (^), like this:ããFirstLine^.LineOText := 'Hello World!');ããto make a new line in the list just get more memory For another line:ããGetMem (LastLine^.NextLine, Sizeof (TStringItem));ãLastLine := LastLine^.NextLine;ããThis will get more memory and set the last line in the File'sãnext line Pointer to the new String, then make the new String theãlast line.ããDeleting a line is almost as simple. You use the FreeMem Procedureãto release the memory used by a Variable. if it's in the middle of theãlist, just set the to-be-deleted's next line's previous line to theãto-be deleted's previous line, and the previous line's next to the oneãafter the one to be deleted, essentially removing it from the list andãthen tieing the peices back together. You can then kill off the memoryãused by that line.ãã{Delete current line}ãif CurrLine^.NextLine <> nil then {there's a line after this one}ã CurrLine^.NextLine^.PrevLine := CurrLine^.PrevLine;ãif CurrLine^.PrevLine <> nil then {there's a line beFore this one}ã CurrLine^.PrevLine^.NextLine := CurrLine^.NextLine;ãFreeMem (CurrLine, Sizeof (TStringItem));ããto insert a line, just do about the opposite.ããif you don't understand, I won't blame you, I'm half asleep anyway...ãbut I hoe it clears some of the fog. if the manual isn't helpfulãenough now, try tom Swan's _Mastering Turbo Pascal_, an excellentãbook.ã 14 05-28-9313:53ALL SWAG SUPPORT TEAM OOPMENU.PAS IMPORT 17 dC {ãMenus in TV are instances of class tMenuBar, accessed via Pointer TypeãpMenuBar. A Complete menu is a Single-linked list, terminated With a NILãPointer. Each item or node is just a Record that holds inFormation onãwhat the node displays and responds to, and a Pointer to the next menuãnode in the list.ããI've written out a short bit of TV menu code that you can Compile andãplay With, and then you can highlight parts that you don't understandãwhen you send back your reply.ã}ããProgram TestMenu;ããUsesã Objects, Drivers, Views, Menus, App;ããConstã cmOpen = 100; (* Command message Constants *)ã cmClose = 101;ããTypeã pTestApp = ^tTestApp;ã tTestApp = Object(tApplication)ã Procedure InitMenuBar; Virtual; (* Do-nothing inherited method *)ã end; (* which you override *)ãã(* Set up the menu by filling in the inherited method *)ãProcedure tTestApp.InitMenuBar;ãVarã vRect : tRect;ããbeginã GetExtent(vRect);ã vRect.B.Y := vRect.A.Y + 1;ã MenuBar := New(pMenuBar, Init(vRect, NewMenu(ã NewSubMenu('~F~ile', hcNoConText, NewMenu(ã NewItem('~O~pen', 'Alt-O', kbAltO, cmOpen, hcNoConText,ã NewItem('~C~lose', 'Alt-C', kbAltC, cmClose, hcNoConText,ã NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoConText,ã NIL)))),ã NewSubMenu('~E~dit', hcNoConText, NewMenu(ã NewItem('C~u~t', 'Alt-U', kbAltU, cmCut, hcNoConText,ã NewItem('Cop~y~', 'Alt-Y', kbAltY, cmCopy, hcNoConText,ã NewItem('~P~aste', 'Alt-P', kbAltP, cmPaste, hcNoConText,ã NewItem('C~l~ear', 'Alt-L', kbAltL, cmClear, hcNoConText,ã NIL))))),ã NewSubMenu('~W~indow', hcNoConText, NewMenu(ã NewItem('Ca~s~cade', 'Alt-S', kbAltS, cmCascade, hcNoConText,ã NewItem('~T~ile', 'Alt-T', kbAltT, cmTile, hcNoConText,ã NIL))),ã NIL))))ã ))ãend;ããVarã vApp : pTestApp;ããbeginã New(vApp, Init);ã if vApp = NIL thenã beginã WriteLn('Couldn''t instantiate the application');ã Exit;ã end;ã vApp^.Run;ã vApp^.Done;ãend.ã 15 05-28-9313:53ALL SCOTT RAMSAY OOPOBJS.PAS IMPORT 46 dÏk Unit OopObjs;ãã{ OOPOBJS.PAS Version 1.1 Copyright 1992 Scott D. Ramsay }ãã{ OOPOBJS.PAS is free! Go crazy. }ã{ When I was learning Linked-List in High School, I thought that I'd only }ã{ need it in boring stuff like database Programming. Doubled linked-list, }ã{ is a great way to handle multiple Objects For games. Throw in some OOP }ã{ design and Volia! Easy managable sprites. }ã{ I give this code to Public Domain. Use it as you see fit. Just include }ã{ the first comment line when distributing the source code, Thanks. }ãã{ Changes from 1.0: }ã{ Added new parameter in method checkhit. }ã{ Var item:pobj }ã{ Is a Pointer to the Object which called the checkhit }ããInterfaceããTypeã plist = ^tlist;ã PObjs = ^tobjs;ã tobjs = Objectã nx,ny, { Sprite Position }ã flp, { Sprite number (For animation) }ã nrx, { I Forget what this does }ã num_sprite, { Num of sprites per Objects }ã timeo, { How long this Object lasts }ã pointage : Integer; { Score value (For gamers) }ã mapcolor : Byte; { Color For radar display }ã id, { I Forget this one too }ã explo, { True if the Object is explodin}ã overshow : Boolean; { See: Procedure DRAWITEMS }ã powner : plist; { The PLIST node which this }ã { Object belongs }ã Constructor init(vx,vy:Integer);ã Procedure drawitemObject;Virtual;ã Procedure calcitemObject;Virtual;ã Function checkhit(hx,hy:Integer;Var item:pobjs):Boolean;Virtual;ã Destructor done; Virtual;ã end;ã PobjMov = ^tobjMov;ã tobjMov = Object(tobjs)ã ndx,ndy : Integer;ã Constructor init(vx,vy,vdx,vdy:Integer);ã Procedure calcitemObject; Virtual;ã end;ã tlist = Recordã item : pobjs;ã prev,next : plist;ã end;ã pkill = ^tkill;ã tkill = Recordã tk : plist;ã next : pkill;ã end;ããProcedure addp(Var nkbeg,nkend,p:plist);ãProcedure deletep(Var nkbeg,nkend,p:plist);ãProcedure calcitems(Var nkbeg:plist);ãProcedure drawitems(Var nkbeg:plist;over:Boolean);ãProcedure add2kill_list(Var kill:pkill;Var i:plist);ãProcedure cleankill_list(Var kill:pkill;Var nkbeg,nkend:plist);ãProcedure clean_plist(Var nkbeg,nkend:plist);ããImplementationããProcedure calcitems(Var nkbeg:plist);ãVarã p : plist;ãbeginã p := nkbeg;ã While p<>nil doã beginã p^.item^.calcitemObject;ã p := p^.next;ã end;ãend;ãããProcedure drawitems(Var nkbeg:plist;over:Boolean);ã{ã This Procedure is usually called from: (GMorPH.PAS)ã Tmorph.pre_mapã Tmorph.post_mapã The OVER flag tells when this Object should be drawn. Behindã geomorph or infront of the geomorph.ã}ãVarã p : plist;ãbeginã p := nkbeg;ã While p<>nil doã beginã if (p^.item^.overshow=over)ã then p^.item^.drawitemObject;ã p := p^.next;ã end;ãend;ãããProcedure clean_plist(Var nkbeg,nkend:plist);ãVarã p,p2 : plist;ãbeginã p := nkbeg;ã While p<>nil doã beginã p2 := p;ã p := p^.next;ã dispose(p2^.item,done);ã dispose(p2);ã end;ã nkbeg := nil;ã nkend := nil;ãend;ãããProcedure addp(Var nkbeg,nkend,p:plist);ãbeginã p^.next := nil;ã if nkend=nilã thenã beginã nkbeg := p;ã nkend := p;ã p^.prev := nil;ã endã elseã beginã p^.prev := nkend;ã nkend^.next := p;ã nkend := p;ã end;ãend;ãããProcedure deletep(Var nkbeg,nkend,p:plist);ãbeginã if nkbeg=nkendã thenã beginã nkbeg := nil;ã nkend := nil;ã endã elseã if nkbeg=pã thenã beginã nkbeg := nkbeg^.next;ã nkbeg^.prev := nil;ã endã elseã if nkend=pã thenã beginã nkend := nkend^.prev;ã nkend^.next := nil;ã endã elseã beginã p^.next^.prev := p^.prev;ã p^.prev^.next := p^.next;ã end;ã dispose(p^.item,done);ã dispose(p);ãend;ãããProcedure cleankill_list(Var kill:pkill;Var nkbeg,nkend:plist);ãVarã p,p2 : pkill;ãbeginã p := kill;ã While p<>nil doã beginã p2 := p;ã p := p^.next;ã deletep(nkbeg,nkend,p2^.tk);ã dispose(p2);ã end;ã kill := nil;ãend;ãããProcedure add2kill_list(Var kill:pkill;Var i:plist);ãVarã p : pkill;ãbeginã new(p);ã p^.tk := i;ã p^.next := kill;ã kill := pãend;ãã(**) { tobjs Methods }ããConstructor tobjs.init(vx,vy:Integer);ãbeginã nx := vx; ny := vy; num_sprite := 1;ã mapcolor := $fb; pointage := 0;ã flp := 0; overshow := False;ãend;ãããDestructor tobjs.done;ãbeginãend;ãããProcedure tobjs.drawitemObject;ãbeginã { i.e.ã fbitdraw(nx,ny,pic[flip]^);ã }ãend;ãããProcedure tobjs.calcitemObject;ãbeginãend;ãããFunction tobjs.checkhit(hx,hy:Integer;Var item:pobjs):Boolean;ãbeginãend;ãã(**) { tobjMov methods }ããConstructor tobjMov.init(vx,vy,vdx,vdy:Integer);ãbeginã nx := vx; ny := vy; ndx := vdx; ndy := vdy;ã mapcolor := $fb; pointage := 0;ã flp := 0; overshow := False;ãend;ãããProcedure tobjMov.calcitemObject;ãbeginã { These are just simple examples of what should go in the methods }ã inc(nx,ndx); inc(ny,ndy);ã flp := (flp+1)mod num_sprite;ãend;ããend. 16 05-28-9313:53ALL SWAG SUPPORT TEAM SORTCOLL.PAS IMPORT 30 d°æ {ãThis post is just to demonstrate a very simple sorted collection usingãnon-Object Types With the collection. If it is needed to store itselfãto a stream, it will need additional over-ridden methods to do that.ãI'm just posting this, because I wrote it several days ago to implementãa simple Variable system in a script language For a menu Program that Iãwrote, and I was looking For an *easier* way to maintain the Variableãlist than With a linked list. To my astonishment, today, I needed aãsimilar structure, and (ohmygosh) I found that I could *re-use* thisãcode, by merely deriving a child class and adding another method or so.ãThis is the first time that I have ever *re-used* an Object Type that Iãhave modified. Of course, I haven't been actually using TurboVision forãmore than a month or so, so I haven't had much of a chance, but it isãvery nice to see that when people talk about "Object orientedãProgramming paradigm", they are not ONLY speaking in big Words, but thatãthey also (apparently) are telling the truth.ããI'm not taking any responsibility if this overWrites your interruptãvector table, so be carefull. If you find any mistakes, or actuallyãmodify this code to become more usefull, I'd appreciate it if you couldãtell me- actually determining the best way to implement a new Objectãclass is kind of difficult For me since I've only been doing this forãabout a month, trying to squeeze it in along With school and a job.ããHere's the code...ã{********* STARTS HERE **********}ã{ Unit: STROBJ.PASã WRITTEN BY: Brian Papeã DATE: 03/28/93ã Copyright 1993 by Brian Pape and Alphawave Technologiesã This Unit contains String Type Objectsã}ã{$P+} { Enable open String parameters. Replace by $V- For TP 6.0 or lower }ãUnit strobj;ããInterfaceããUsesã Objects;ããTypeã str20 = String[20];ãã PVarType = ^TVarType;ã TVarType = Recordã name : str20;ã value : String;ã end; { TVarType }ãã PVarCollection = ^TVarCollection;ã TVarCollection = Object(TSortedCollection)ã Constructor init(Alimit,Adelta:Integer);ã Function KeyOf(item:Pointer):Pointer; virtual;ã Function Compare(Key1,Key2:Pointer):Integer; virtual;ã Procedure freeitem(Item:Pointer); virtual;ãã { This Function will return the value of a Variable in a TVarCollection }ã Function getVar(s:String):String;ãã { Adds a PVarType Record to the collection, without having to manuallyã create, and allocate memory for, a Record Type }ã Procedure add(aname:str20;avalue:String);ã end; { TVarCollection }ããImplementationããConstructor TVarCollection.init(ALimit,ADelta:Integer);ãbeginã inherited init(ALimit,ADelta);ãend; { TVarCollection.init }ããFunction TVarCollection.KeyOf(item:Pointer):Pointer;ãbeginã KeyOf := @(TVarType(item^).name);ãend; { TVarCollection.KeyOf }ããFunction TVarCollection.Compare(Key1,Key2:Pointer):Integer;ãbeginã if String(Key1^) > String(Key2^) thenã Compare := 1ã else if String(Key1^) = String(Key2^) thenã Compare := 0ã else Compare := -1;ãend; { TVarCollection.Compare }ããProcedure TVarCollection.freeitem(Item:Pointer);ãbeginã dispose(Item);ãend; { freeitem }ããFunction TVarCollection.getVar(s:String):String;ãVarã t : TVarType;ã where : Integer;ãbeginã t.name := s;ã if Search(@t,where) thenã getVar := TVarType(at(where)^).valueã elseã getVar := '';ãend; { getVar }ãããProcedure TVarCollection.add(aname:str20;avalue:String);ãVarã rec : PVarType;ãbeginã rec := new(PVarType);ã rec^.name := aname;ã rec^.value := avalue;ã insert(rec);ãend; { add }ããbeginãend. { strobj }ã{*********** endS HERE *************}ã 17 05-28-9313:53ALL SWAG SUPPORT TEAM STATUDLG.PAS IMPORT 32 dÇ Program StatusDialogDemo;ãã Usesã Crt,Objects,Drivers,Views,Dialogs,App;ãã Typeã PDemo = ^TDemo;ã TDemo = Object (TApplication)ã Constructor Init;ã end;ãã PStatusDialog = ^TStatusDialog;ã TStatusDialog = Object (TDialog)ã Message,Value: PStaticText;ã Constructor Init;ã Procedure Update (Status: Word; AValue: Word); Virtual;ã end;ãã Constructor TDemo.Init;ãã Varã D: PStatusDialog;ã I: Integer;ã E: TEvent;ãã beginã TApplication.Init;ã D := New (PStatusDialog,Init);ã Desktop^.Insert (D);ã For I := 1 to 10 doã beginã D^.Update (cmValid,I * 10);ã if CtrlBreakHit thenã beginã CtrlBreakHit := False;ã GetEvent (E); { eat the Ctrl-Break }ã D^.Update (cmCancel,I * 10);ã Repeat GetEvent (E) Until (E.What = evKeyDown)ã or (E.What = evMouseDown);ã Desktop^.Delete (D);ã Dispose (D,Done);ã Exit;ã end;ã Delay (1000); { simulate processing }ã end;ã D^.Update (cmOK,100);ã Repeat GetEvent (E) Until (E.What = evKeyDown)ã or (E.What = evMouseDown);ã Desktop^.Delete (D);ã Dispose (D,Done);ã end;ãã Constructor TStatusDialog.Init;ãã Varã R: TRect;ãã beginã R.Assign (20,6,60,12);ã TDialog.Init(R,'Processing...');ã Flags := Flags and not wfClose;ã R.Assign (10,2,30,3);ã Insert (New (PStaticText,Init (R,'Completed Record xxx')));ã R.Assign (27,2,30,3);ã Value := New (PStaticText,Init (R,' 0'));ã Insert (Value);ã R.Assign (2,4,38,5);ã Message := New (PStaticText,Init (R,ã ' Press Ctrl-Break to cancel '));ã Insert (Message);ã end;ãã Procedure TStatusDialog.Update (Status: Word; AValue: Word);ãã Varã ValStr: String[3];ãã beginã Case Status ofã cmCancel: beginã DisposeStr (Message^.Text);ã Message^.Text := NewStr (' Cancelled - press any key ');ã Message^.DrawView;ã end;ã cmOK: beginã DisposeStr (Message^.Text);ã Message^.Text := NewStr (' Completed - press any key ');ã Message^.DrawView;ã end;ã end;ã Str (AValue:3,ValStr);ã DisposeStr (Value^.Text);ã Value^.Text := NewStr (ValStr);ã Value^.DrawView;ã end;ãã Varã Demo: TDemo;ãã beginã Demo.Init;ã Demo.Run;ã Demo.Done;ã end.ãã {ãGH> Can someone explain how exactly to display aãGH>parameterized Text field into a dialog Window? This is what IããHere is a dialog that I hope does what you want. It comes from Shazam,ãa TV dialog editor and code generator. Also a great learning tool.ãYOu can get it as SZ2.zip from Compuserve or from Jonathan Steinãdirectly at PO Box 346, Perrysburg OH 43552 fax 419-874-4922.ãã Function MakeDialog : PDialog ; Var Dlg :ã PDialog ; R : TRect ; Control , Labl , Histryã : PView ; begin R.Assign ( 0 , 10 , 37 , 23 ) ; New ( Dlg , Init ( Rã , 'About #2' ) ) ;ãã R.Assign ( 10 , 2 , 26 , 3 ) ;ã Control := New ( PStaticText , Init ( R ,ã 'A Sample Program' ) ) ;ã Dlg^.Insert ( Control ) ;ãã R.Assign ( 13 , 4 , 20 , 5 ) ;ã Control := New ( PStaticText , Init ( R ,ã 'Version' ) ) ;ã Dlg^.Insert ( Control ) ;ãã R.Assign ( 21 , 4 , 28 , 5 ) ;ã Control := New ( PParamText , Init ( R , '%-s ' , 1 ) )ã Dlg^.Insert ( Control ) ;ãã R.Assign ( 8 , 6 , 29 , 7 ) ;ã Control := New ( PStaticText , Init ( R ,ã '(C) Copyright 19xx by' ) ) ;ã Dlg^.Insert ( Control ) ;ãã R.Assign ( 8 , 8 , 29 , 9 ) ;ã Control := New ( PStaticText , Init ( R ,ã 'Anybody, Incorporated' ) ) ;ã Dlg^.Insert ( Control ) ;ãã R.Assign ( 14 , 10 , 24 , 12 ) ;ã Control := New ( PButton , Init ( R , ' O~K~ ' , cmOK , bfDefault));ã Control^.HelpCtx := hcAbout2 ;ã Dlg^.Insert ( Control ) ;ãã Dlg^.SelectNext ( False ) ;ã MakeDialog := Dlg ;ãend ;ããVarã DataRec : Recordã ParamField1 : PString ; { ParamText }ã end ;ãã } 18 05-28-9313:53ALL SWAG SUPPORT TEAM STROBJ.PAS IMPORT 44 dé
Program KenTest;ã{ a short program to check out collecting TObject Descendents, asã opposed to binding data types directly to a collection object}ããUses Objects;ãTypeã PBaseData = ^BaseData;ã BaseData = Object(TObject)ã name : PString;ã DType: Word;ã Data : Pointer;ã Constructor Init(AName:String;Var AData);ã Procedure PutData(Var S:TStream); virtual;ã Function GetData(Var S:TStream):Pointer; virtual;ã Procedure SetData(Var ADAta); virtual;ã Constructor Load(Var S:TStream);ã Procedure Store(Var S:TStream); virtual;ã Destructor Done; virtual;ã end;ãConstructor BaseData.Init(AName:String;Var AData);ã Beginã Name := NewStr(Aname);ã Data := Nil;ã SetData(AData);ã End;ãConstructor BaseData.Load(Var S:TStream);ã Beginã Name := S.ReadStr;ã S.Read(DType,2);ã Data := GetData(S);ã End;ãProcedure BaseData.SetData(Var AData);ã Beginã DType := 0;ã End;ãProcedure BaseData.Store(Var S:TStream);ã Beginã S.WriteStr(Name);ã S.Write(DType,2);ã PutData(S);ã End;ãFunction BaseData.GetData(Var S:TStream):Pointer;ã Beginã GetData := Nil;ã End;ãProcedure BaseData.PutData(Var S:TStream);ã Beginã End;ãDestructor BaseData.Done;ã Beginã DisposeStr(Name);ã End;ããTypeã PStrData = ^StrData;ã StrData = Object(BaseData)ã Procedure PutData(Var S:TStream); virtual;ã Function GetData(Var S:TStream):Pointer; virtual;ã Procedure SetData(Var ADAta); virtual;ã Destructor Done; virtual;ã end;ã LongPtr = ^LongInt;ã PNumData = ^NumData;ã NumData = Object(BaseData)ã Procedure PutData(Var S:TStream); virtual;ã Function GetData(Var S:TStream):Pointer; virtual;ã Procedure SetData(Var ADAta); virtual;ã Destructor Done; virtual;ã end;ããProcedure StrData.PutData(Var S:TStream);ã Beginã S.WriteStr(PString(Data));ã End;ãFunction StrData.GetData(Var S:TStream):Pointer;ã Beginã GetData := S.ReadStr;ã End;ãProcedure StrData.SetData(Var AData);ã Var S:String Absolute AData;ã Beginã Data := NewStr(S);ã DType := 1;ã End;ãDestructor StrData.Done;ã Beginã DisposeStr(PString(Data));ã Inherited Done;ã End;ããProcedure NumData.PutData(Var S:TStream);ã Beginã S.Write(LongPtr(Data)^,SizeOf(LongInt));ã End;ãFunction NumData.GetData(Var S:TStream):Pointer;ã Var L : LongPtr;ã Beginã New(L);ã S.Read(L^,SizeOf(LongInt));ã GetData := L;ã End;ãProcedure NumData.SetData(Var AData);ã Var L:LongInt Absolute AData;ã Beginã DType := 2;ã New(LongPtr(Data));ã LongPtr(Data)^ := L;ã End;ãDestructor NumData.Done;ã Beginã Dispose(LongPtr(Data));ã Inherited Done;ã End;ããConstãRStrDataRec : TStreamRec = (ObjType : 19561;ã VMTLink : Ofs(TypeOf(StrData)^);ã Load : @StrData.Load;ã Store : @StrData.Store);ããRNumDataRec : TStreamRec = (ObjType : 19562;ã VMTLink : Ofs(TypeOf(NumData)^);ã Load : @NumData.Load;ã Store : @NumData.Store);ããProcedure ShowStuff(P:PCollection);ã Procedure ShowName(P:PBaseData); far;ã Beginã if P^.Name <> Nilã then Write(P^.Name^,' ');ã Case P^.DType ofã 1 : if PString(P^.Data) <> Nil then Writeln(PString(P^.Data)^);ã 2 : writeln(LongPtr(P^.Data)^);ã end;ã end;ã Beginã P^.ForEach(@ShowName);ã End;ããVarã P : PCollection;ã Ps : PDosStream;ã m : Longint;ã S : String;ã I : LongInt;ãBeginã m := MaxAvail;ã RegisterType(RCollection);ã RegisterType(RStrDataRec);ã RegisterType(RNumDataRec);ã New(P,init(5,5));ã if P <> Nil thenã Beginã S := 'String data # 1';ã P^.insert(New(PStrData,init('A string data type ',S)));ã S := 'String data # 2';ã P^.insert(New(PStrData,init('A second string data type ',S)));ã I := 1234567;ã P^.Insert(New(PNumData,init('Numeric Data Type',I)));ã S := 'String Data #3';ã P^.Insert(New(PStrData,init('A third string data type ',S)));ã I := 987654;ã P^.Insert(New(PNumData,init('A second Numeric data type ',I)));ã New(Ps,init('Test1.dta',StCreate));ã if Ps <> Nil thenã beginã P^.Store(Ps^);ã dispose(P,Done);ã Dispose(Ps,Done);ã if maxavail = m then writeln('mem disposed')ã else writeln('Failed to release memory');ã new(Ps,init('test1.dta',stopenread));ã if Ps <> Nil thenã Beginã New(P,Load(Ps^));ã dispose(Ps,done);ã if P <> Nil then showstuff(P);ã if p <> Nil then dispose(P,done);ã end;ã end;ã end;ã if maxavail = m then writeln('mem disposed')ã else writeln('Failed to release memory');ãEnd.ãã...kenã---ã * Origin: Telos Point of Source. Replied From Saved Mail. (Max 1:249/201.21)ã 19 05-28-9313:53ALL SWAG SUPPORT TEAM TV-ANSI.PAS IMPORT 14 dÑ {ãhere's some code to insert your one personal desktop in TurboVision.ã}ã{$L SBLOGO}ãProcedure Logo; external;ã{ãThe only use of this Procedure is to link in the ansi drawing. It's a TPãCompatible Object File (you can make them With TheDraw). But every videoãdump will do. This drawing should have the dimension 22 * 80.ã}ãTypeã PAnsiBackGround = ^TAnsiBackGround;ã TAnsiBackGround = Object (TBackGround)ã BckGrnd : Pointer;ã { This is the Pointer to your video dump }ãã Constructor Init (Var Bounds : TRect; APattern : Char);ã Procedure Draw; Virtual;ã end;ããConstructor TAnsiBackGround.Init;ãbeginã TBackGround.Init (Bounds, APattern);ã BckGrnd := @Logo;ããend;ããProcedure TAnsiBackGround.Draw;ãbeginã TView.Draw;ã WriteBuf (0,0, 80, 23, BckGrnd^);ã { The TV buffer Type is nothing more then a dump of the video memory }ããend;ããTypeã PAnsiDesktop = ^TAnsiDesktop;ã TAnsiDesktop = Object (TDesktop)ã Procedure InitBackGround; Virtual;ã end;ããProcedure TAnsiDesktop.InitBackGround;ãVarã R: TRect;ã AB : PAnsiBackGround;ãbeginã GetExtent(R);ã New (AB, Init(R, #176));ã BackGround := AB;ããend;ãã{ Your applications InitDesktop method should look like this : }ããProcedure TGenericApp.InitDesktop ;ãVarã AB : PAnsiDesktop;ã R : TRect;ãbeginã GetExtent(R);ã Inc(R.A.Y);ã Dec(R.B.Y);ã New(AB, Init(R));ã Desktop := AB;ããend;ã{ãThe only problem With this approach is that it doesn't work in 43 line modeãsince your background covers only 22 lines. if anyone has some nice codeãto move this ansi-picture in an buffer which fills up 43 lines mode I Reallyãappreciate it !!ã} 20 05-28-9313:53ALL SWAG SUPPORT TEAM TV-HELP.PAS IMPORT 44 d%[ (*ãLast week I found a bug in HELPFile.PAS and called Borland. After describingãthe error, the Borland representative agreed that it was a bug and thatãit hasn't been reported. ThereFore, I will describe the bug here and giveãa fix to the problem.ããProblem:ãRecall, HELPFile.PAS is the Turbo Vision Unit that TVDEMO.PAS Uses toãprovide on-line help to Turbo Vision Programs. The problem that occurredãwas that if a help panel was brought up that did not contain a crossãreference entry (i.e. hyperText link), and the user pressed [Tab] orãShift+[Tab] then a run-time error is generated. notE: the run-timeãerror is generated if the Program is Compiled With Range Checking on.ãif Range checking is off, then unpredicatable results occur.ããto see the bug in action, do the following:ããFire up Turbo Pascal 6 and load the TVDEMO.PAS Program (by default it existsãin the TVDEMOS subdirectory). Make sure Range checking is turned on.ãThe option is in Options|Compiler. You will also want to turn debuggingãon in both the TVDEMO.PAS and HELPFile.PAS Files. to do this, you mustãedit the source code of both Files and change the {$D-} option to {$D+}ãat the beginning of both Files.ããOnce you have done the above, press Ctrl+F9 to run TVDEMO. When TVDEMOãcomes up, press F1 to bring up the help Window. Now, press Shift+[Tab]ãor [Tab] and a RunTime error 201 will occur.ããThis bug arises from the fact that the HELPFile.PAS Unit assumes thatãthere will always be at least one cross reference field on a help panel.ãObviously, this is an invalid assumption.ããLuckily, there is an easy solution to the problem. The following showsãhow to change the HELPFile.PAS Program so that this error doesn't occur.ãThe only Procedure that needs to be changed is THelpViewer.HandleEvent.ãã*)ããProcedure THelpViewer.HandleEvent(Var Event: TEvent);ãVarã KeyPoint, Mouse: TPoint;ã KeyLength: Byte;ã KeyRef: Integer;ã KeyCount: Integer;ã{ 1. Add the following Variable declaration }ã n : Integer;ããProcedure MakeSelectVisible;ãVarã D: TPoint;ãbeginã topic^.GetCrossRef(Selected, KeyPoint, KeyLength, KeyRef);ã D := Delta;ã if KeyPoint.X < D.X then D.X := KeyPoint.X;ã if KeyPoint.X > D.X + Size.X then D.X := KeyPoint.X - Size.X;ã if KeyPoint.Y < D.Y then D.Y := KeyPoint.Y;ã if KeyPoint.Y > D.Y + Size.Y then D.Y := KeyPoint.Y - Size.Y;ã if (D.X <> Delta.X) or (D.Y <> Delta.Y) then Scrollto(D.X, D.Y);ãend;ããProcedure Switchtotopic(KeyRef: Integer);ãbeginã if topic <> nil then Dispose(topic, Done);ã topic := HFile^.Gettopic(KeyRef);ã topic^.SetWidth(Size.X);ã Scrollto(0, 0);ã SetLimit(Limit.X, topic^.NumLines);ã Selected := 1;ã DrawView;ãend;ããbeginã TScroller.HandleEvent(Event);ã Case Event.What ofã evKeyDown:ã beginã Case Event.KeyCode ofã kbTab:ã beginã{ 2. Change This...ã Inc(Selected);ã if Selected > topic^.GetNumCrossRefs then Selected := 1;ã MakeSelectVisible;ãto this... }ã Inc(Selected);ã n := topic^.GetNumCrossRefs;ãã if n > 0 thenã beginã if Selected > n thenã Selected := 1;ã MakeSelectVisible;ã endã elseã selected := 0;ã{ end of Change 2 }ã end;ã kbShiftTab:ã beginã{ 3. Change this ...ã Dec(Selected);ã if Selected = 0 then Selected := topic^.GetNumCrossRefs;ã MakeSelectVisible;ãto this... }ã Dec(Selected);ã n := topic^.GetNumCrossRefs;ã if n > 0 thenã beginã if Selected = 0 thenã Selected := n;ã MakeSelectVisible;ã endã elseã Selected := 0;ã{ end of Change 3 }ã end;ã kbEnter:ã beginã{ 4. Change this...ã if Selected <= topic^.GetNumCrossRefs thenã beginã topic^.GetCrossRef(Selected, KeyPoint, KeyLength, KeyRef);ã Swithtotopic(KeyRef);ã end;ãto this...}ã n := topic^.GetNumCrossRefs;ã if n > 0 thenã beginã if Selected <= n thenã beginã topic^.GetCrossRef(Selected, KeyPoint, KeyLength, KeyRef);ã Switchtotopic(KeyRef);ã end;ã end;ã{ end of Change 4 }ã end;ã kbEsc:ã beginã Event.What := evCommand;ã Event.Command := cmClose;ã PutEvent(Event);ã end;ã elseã Exit;ã end;ã DrawView;ã ClearEvent(Event);ã end;ã evMouseDown:ã beginã MakeLocal(Event.Where, Mouse);ã Inc(Mouse.X, Delta.X); Inc(Mouse.Y, Delta.Y);ã KeyCount := 0;ã Repeatã Inc(KeyCount);ã if KeyCount > topic^.GetNumCrossRefs then Exit;ã topic^.GetCrossRef(KeyCount, KeyPoint, KeyLength, KeyRef);ã Until (KeyPoint.Y = Mouse.Y+1) and (Mouse.X >= KeyPoint.X) andã (Mouse.X < KeyPoint.X + KeyLength);ã Selected := KeyCount;ã DrawView;ã if Event.Double then Switchtotopic(KeyRef);ã ClearEvent(Event);ã end;ã evCommand:ã if (Event.Command = cmClose) and (Owner^.State and sfModal <> 0) thenã beginã endModal(cmClose);ã ClearEvent(Event);ã end;ã end;ãend;ã 21 05-28-9313:53ALL SWAG SUPPORT TEAM VIEWCOLR.PAS IMPORT 22 dê2 (*ã> Does somebody know how to get correct colors in a view.ã> That is: Exactly the colors I want to specify without mappingã> on the colors of the views owner?ããNow you're getting even more complicated than the actual method of doing it.ã(as if that wasn't complicated enough!)ããThe BP7 Turbo Vision Guide (and I'll assume the TP7 TVGuide as well) do a muchãbetter job at explaning the palette's that the TP6 version. The colors are notãas much maps, as they are indexes. Only the TProgram Object actual contains anyãcolor codes. TApplication, by design, inherits that palette as is. Any insertedãviews palette will contain a String of indexes into that palette.ããThere are a couple of ways to customize your colors. Either adjust where yourãcurrent views index points to, or adjust the actual applications palette.ãã> The manual says that such is done to get "decent colors". But theã> problem is that defining what should be "decent" is to the Programmer,ã> not to the designer of a compiler :-)ãã> How to get just Absolute colors in a view, thats the question.ããThe easiest method I've found For adjusting colors, is directly adjusting theãactual TApllications GetPalette Method.ãããFunction TMyApp.GetPalette:PPalette;ãConstã P: Array[apColor..apMonochrome] of String[Length(CColor)] =ã (CColor, CBlackWhite, CMonochrome);ãbeginã p[apcolor,1] := #$1A; {background}ã p[apcolor,2] := #$1F; {normal Text}ã p[apcolor,33] := #$74; {tdialog frame active}ã p[apcolor,51] := #$1B; {inputline selected}ã p[apcolor,56] := #$4F; {history Window scrollbar control}ã getpalette := @p[apppalette];ãend;ãããThis lets you change and adjust your entire pallete, and have those changesãreflected throughout your entire application... Just consult your TVGuide toãfind the offset into the String of the item you want to change.ããHeres a nifty Program to display all the colors available, and what they lookãlike (not only tested.. but used quite a bit!) :ã*)ããProgram Colourtest;ããUsesã Crt;ãTypeã str2 = String[2];ãVarã i, y, x,ã TA : Byte;ããFunction Hexit(w : Byte) : str2;ãConstã Letr : String[16] = '0123456789ABCDEF';ãbeginã Hexit := Letr[w shr 4 + 1] + Letr[w and $0F + 1];ãend;ããbeginã TA := TextAttr ;ã ClrScr;ã For y := 0 to 7 doã beginã GotoXY(1, y + 5);ã For i := 0 to 15 doã beginã TextAttr := y * 16 + i;ã Write('[', Hexit(TextAttr), ']');ã end;ã end;ã Writeln;ã Writeln;ã GotoXY(1, 15);ã Textattr := TA;ã Write(' For ');ã Textattr := TA or $80;ã Write(' Flashing ');ã Textattr := TA;ã Writeln('Attribute : Color = Color or $80');ã Writeln;ã Write(' Press any key to quit : ');ã ReadKey;ã ClrScr;ãend.ãã 22 05-28-9313:53ALL SWAG SUPPORT TEAM XCDIALOG.PAS IMPORT 16 dË {ãJohan: this code may help you out. Keep With it, the learning curveãon TV is very steep. Try the Fidonet TV Forum in Europe, or betterãyet, the Compuserve BPascalA Forum.ã}ã{xcdialog.int}ãã{$X+}ããUnit xcdialog;ããInterfaceããUsesã Objects,Drivers,Views,Menus,Dialogs,MsgBox,App,Crt,Printer,ã TVXCVars, FmtLine, XCMapL, TVCalcL, TVXCHelp, File_ioL, Dos;ããTypeã PAspDialog = ^TAspDialog;ã TAspDialog = Object(TDialog)ã end;ãã PExitDialog = ^TExitDialog;ã TExitDialog = Object(TDialog)ã end;ããProcedure ExitDialog; {asks user whether s/he want to quit or not}ããImplementationãããProcedure ExitDialog;ã{þþþþþþþþþþþþþþþþþþþþþþþþþþþþþþþþþþþþþþþþþþþþþ}ãVarã Dlg : PAspDialog ;ã R : TRect ;ã Control, Labl : PView ;ã Event : TEvent;ã iStart : Integer;ãbeginã R.Assign ( 10 , 2 , 60 , 12 ) ;ã New ( Dlg , Init ( R , 'Exit Confirmation') ) ;ãã iStart:= (50 - length('Are you SURE you want to Exit?')) div 2;ã {centre Text}ãã R.Assign ( iStart , 3 , 48 , 4 ) ;ã Control := New ( PStaticText , Init ( R , length('Are you SURE'ã +' you want to Exit?' ) ) ;ã Dlg^.Insert ( Control ) ;ãã R.Assign ( 10 , 7 , 21 , 9 ) ;ã Control:= New ( PButton , Init ( R , Words^.get(numYes) ,ã cmOK , bfDefault ) ) ;ã Control^.HelpCtx := hcEnter ;ã Dlg^.Insert ( Control ) ;ãã R.Assign ( 23 , 7 , 36 , 9 ) ;ã Control := New ( PButton,Init(R , 'Cancel', cmCancel , bfNormal ) ) ;ã Control^.HelpCtx := hcCancelBtn ;ã Dlg^.Insert ( Control ) ;ãã Dlg^.SelectNext ( False ) ;ãã if Desktop^.ExecView (Dlg) <> cmCancel thenã beginã Event.What := evCommand;ã Event.Command := cmQuit;ã Application^.PutEvent(Event);ã end;ã Dispose(Dlg, Done);ãend;ã 23 08-17-9308:47ALL SWAG SUPPORT TEAM Dynamic OPP Box Object IMPORT 33 d= program Dynamic_Object_Demo;ãã { DYN-DEMO.PAS }ããuses Crt, Dos;ããtypeã ScrPtr = ^SaveScreen;ã BoxPtr = ^ReportBox;ã SaveScreen = array[1..80,1..25] of word;ã ReportBox = objectã SavPtr: ScrPtr; FColor, BColor: byte;ã WPosX, WPosY, WSizeX, WSizeY: integer;ã constructor Init( PtX, PtY, Width, Height,ã C1, C2 : integer );ã destructor Done;ã procedure Draw;ã procedure Erase;ã end;ãã{==========================================}ã{ implementation for object type ReportBox }ã{==========================================}ããconstructor ReportBox.Init;ãvarã i, j: integer;ã Regs: Registers;ãbeginã WPosX := PtX;ã WPosY := PtY;ã WSizeX := Width;ã WSizeY := Height;ã FColor := C1;ã BColor := C2;ã New( SavPtr ); { allocate memory for array }ã window( WPosX, WPosY, WPosX+WSizeX-1,ã WPosY+WSizeY-1 );ãã {read character and attribute on video page 0}ãã for i := 1 to WSizeX doã for j := 1 to WSizeY doã beginã gotoxy(i,j);ã Regs.AH := 08;ã Regs.BH := 00;ã intr( $10, Regs );ã SavPtr^[i,j] := Regs.AX;ã end;ã Draw;ãend;ããdestructor ReportBox.Done;ãbeginã Erase;ã Dispose( SavPtr );ãend;ããprocedure ReportBox.Erase;ãvarã i, j : integer;ã Regs : Registers;ãbeginã window( WPosX, WPosY,ã WPosX+WSizeX-1, WPosY+WSizeY-1 );ã ClrScr; { inner window }ãã{ Write character and attr on video page 0 }ãã{ AL stores the character value }ã{ BL stores the attribute value }ã{ CL stores the repititions value (1) }ãã for i := 1 to WSizeX doã for j := 1 to WSizeY doã beginã gotoxy(i,j);ã Regs.AH := 09;ã Regs.BH := 00;ã Regs.AL := lo( SavPtr^[i,j] );ã Regs.BL := hi( SavPtr^[i,j] );ã Regs.CL := 1;ã intr( $10, Regs );ã end;ã window( 1, 1, 80, 25 );ãend;ããprocedure ReportBox.Draw;ãvarã BoxStr : string[6];ã i : integer;ã MemSize : longint;ãbeginã TextColor( FColor );ã TextBackground( BColor );ã BoxStr := #$C9 + #$CD + #$BB +ã #$BA +#$BC + #$C8;ã window( WPosX, WPosY,ã WPosX+WSizeX-1, WPosY+WSizeY-1 );ã ClrScr;ã gotoxy( 1, 1 ); write( BoxStr[1] );ã for i := 1 to WSizeX-2 do write( BoxStr[2] );ã write( BoxStr[3] );ã gotoxy( 1, WSizeY-1 ); write( BoxStr[6] );ã for i := 1 to WSizeX-2 do write( BoxStr[2] );ã write( BoxStr[5] );ã gotoxy( 1, 2 );ã InsLine;ã for i := 2 to WSizeY-1 doã beginã gotoxy( 1, i ); write( BoxStr[4] );ã gotoxy( WSizeX, i ); write( BoxStr[4] );ã end;ã window( WPosX+1, WPosY+1,ã WPosX+WSizeX-2, WPosY+WSizeY-2 );ã ClrScr;ã MemSize := MemAvail;ã for i := 1 to 30 doã write('Memory now = ',MemSize,' bytes! ');ã window( 1, 1, 80, 25 );ãend;ãã{ **** end of methods **** }ããvarã Box : array[1..5] of BoxPtr;ã MemSize : longint;ã i : integer;ããprocedure Prompt;ãbeginã gotoxy( 1, 1 ); clreol;ã write('Memory now = ', MemAvail,ã '. Press ENTER to continue ');ã readln;ãend;ããbeginã ClrScr;ã TextColor( White );ã TextBackground( Black );ã MemSize := MemAvail;ã for i := 1 to 100 doã write(' Initial memory available = ',ã MemSize, ' bytes! ' );ã gotoxy( 1, 1 ); clreol;ã write('Press ENTER to continue ');ã readln;ã Box[1] := New( BoxPtr, Init( 5, 12, 30, 10,ã LightRed, Black ) );ã gotoxy( 1, 1 ); clreol;ã write('Memory now = ', MemAvail,ã '. Press ENTER to continue ');ã readln;ã Box[2] := New( BoxPtr, Init( 40, 5, 30, 10,ã LightGreen, Blue ) );ã gotoxy( 1, 1 ); clreol;ã write('Memory now = ', MemAvail,ã '. Press ENTER to continue ');ã readln;ã Dispose( Box[1], Done );ã Dispose( Box[2], Done );ã gotoxy( 1, 1 ); clreol;ã write( 'Final memory (after release) = ',ã MemAvail, ' bytes...');ã readln;ãend.ã 24 08-27-9320:37ALL STUART MACLEAN Passing method as OBJect IMPORT 8 d>} {ãStuart MacleanããHi there, I've found a neat way of passing an Object a method of its ownãclass, which it then executes. The idea comes from Smalltalk'sãchange/update mechanism For dependencies under the MVC paradigm.ããWorks under TP6.ã}ããTypeã DependentPtr = ^Dependent;ãã Dependent = Objectã Procedure Update(p : Pointer);ã Procedure SomeMethod;ã end;ãã Model = Objectã dep : DependentPtr;ã Procedure Change;ã end;ããProcedure Dependent.Update; Assembler;ãAsmã les di, selfã push esã push diã call dWord ptr pãend;ããProcedure Dependent.SomeMethod;ãbeginã{ do something here }ãend;ããProcedure Model.Change;ãbeginã dep^.Update(@Dependent.Somemethod);ãend;ããVarã m : Model;ã d : Dependent;ããbeginã m.dep := @d; { add d as a dependent of m }ã m.Change; { caUses d to be updated }ãend.ã 25 08-27-9321:43ALL EDWIN GROOTHUIS Password for TVision IMPORT 13 dTâ {ãEDWIN GROOTHUISããsomebody asked For a inputline For passWords. I have such one, but I'veãforgotten WHICH discussionlist... so I'll mail it to the above lists, Iãknow it's one of it, and know it can be interesting For somebody else.ããWhat I have done is overriden the Draw-Procedure For the inputline to drawãonly ***'s instead of the right Characters. The solution I gave yesterdayãwas not quitte correct: I used the Procedure SetData to put the *'s into theãData^-field, but that Procedure calls the Draw-Procedure itself so you'llãget an infinite loop and a stack-overflow error. Now I put the *'s direct toãthe Data^-field, I don't think it can give problems.ã}ããUsesã app, dialogs, views, Objects;ããTypeã PPassWord = ^TPassWord;ã TPassWord = Object(TInputLine)ã Procedure Draw; Virtual;ã end;ãããProcedure TPassWord.Draw;ããVarã s, t : String;ã i : Byte;ãbeginã GetData(s);ã t := s;ã For i := 1 to length(t) doã t[i] := '*';ã Data^ := t;ã inherited Draw;ã Data^ := s;ãend;ããProcedure about;ãVarã d : pdialog;ã r : trect;ã b : pview;ãbeginã r.assign(1, 1, 60, 15);ã d := new(pdialog,init(r, 'About'));ã With d^ doã beginã flags := flags or wfgrow;ã r.assign(1,1,10,3);ã insert(new(PButton, init(r,'~O~K', cmok, bfdefault)));ã r.assign(2,4,8,5);ã insert(new(PPassWord, init(r,10)));ã end;ã desktop^.execview(d);ã dispose(d, done);ãend;ãããVarã a : TApplication;ãbeginã a.init;ã about;ã a.run;ã a.done;ãend.ã 26 11-02-9316:45ALL BRIAN RICHARDSON Efficient Turbo Vision IMPORT 22 dà {ãFrom: BRIAN RICHARDSONãSubj: Efficient Tv2ã---------------------------------------------------------------------------ã On 10-08-93 FRANK DERKS wrote to ALL...ãã Hello All,ãã for those who have read my other message (Efficient TV, Thu 07). Maybeã some of you can expand on the following idea. How do I create aã 'dynamic' pick list box: a box that is displayed only when I haveãã Or maybe more simple : what I'm after is a sort of inputline-objectã which can be cycled through a number of predefined values. }ããuses objects, app, dialogs, drivers;ããtypeã PRoomInputLine = ^TRoomInputLine;ã TRoomInputLine = object(TInputLine)ã StatusList : PStringCollection;ã Index : integer;ãã constructor Init(var Bounds: TRect; AMaxLen: integer;ã AStatusList : PStringCollection);ã procedure HandleEvent(var Event : TEvent); virtual;ã procedure Up; virtual;ã procedure Down; virtual;ã end;ãã PRoomDialog = ^TRoomDialog;ã TRoomDialog = object(TDialog)ã constructor Init(List : PStringCollection);ã end;ããconstructor TRoomInputLine.Init(var Bounds : TRect; AMaxLen: Integer;ã AStatusList : PStringCollection);ãbeginã inherited Init(Bounds, AMaxLen);ã StatusList := AStatusList;ã Index := 0;ã SetData(PString(StatusList^.At(Index))^);ãend;ããprocedure TRoomInputLine.Up;ãbeginã Index := (Index + 1) Mod StatusList^.Count;ã SetData(PString(StatusList^.At(Index))^);ãend;ãããprocedure TRoomInputLine.Down;ãbeginã if Index = 0 then Index := (StatusList^.Count - 1) elseã Dec(Index);ã SetData(PString(StatusList^.At(Index))^);ãend;ããprocedure TRoomInputLine.HandleEvent(var Event: TEvent);ãbeginã if (Event.What = evKeyDown) then beginã case Event.KeyCode ofã kbUp : Up;ã kbDown : Down;ã elseã inherited HandleEvent(Event);ã end; end elseã inherited HandleEvent(Event);ãend;ããconstructor TRoomDialog.Init(List : PStringCollection);ãvar R: TRect;ãbeginã R.Assign(20, 5, 60, 20);ã inherited Init(R, '');ã R.Assign(15, 7, 25, 8);ã Insert(New(PRoomInputLine, Init(R, 20, List)));ã R.Assign(15, 9, 25, 10);ã Insert(New(PRoomInputLine, Init(R, 20, List)));ããend;ããvarã RoomApp : TApplication;ã List : PStringCollection;ãbeginã RoomApp.Init;ã List := New(PStringCollection, Init(3, 1));ã with List^ do beginã Insert(NewStr('Vacant')); Insert(NewStr('Occupied'));ã Insert(NewStr('Cleaning'));ã end;ã Application^.ExecuteDialog(New(PRoomDialog, Init(List)), nil);ã Dispose(List, Done);ã RoomApp.Done;ãend.ãã 27 11-02-9318:37ALL TODD HOLMES Flexible OOP Array IMPORT 21 dÒ {ãFrom: TODD HOLMESãHeres a flexible OOP array...}ãã{ $TESTED}ããUses Objects;ãTypeãã TestRec = Recordã Name: String[20];ã Age : Word;ã end;ã {A TestRecord}ãã PAByte = ^TAByte;ã TAByte = Array[0..65519] of byte;ã {General byte array}ãã{TArray is limited to 65520 bytes of data, and may store any typeãof data.}ãã PArray = ^TArray;ã TArray = Object(TObject)ã Data : PAByte;ã DataSize: Word; {Size of the Data to hold}ã MaxCount: Word; {Maximum amount of items of DataSize}ã Count : Word; {How many items in Array}ã Constructor Init(ADataSize,ACount:Word);ã Constructor Load(Var S:TStream);ã Procedure Store(VAR S:TStream); Virtual;ã Destructor Done;Virtual;ã Procedure GetItem(Index:Word;Var Item);ã Procedure PutItem(Index:Word;Var Item);ã end;ããConstructor TArray.Init(ADataSize,ACount:Word);ã beginã Inherited Init; {TP6 Tobject.init}ã DataSize := ADataSize;ã MaxCount := 65520 div ADataSize; {For Error Checking}ã If Acount > MaxCount then Fail; {Array is too big}ã Count := ACount;ã GetMem(Data,Count * DataSize); {Get Mem for the array}ã FillChar(Data^,Count * DataSize,0);{Clear the Array}ã end;ããConstructor TArray.Load(Var S:TStream);ã beginã With S do beginã Read(DataSize,SizeOf(DataSize));ã Read(MaxCount,SizeOf(MaxCount));ã Read(Count,SizeOf(MaxCount));ã GetMem(Data,Count * DataSize);ã Read(Data^,Count * DataSize);ã end;ã end;ããProcedure TArray.Store(Var S:TStream);ã beginã With S do Beginã Write(DataSize,SizeOf(DataSize));ã Write(MaxCount,SizeOf(MaxCount));ã Write(Count,sizeOf(Count));ã Write(Data^,Count * DataSize);ã end;ã end;ããDestructor TArray.done;ã beginã FreeMem(Data,Count*DataSize);ã Inherited Done;ã end;ããProcedure TArray.GetItem(Index:Word;Var Item);ã beginã If Index > count then Exit;ã Move(Data^[(Index - 1) * DataSize],Item,DataSize);ã end;ããProcedure TArray.PutItem(Index:Word;Var Item);ã beginã If Index > count then exit;ã Move(Item,Data^[(Index - 1) * DataSize],DataSize);ã end;ããVarã Flexable:PArray;ã TR:TestRec;ã I:Integer;ããbeginã Randomize;ã Flexable := New(PArray,Init(SizeOf(TR),10));ã If Flexable <> Nil then begin; {Array to big}ã For I := 1 to Flexable^.Count do beginã With TR do beginã Name := 'Bobby Sue';ã Age := I;ã end;ã Flexable^.PutItem(I,TR);ã end;ã For I := 1 to FlexAble^.Count do beginã FlexAble^.GetItem(I,TR);ã With Tr doã Writeln('Rec ',I:2,' is Name: ',Name:20,' Age: ',Age:8);ã end;ã end;ã Dispose(Flexable,Done);ãend.ã 28 11-02-9318:39ALL BRIAN PAPE PICKLIST in Turbo Vision IMPORT 23 dÀ {ãFrom: BRIAN PAPEãSubj: Picklist in TVã}ãã{************************************************}ã{ }ã{ Turbo Vision 2.0 Demo }ã{ Copyright (c) 1992 by Borland International }ã{ }ã{************************************************}ããprogram PickList;ããuses Objects, Views, Dialogs, App, Drivers,editors;ãconstã cmPickClicked = 1001;ãtypeã PCityColl = ^TCityColl;ã TCityColl = object(TStringCollection)ã constructor Init;ã end;ãã PPickLine = ^TPickLine;ã TPickLine = object(TMemo)ã procedure HandleEvent(var Event: TEvent); virtual;ã end;ãã PPickWindow = ^TPickWindow;ã TPickWindow = object(TDialog)ã constructor Init;ã end;ãã TPickApp = object(TApplication)ã PickWindow: PPickWindow;ã constructor Init;ã end;ããVAR Lijst:PCityColl;ã GControl: PView;ã S : String[30];ãããconstructor TCityColl.Init;ãbeginã inherited Init(10, 10);ã Insert(NewStr('Scotts Valley'));ã Insert(NewStr('Sydney'));ã Insert(NewStr('Copenhagen'));ã Insert(NewStr('London'));ã Insert(NewStr('Paris'));ã Insert(NewStr('Munich'));ã Insert(NewStr('Milan'));ã Insert(NewStr('Tokyo'));ã Insert(NewStr('Stockholm'));ãend;ããprocedure TPickLine.HandleEvent(var Event: TEvent);ãVARã Count:Integer;ãbeginã inherited HandleEvent(Event);ã if (Event.What = evBroadcast) and (Event.command=cmListItemSelected) thenã beginã S:=PListBox(Event.InfoPtr)^.GetText(PListBox(Event.InfoPtr)^.Focused,ã high(s));ã with PListBox(Event.InfoPtr)^ doã beginã s := s + #13;ã InsertText(@s[1],length(s),false);ã end;ã DrawView;ã ClearEvent(Event);ã end;ãend;ããconstructor TPickWindow.Init;ãvarã R: TRect;ã Control: PView;ã ScrollBar: PScrollBar;ãbeginã R.Assign(0, 0, 40, 15);ã inherited Init(R, 'Pick List Window');ã Options := Options or ofCentered;ã R.Assign(5, 2, 35, 4);ã Control := New(Ppickline, Init(R,NIL,NIL,NIL, 130));ã Control^.EventMask := Control^.EventMask or evBroadcast;ã Insert(Control);ã R.Assign(4, 1, 13, 2);ã Insert(New(PLabel, Init(R, 'Picked:', Control)));ã R.Assign(34, 5, 35, 11);ã New(ScrollBar, Init(R));ã Insert(ScrollBar);ã R.Assign(5, 5, 34, 11);ã gControl := New(PListBox, Init(R, 1, ScrollBar));ã Insert(gControl);ã PListBox(gControl)^.NewList(Lijst);ã R.Assign(4, 4, 12, 5);ã Insert(New(PLabel, Init(R, 'Items:', Control)));ã R.Assign(15, 12, 25, 14);ã Insert(New(PButton, Init(R, '~Q~uit', cmQuit, bfDefault)));ãend;ããconstructor TPickApp.Init;ãbeginã inherited Init;ã Lijst:=New(PCityColl,Init);ã PickWindow := New(PPickWindow, Init);ã InsertWindow(PickWindow);ãend;ããvarã PickApp: TPickApp;ãbeginã PickApp.Init;ã PickApp.Run;ã PickApp.Done;ãend.ãã 29 01-27-9411:58ALL LARRY HADLEY Valid Directories IMPORT 13 d²À {ã For you TV programmers out there, here is a neat littleã TValidator object for you - it verifies that the DIRECTORYã entered in a TInputLine is valid and currently exists.ã}ããUnit DirValid;ããINTERFACEããUsesã Objects,ã Validate;ããTypeã PDirValidator = ^TDirValidator;ã TDirValidator = OBJECT(TValidator)ã constructor Init;ãã procedure Error; virtual;ã function IsValid(const S : string) : boolean; virtual;ã end;ããIMPLEMENTATIONããUsesã Dos,ã MsgBox;ããFunction ExistDir(d : string) : boolean;ãVARã S : SearchRec;ãBEGINã {$I-}ã FindFirst(d, Directory, S);ã {$I+}ã if DOSError = 0 thenã BEGINã if Directory = (S.attr and Directory) thenã ExistDir := TRUEã ELSEã ExistDir := FALSE;ã ENDã ELSEã ExistDir := FALSE;ã END;ããconstructor TDirValidator.Init;ãbeginã inherited Init;ãend;ããprocedure TDirValidator.Error;ãbeginã MessageBox('Directory does not exist!', nil, mfError + mfOKButton);ãend;ããfunction TDirValidator.IsValid(const S : string) : boolean;ãvarã d : string;ãbeginã if s='' then {always return TRUE when entry string is empty}ã beginã IsValid := TRUE;ã EXIT;ã end;ã d := s;ã if s[Length(d)] = '\' thenã Delete(d, Length(d), 1); {allows flexibility - TV & TP expectã paths to NOT terminate in a \ }ã if ExistDir(d) thenã IsValid := TRUE {directory exists}ã elseã IsValid := FALSE; {directory does not exist}ãend;ããend. 30 01-27-9412:16ALL DJ MURDOCH Object Checking IMPORT 10 d-3 {ã> But it's not bad if they DON'T have them, is it? Defining what is good orã> bad from reading the manual is the single most difficult problem I haveã> with them for anything (not just TP). I wouldn't supposeã> it would be if you can do it.ããI'm not sure what you mean by good or bad. If you want to use virtual methods,ãyou need a VMT. Not having one would be very bad. If you don't want to useãvirtual methods, then you probably don't need a VMT. The only reason you mightãwant one is for debugging: you can check whether an object has beenãinitialized by checking whether its VMT is valid. Here's the check I use:ã}ããFunction ObjCheck(o:PObject;msg:string):boolean;ãtypeã VMT = recordã size, negsize : integer;ã end; varã PVmt : ^VMT;ãbeginã PVmt := Ptr(DSeg, word(Pointer(o)^));ã with PVmt^ doã if (size = 0) or (size + negsize <> 0) thenã beginã write(msg,': Not initialized');ã ObjCheck := false;ã endã elseã ObjCheck := true; end;ãã{ This is pretty close to the same check that $R+ does. }ã 31 01-27-9412:19ALL DJ MURDOCH TVision Extension IMPORT 27 dì· {ã>try using resource files with TurboVision. When opening a resource file withã>extension EXE, TV will append it to the file during write operations.ã>I did it already for registration stuff and it works fine.ããThe trouble with this approach is that each write operation appends aãrecord, it doesn change the existing one. For something you do only onceãlike registration, that's okay, but for config changes, you need to doãsomething to pack the records. With Resource files that's complicated, butãpossible. Here's the unit I use to do it.ã}ããunit resources;ãã{ Unit to provide extra functions to TVision TResourceFiles }ããinterfaceããusesã objects;ããtypeã PPackableResource = ^TPackableResource;ã TPackableResource = object(TResourceFile)ã function pack : boolean;ã { Packs the resource file by reading all resources and rewriting them toã the stream. Returns false if it fails. }ã end;ããimplementationããtypeã { Type here to get at the secret fields of the TResourceFile }ã TResourceSecrets = object(TObject)ã Stream : PStream;ã Modified : Boolean;ã BasePos : Longint;ã IndexPos : Longint;ã Index : TResourceCollection;ã end;ãã PNamedItem = ^TNamedItem;ã TNamedItem = object(TObject)ã Item : PObject;ã Name : PString;ã destructor done; virtual;ã end;ããdestructor TNamedItem.done;ãbeginã DisposeStr(Name);ã inherited done;ãend;ããprocedure Deletechars(var S : TStream; count : Longint);ã{ Deletes the given number of characters from the stream }ãvarã copy : longint;ã buffer : array [1..1024] of byte;ã bufsize : word;ã pos : longint;ãbeginã pos := S.GetPos;ã copy := S.GetSize - pos - count;ã bufsize := sizeof(buffer);ãã while copy > 0 doã beginã if copy < sizeof(buffer) thenã bufsize := copy;ã S.Seek(pos + count);ã S.Read(Buffer, bufsize);ã S.Seek(pos);ã S.write(Buffer, bufsize);ã inc(pos, bufsize);ã dec(copy, bufsize);ã end;ã S.Truncate;ãend;ããfunction TPackableResource.Pack : boolean;ãvarã contents : TCollection;ã i : integer;ã item : PObject;ã nameditem : PNamedItem;ã OldSize : longint;ãbeginã Flush;ã pack := false; { Assume failure }ã if Stream^.status <> stOk thenã exit;ãã { First, make a copy of all the contents in memory }ãã contents.init(Count, 10);ã for i := 0 to pred(Count) doã beginã item := Get(KeyAt(i));ã New(NamedItem, init);ã if (NamedItem = nil) or (item = nil) thenã beginã contents.done;ã exit;ã end;ã NamedItem^.item := item;ã NamedItem^.name := Newstr(Keyat(i));ã contents.atinsert(i, nameditem);ã end;ãã { Now, remove all traces of the original. }ãã with TResourceSecrets(Self) doã beginã Stream^.Seek(BasePos + 4);ã Stream^.Read(OldSize, Sizeof(OldSize));ã Stream^.Seek(BasePos);ã DeleteChars(Stream^, OldSize + 8);ã end;ãã { Now, close down and restart }ã TResourceSecrets(Self).Index.Done;ã Stream^.Seek(0);ã inherited init(Stream);ãã { Now rewrite all those saved objects. }ã for i := 0 to pred(contents.count) doã beginã nameditem := PNamedItem(contents.At(i));ã Put(nameditem^.item, nameditem^.name^);ã end;ãã { Get rid of the copies from memory }ã contents.done;ãã if Stream^.Status = stOk thenã pack := true;ãend;ããend.ãã 32 01-27-9412:22ALL LARRY HADLEY OOP Stack Object IMPORT 42 dÛ {ã> If you want, I can post a few good and simple examples of OOPã> concepts to get you started.ãã{ã -- A simple stack object with the nice flexibility that only OOPã can provide.ãã Data structuresãã StackItem: node for a doubly linked list containing an untyped pointerã to hold data. It is the responsibility of descendant typesã to type this pointer. (override push and pop)ãã StackTop :pointer to available stack itemã StackBottom :pointer to the bottom (end/root) of the stackã StackHt :number of items on stackã StackST :status variableãã Methodsãã Init - initializes the stack object, StackHt = 0, all pointers = nilã *** YOU MUST CALL THIS BEFORE ACCESSING STACK ***ãã done - destructor deallocates the stack by doing successive pops untilã the stack is empty.ã *** YOU MUST OVERRIDE THIS METHOD WHEN YOU OVERRIDE ***ã *** PUSH AND POP. ITEMS POPPED ARE NOT DEALLOCATED ***ãã Push - Pushes an item onto the stack by:ã 1) Allocating a new StackItem (if StackHt>0)ã 2) Assigning pointer dta to data fieldã 3) Incrementing StackHtãã Pop - Pops by reversing push method:ã 1) Recovering dta pointer from data fieldã 2) Deallocating "top" StackItem (if StackHt>1)ã 3) Decrementing StackHtãã Most decendant types will override push and pop to type the data field, andã call STACK.push or STACK.pop to do the "basic" operations.ãã IsError - shows if an error condition existsãã MemoryOK - internally used function to check available heap.ã}ããUnit OSTACK;ããINTERFACEããCONSTã MAX_STACK = 100;ã MIN_MEMORY = 4096;ãã StatusOK = 0;ã StatusOFlow = 1;ã StatusEmpty = 2;ã StatHeapErr = 3;ããTYPEã ItemPtr = ^StackItem;ã StackItem = RECORDã data :pointer;ã prev, next :ItemPtr;ã END; { StackItem }ãã STACK = OBJECTã StackTop, StackBottom :ItemPtr;ã StackST :integer;ã StackHt :byte;ãã constructor init;ã destructor done; virtual;ã procedure push(var d); virtual;ã procedure pop(var d); virtual;ã function IsError:boolean;ã privateã function MemoryOK:boolean;ã END; { STACK }ããIMPLEMENTATIONããconstructor STACK.init;ã BEGINã New(StackBottom);ã StackTop := StackBottom;ã StackBottom^.prev := NIL;ã StackBottom^.next := NIL;ã StackBottom^.data := NIL;ã StackHt := 0; StackST := StatusOK;ã END;ããdestructor STACK.done;ã VAR val :pointer;ã BEGINã if StackHt>0 thenã repeatã pop(val);ã until val = nil;ã Dispose(StackBottom);ã END;ããprocedure STACK.push(var d);ã VAR TemPtr :ItemPtr;ã dta :pointer ABSOLUTE d;ã BEGINã if not MemoryOK then EXIT;ãã if (StackHt>=MAX_STACK) thenã beginã StackST := StatusOFlow;ã EXIT;ã end;ãã If StackHt>0 thenã BEGINã New(StackTop^.next);ã TemPtr := StackTop;ã StackTop := TemPtr^.next;ã StackTop^.prev := TemPtr;ã StackTop^.next := NIL;ã END;ãã StackTop^.data := dta;ã Inc(StackHt);ã END;ããprocedure STACK.pop(var d);ã VAR dta :pointer ABSOLUTE d;ã BEGINã if StackHt>1 thenã BEGINã dta := StackTop^.data;ã StackTop := StackTop^.prev;ã Dispose(StackTop^.next);ã StackTop^.next := NIL;ã Dec(StackHt);ã if StackST = StatusOFlow then StackST := StatusOK;ã ENDã ELSEã BEGINã if StackHt = 1 thenã BEGINã dta := StackBottom^.data;ã StackBottom^.data := nil;ã Dec(StackHt);ã ENDã ELSEã beginã dta := StackBottom^.data;ã StackST := StatusEmpty;ã end;ã END;ã END;ããfunction STACK.IsError:boolean;ãbeginã if StackST = StatusOK thenã IsError := FALSEã elseã IsError := TRUE;ãend;ããfunction STACK.MemoryOK:boolean;ãbeginã if MaxAvail0 thenã repeatã pop(tmp);ã until tmp = NOREG;ãend;ããprocedure RegisterStack.push(var d);ãvarã tmp :pOpRec;ã dta :OpRec ABSOLUTE d;ãbeginã New(tmp);ã tmp^ := dta;ã inherited push(tmp);ãend;ããprocedure RegisterStack.pop(var d);ãvarã tmp :pOpRec;ã dta :OpRec ABSOLUTE d;ãbeginã inherited pop(tmp);ã if StackST = StatusEmpty thenã beginã dta := NOREG;ã EXIT;ã endã elseã if tmp<>nil thenã beginã dta := tmp^;ã Dispose(tmp);ã endã elseã dta := NOREG;ãend;ãã 33 01-27-9412:23ALL MARTIN WERNER TVision Backgrounds IMPORT 6 d8" {ã> I'm starting to play with TVision 1 and I would like to know howã> to change the background fill character.ããWorking example:ã}ããprogram otherbackground;ããusesã app, objects;ããtypeã pmyapp=^tmyapp;ã tmyapp=object(tapplication)ã constructor init;ã end;ããconstructor tmyapp. init;ãã varã r: trect;ãã beginã tapplication. init;ã desktop^. getextent(r);ã dispose(desktop^. background, done);ã desktop^. background:=new(pbackground, init(r, #1));ã desktop^. insert(desktop^. background);ã end;ããvarã myapp: tmyapp;ããbeginã myapp. init;ã myapp. run;ã myapp. done;ãend.ã 34 01-27-9412:23ALL KEN BURROWS Dialogs in TVision IMPORT 36 dÉâ {ã>>> In a Turbo Vision DIALOG form, how do you (re)select the FIRST editableã>>> data field FROM ANYWHERES IN the DIALOG?ãã>> You don't select it. You let IT select itself. Since all the viewsã>> inserted into the dialog are descendents of TView, then they allã>> have a select method.ãã> Nice Idea, too bad it's not that simple 8-(ããIt rarely is with TV.ã}ãProgram SelectAView_2; {tested. The only thing this does, is work}ãã { If you want to have an object select itself, without haveingã to explicitly define itself first, you must begin with anã object that KNOWS how to select itself.ã Since Select is a method of the TView object, any descendentã will know how.ãã A method is then needed by the object,ã that contains the object that must select itself,ã to get its, request that it select itselfã to the object that must select itself.ãã Use the evBroadcast event.ãã The object, that contain the object that must select itself,ã generates a broadcast event onto it's event tree. (random shotã in the dark) This broadcast, requests that any object thatã is set to select itself on the events command, should accept theã broadcast.... , and then select itself.ãã This is accomplished by taking your last instance definitionã of a object that you are inserting into your event queue andã descending it once more to overide its HandleEvent method.ãã In my example, I've used a simple TDialog and inserted aã bunch of of TInputLine's and a TButton that generates anã EvCommand of 'SelectFirst', and descended the HandleEventã to generate a evBroadCast event, to broadcast the SelectFirstã Command.ãã The TinputLine descendent, TMyLine, is directly descendedã from the type of object that I am linking into this TDialogã objects event queue.ãã Within a 'For i = 1 to 4' Loop, the TDialogs constructorã will insert a TMyLine type, that will select itself wheneverã an evBroadCast event, broadcasts a SelectFirst command.ãã As long as this object is a descendent of a TView, theã TDialog will accept it, and treat like any other object.ãã A TButton is installed to provide a method of generatingã an evBroadCast event that broadcasts a SelectFirst command.ã }ãããuses Objects,App,Dialogs,Views,Drivers;ããtypeã MyDlg = object(TDialog)ã constructor init;ã procedure HandleEvent(var Event:TEvent); virtual;ã end;ãã MyLine = Object(TInputLine)ã Selector : Word;ã Constructor Init(var bounds:Trect;AMaxLen:Integer;ã SelectKey:Word);ã Procedure HandleEvent(Var Event:TEvent); virtual;ã end;ã PMyLine = ^MyLine;ããconstã SelectFirst = 1000;ããConstructor MyLine.Init(var bounds:Trect;AMaxLen:Integer;ã SelectKey:Word);ã Beginã Inherited Init(Bounds,AMaxLen);ã EventMask := EventMask or evBroadcast;ã Selector := SelectKey;ã End;ããProcedure MyLine.HandleEvent(Var Event:TEvent);ã Beginã inherited HandleEvent(Event);ã if (Event.What = EvBroadcast) andã (Event.Command = Selector)ã then Select;ã End;ããConstructor MyDlg.Init;ã var r:trect;ã i:integer;ã Beginã r.assign(0,0,50,13);ã inherited init(r,'test dialog');ã options := options or ofcentered;ã getextent(r);ã r.grow(-3,-2);ã r.b.y := r.a.y + 1;ã for i := 1 to 4 doã beginã if i = 2ã then insert(new(PMyLine,init(r,size.x,SelectFirst)))ã else insert(New(PInputLine,init(r,size.x)));ã inc(r.a.y,2); inc(r.b.y,2);ã end;ã inc(r.b.y);ã inc(r.a.x,(size.x div 2) - 14);ã dec(r.b.x,(size.x div 2) - 13);ã insert(new(Pbutton,init(r,'~S~elect FirstLine',ã SelectFirst,bfdefault)));ã SelectNext(False);ã end;ããProcedure MyDlg.HandleEvent(Var Event:TEvent);ã Beginã inherited HandleEvent(Event);ã if (Event.What = EvCommand) andã (Event.Command = SelectFirst)ã then Message(owner,evBroadcast,Event.Command,nil);ã end;ããvarã a : TApplication;ã m : longint;ãtypeã PMyDlg = ^MyDlg;ããbeginã m := memavail;ã with a doã beginã Init;ã ExecuteDialog(new(PMyDlg,init),nil);ã done;ã end;ã if memavail <> m then writeln('memory allocation/deallocation error');ãend.ã 35 02-15-9408:09ALL DONN AULT Extended TV GADGETS IMPORT 22 d= {********************************************************************}ã{ }ã{ Author: Donn Ault }ã{ Date: 12/18/91 }ã{ Purpose: Extend clock view to show am/pm }ã{ Extend heap view to include commas (more readable) }ã{ Copyright: Donated to the public domain }ã{ }ã{ Notes: }ã{ + In your main program you will need more space for the expanded }ã{ views. The old clock uses 9 characters while the new }ã{ clock uses 12. The old heap viewer uses 9 while the new one }ã{ uses 13. Change the R.B.X occordingly. }ã{ }ã{********************************************************************}ããunit xgadgets;ãã{$F+,O+,S-,D-}ããinterfaceããuses Dos, Objects, Views, App, gadgets;ããtypeã PXHeapView = ^TXHeapView;ã TXHeapView = object (THeapView)ã Procedure Draw; Virtual;ã Function Comma ( N : LongInt ) : String;ã End;ãã PXClockView = ^TXClockView;ã TXClockView = Object (TClockView)ã am : Char;ã Function FormatTimeStr (h,m,s : word) : String; Virtual;ã Procedure Draw; Virtual;ã End;ããimplementationããuses Drivers;ããFunction TXHeapView.Comma ( n : LongInt) : String;ãVar num, loc : Byte;ã s : String;ã t : String;ãBeginã Str (n,s);ã Str (n:Size.X,t);ãã num := length(s) div 3;ã if (length(s) mod 3) = 0 then dec (num);ãã delete (t,1,num);ã loc := length(t)-2;ãã while num > 0 doã Beginã Insert (',',t,loc);ã dec (num);ã dec (loc,3);ã End;ãã Comma := t;ãEnd;ããprocedure TXHeapView.Draw;ãvarã S: String;ã B: TDrawBuffer;ã C: Byte;ããbeginã OldMem := MemAvail;ãã S := Comma (OldMem);ã C := GetColor(2);ã MoveChar(B, ' ', C, Size.X);ã MoveStr(B, S, C);ã WriteLine(0, 0, Size.X, 1, B);ãend;ããprocedure TXClockView.Draw;ãvarã B: TDrawBuffer;ã C: Byte;ãbeginã C := GetColor(2);ã MoveChar(B, ' ', C, Size.X);ã MoveStr(B, TimeStr + ' '+am+'m', C); { Modified line }ã WriteLine(0, 0, Size.X, 1, B);ãend;ããFunction TXClockView.FormatTimeStr (h,m,s: Word) : String;ãBeginã if h = 0 thenã Beginã h := 12;ã am := 'a';ã Endã Else if h > 12 thenã Beginã dec (h,12);ã am := 'p';ã Endã Else am := 'a';ã FormatTimeStr := TClockView.FormatTimeStr (h,m,s);ãEnd;ããEnd.ãã 36 02-15-9408:40ALL M. FIEL ScreenSaver Object IMPORT 31 d UNIT ScrSaver;ãã{ã ScreenSaver Object based on the ScreenSaver byã Stefan Boether in the TurboVision Forum of CompuServeãã (C) M.Fiel 1993 Vienna - Austriaã CompuServe ID : 100041,2007ãã Initialize it with a string (wich is printed on the screen) and the timeã in seconds when it should start.ãã To see how it works start the menupoint 'ScreenSave' in theã demo.exeãã to see how to initialisze the saver watch the demo source.ãã to increase or decrease the speed of the printed string use theã '+' and '-' key (the gray ones);ãã Use freely if you find it useful.ãã}ãããINTERFACEããUSES Dos, Objects, Drivers, Views, App ;ããTYPEãã PScreenSaver = ^TScreenSaver;ã TScreenSaver = object( TView )ãã Activ : Boolean;ã Seconds : Integer;ãã constructor Init(FName:String;StartSeconds:Integer);ã procedure GetEvent(var Event : TEvent); virtual;ã function itsTimeToAct : Boolean;ãã PRIVATEãã LastPos : Integer;ã Factory : PString;ã DelayTime : Integer;ã IdleTime : LongInt;ãã procedure Action; virtual;ã procedure SetIdleTime; virtual;ãã END;ããIMPLEMENTATIONãã USESã Crt;ãã constructor TScreenSaver.Init(FName:String;StartSeconds:Integer);ã varã R : TRect;ã beginãã R.Assign(ScreenWidth-1,0,ScreenWidth,1);ã inherited Init(R);ãã LastPos:=(ScreenWidth DIV 2);ã Factory:=NewStr(FName);ã DelayTime:=100;ã Seconds :=StartSeconds;ã SetIdleTime;ãã end;ãã procedure TScreenSaver.GetEvent(var Event:TEvent);ã beginãã if (Event.What=evNothing) then beginãã if not Activ then beginãã if itsTimeToAct then beginã Activ := True;ã DoneVideo;ã end;ãã end else Action;ãã end else if Activ then beginãã if ((Event.What=evKeyDown) and ((Event.KeyCode=kbGrayPlus) orã (Event.KeyCode=kbGrayMinus)) ) then beginã case Event.KeyCode ofã kbGrayPlus:if DelayTime>0 then dec(DelayTime);ã kbGrayMinus:if DelayTime<4000 then inc(DelayTime);ã end;ãã ClearEvent(Event);ãã end else beginã Activ := False;ã InitVideo;ã Application^.ReDraw;ã SetIdleTime;ã end;ã end elseã SetIdleTime;ã end;ãã procedure TScreenSaver.SetIdleTime;ã varã h,m,s,mm: word;ã beginã GetTime(h,m,s,mm);ã IdleTime:=(h*3600)+(m*60)+s;ã end;ãã function TScreenSaver.itsTimeToAct : Boolean;ã varã h,m,s,mm: word;ã beginã GetTime(h,m,s,mm);ã itsTimeToAct:=( ((h*3600)+(m*60)+s) > (IdleTime+Seconds) )ã end;ãã procedure TScreenSaver.Action;ã varã Reg:Registers;ã PrStr : String;ã beginã Dec(LastPos);ãã if LastPos>0 then beginãã if LastPos<=ScreenWidth then beginã if LastPos=ScreenWidth then LastPos:=ScreenWidth-length(Factory^);ã Reg.DL:=LastPos;ã PrStr:=Factory^+' ';ã end else beginã PrStr:=(Copy(Factory^,1,ScreenWidth+length(Factory^)-LastPos));ã Reg.DL:=ScreenWidth-length(PrStr);ã end;ãã end else beginãã if length(Factory^)+LastPos=0 then beginã PrStr:=' ';ã Reg.DL:=0;ã LastPos:=ScreenWidth+length(Factory^);ã end else beginã Reg.DL := $00;ã PrStr:=Copy(Factory^,Abs(LastPos)+1,80)+' ';ã end;ãã end;ãã with Reg do beginã AH := $02;ã BH := $00;ã DH := (ScreenHeight DIV 2) + (ScreenHeight DIV 4);ã end;ã Intr($10,Reg); (* Set Cursor Position *)ãã PrintStr(PrStr);ãã with Reg do beginã AH:=$02;ã BH:=$00;ã DH:=(ScreenHeight+1);ã DL:=$00;ã end;ã Intr($10,Reg); (* Set Cursor Position outside -> Cursor not visible *)ãã Delay(DelayTime);ãã end;ããEND. 37 02-15-9408:41ALL M. FIEL Recursive Expression ParsIMPORT 119 d UNIT PARSER;ãã{ recursive descent expression Parser.ãã Based on the parser by Herbert Shildt as shown inã Advanced Cã Osborn McGraw-Hillãã Ported to Pascal byãã (C) M.Fiel 1993 Vienna - Austriaã CompuServe ID : 100041,2007ãã for further infos refer to this book.ãã Use freely if you find it useful.ãã}ã{$R+}ããINTERFACEãã USESã Objects,ParTools;ãã CONSTã MaxParserVars = 100; { Max Count of Variables fo PVarParser }ãã TYPEãã{ PMathParser evaluates expressions like (-(10*5)/27) * 128 no variables }ãã PMathParser = ^TMathParser;ã TMathParser = object(TObject)ãã ToParse : PString; { the string to parse }ã ExprPos : Integer; { aktuall position in the string }ã TokenType : Integer; { Variable delimiter...}ã Token : String; { the aktuell token }ãã Result : Real; { the result of the expression }ãã constructor Init;ã destructor Done; virtual;ãã function Evaluate(Expression:String) : Real;ã { expression is the string which is to be evaluatedã calls function Parse}ãã function GetNextToken : Boolean; virtual;ã function GetPart : String; virtual;ã function isDelimiter : Boolean; virtual;ãã function AddSub : Boolean; virtual;ã { checks for Addition or Substr and calls MulDiv }ã function MulDiv : Boolean; virtual;ã { checks for Multiplikation or Div. and calls Unary }ã function Unary : Boolean; virtual;ã { checks for Unary (+/-) and calls Parant }ã function Parant : Boolean; virtual;ã { checks for paratheses and if necessary calls Parse --> go recursive }ãã function Primitive : Boolean; virtual;ã { evaluates constatn value }ãã function Parse : Boolean; virtual;ã { parse not necessary in this version (call addsub instead) but isã needed in descents }ãã end;ãã{ VarParser can Handle Variables and epressions likeã A=10.78ã B=20.45ã A*(B-10)+5ã .ã .ã .ã}ã PVarParser = ^TVarParser;ã TVarParser = object(TMathParser)ãã Vars : PParserVarColl;{Container of Variables defined in Unit ParTools}ãã constructor Init;ã destructor Done; virtual;ãã function Primitive : Boolean; virtual;ã function Parse : Boolean; virtual;ã { Calls Checckassign }ãã function CheckAssign : Boolean; virtual;ã { checks assignments : ex. A=12 }ã procedure ClearVars; virtual;ã { clears all variables }ãã end;ããIMPLEMENTATIONãã CONST { defines wich type a token is }ã tError = 0;ã tVariable = 1;ã tDelimiter = 2;ã tNumber = 3;ã tConstValue = 4;ãã constructor TMathParser.Init;ã beginã if not inherited Init then FAIL;ã ExprPos:=0;ã Token:='';ã end;ãã destructor TMathParser.Done;ã beginã if (ToParse<>NIL) then DisposeStr(ToParse);ã inherited Done;ã end;ãã function TMathParser.Evaluate(Expression:String) : Real;ãã beginãã if (ToParse<>NIL) then DisposeStr(ToParse);ã ToParse:=NewStr(Expression);ãã result:=0.00;ã ExprPos:=1;ãã if GetNextToken then Parse;ãã Evaluate:=result;ãã end;ãã function TMathParser.Parse : Boolean;ã beginã Parse:=AddSub;ã end;ãã function TMathParser.GetNextToken : Boolean;ã beginãã GetNextToken:=True;ãã while ToParse^[ExprPos] = ' ' do inc(ExprPos);ãã if (isDelimiter) then beginãã TokenType := tDelimiter;ã Token:=ToParse^[ExprPos];ã inc(ExprPos);ãã end else beginãã case ToParse^[ExprPos] ofãã '0'..'9':beginã TokenType := tNumber;ã Token :=GetPart;ã end;ãã 'A'..'Z','a'..'z' : beginã TokenType := tVariable;ã Token:=GetPart;ã end;ãã else beginã TokenType := tError;ã GetNextToken:=False;ã end;ãã end;ãã end;ãã end;ãã function TMathParser.GetPart : String;ã varã RetVal : String;ã beginãã RetVal:='';ãã while not(isDelimiter) do beginãã RetVal:=RetVal+ToParse^[ExprPos];ãã if ExprPos0);ã end;ãã function TMathParser.AddSub : Boolean;ã varã Hold : Real;ã OldToken : String;ã beginãã AddSub:=True;ãã if (MulDiv) then beginãã while (Pos(Token,'+-') > 0) do beginãã OldToken:=Token;ã GetNextToken;ãã Hold:=Result;ãã if (MulDiv) then beginã if OldToken='+' then Result:=(Hold+Result) else Result:=(Hold-Result);ã end elseã AddSub:=False;ãã end;ãã end elseã AddSub:=False;ãã end;ãã function TMathParser.MulDiv : Boolean;ã varã Hold : Real;ã PerHelp : Real;ã OldToken : String;ã beginãã MulDiv:=True;ãã if (Unary) then beginãã while (Pos(Token,'*/%') > 0) do beginãã OldToken:=Token;ã GetNextToken;ã Hold:=Result;ãã if (Unary) then beginãã case OldToken[1] ofã '*':Result:=Hold*Result;ãã '/':beginã if (Result<> 0) thenã Result:=Hold/Resultã else beginã OwnError('Division by zero');ã MulDiv:=False;ã end;ã end;ãã '%':beginã PerHelp:=Hold/Result;ã Result:=Hold-(PerHelp*Result);ã end;ãã end;ãã end elseã MulDiv:=False;ãã end;ãã end elseã MulDiv:=False;ãã end;ãã function TMathParser.Unary : Boolean;ã varã UnaryHelp:Boolean;ã OldToken : String;ã beginãã Unary:=True;ãã UnaryHelp:=False;ãã if (Pos(Token,'-+') >0) then beginã OldToken:=Token;ã UnaryHelp:=True;ã GetNextToken;ã end;ãã if (Parant) then beginã if (UnaryHelp and (OldToken = '-')) then Result:=-(Result);ã end elseã Unary:=False;ãã end;ãã function TMathParser.Parant : Boolean;ã beginãã Parant:=True;ãã if ((TokenType = tDelimiter) and (Token = '(')) then beginãã GetNextToken;ãã if (Parse) then beginãã if (Token <> ')') then beginã OwnError('unbalanced parantheses');ã Parant:=False;ã end;ãã end elseã Parant:=False;ãã GetNextToken;ãã end elseãã Parant:=Primitive;ãã end;ãã function TMathParser.Primitive : Boolean;ã varã e:Integer;ã beginãã Primitive:=True;ãã if (TokenType = tNumber) then beginãã val(Token,Result,e);ãã if (e<>0) then beginã OwnError('syntax error');ã Primitive:=False;ã end;ãã GetNextToken;ãã end;ãã end;ããã{****************************************************************************}ã{ TVARPARSER }ã{****************************************************************************}ãã constructor TVarParser.Init;ã beginã if not inherited Init then FAIL;ã Vars:=New(PParserVarColl,Init(MaxParserVars,0));ã end;ãã destructor TVarParser.Done;ã beginã Dispose(Vars,Done);ã inherited Done;ã end;ãã function TVarParser.Primitive : Boolean;ã beginãã Primitive:=True;ãã if (inherited Primitive) then beginãã if (TokenType = tVariable) then beginã result:=Vars^.GetVar(Token);ã GetNextToken;ã end;ãã end elseã Primitive:=False;ãã end;ãã function TVarParser.Parse : Boolean;ã beginã Parse:=CheckAssign;ã end;ãã function TVarParser.CheckAssign : Boolean;ã varã OldToken : String;ã OldType : Integer;ã beginãã if (TokenType = tVariable) then beginãã OldToken :=Token;ã OldType := TokenType;ãã GetNextToken;ãã if (Token = '=') then beginãã GetNextToken;ãã CheckAssign:=AddSub;ã Vars^.SetValue(OLdToken,result);ãã Exit;ãã end else beginãã dec(ExprPos,length(Token));ã Token:=OldToken;ã TokenType:=OldType;ãã end;ãã end;ãã CheckAssign := AddSub;ãã end;ãã procedure TVarParser.ClearVars;ã beginã Vars^.FreeAll;ã end;ããEND.ãã{ -------------------------------- CUT HERE -----------------------}ããUNIT PARTOOLS;ãã{ã (C) M.Fiel 1993 Vienna - Austriaã CompuServe ID : 100041,2007ãã Use freely if you find it useful.ã}ããINTERFACEãã USESã Objects;ãã TYPEãã {Object to hold variable data for the TVarParser defined in Unit Parser}ãã PParserVar = ^TParserVar;ã TParserVar = object(TObject)ãã Name : PString;ã Value : Real;ãã constructor Init(aName:String;aValue:Real);ã destructor Done; virtual;ãã function GetName : String; virtual;ã function GetValue : Real; virtual;ã procedure SetValue(NewValue : Real); virtual;ãã end;ãã {Container to hold TParserVar objects }ãã PParserVarColl = ^TParserVarColl;ã TParserVarColl = object(TCollection)ãã procedure FreeItem(Item:Pointer); virtual;ã function GetVarIndex(Name:String) : Integer; virtual;ã function GetVar(Name:String) : Real; virtual;ã procedure SetValue(Name:String;NewValue:Real); virtual;ãã end;ãã PStrColl = ^TStrColl; { Container for Strings }ã TStrColl = object(TCollection)ã procedure FreeItem(Item: Pointer); virtual;ã end;ãã procedure OwnError(S:String); { Shows a MsgBox with S }ã function Trim(Line:String) : String; { Pads a String from End }ã function MkStr(Len,Val:Byte): String;ã { makes a String of length len and fills it with val }ããIMPLEMENTATIONãã USESã MsgBox;ãã constructor TParserVar.Init(aName:String;aValue:Real);ã beginã inherited Init;ã Name:=NewStr(aName);ã Value:=aValue;ã end;ãã destructor TParserVar.Done;ã beginã DisposeStr(Name);ã inherited Done;ã end;ãã function TParserVar.GetName : String;ã beginã if Name<>NIL then GetName:=Name^ else GetName:='';ã end;ãã function TParserVar.GetValue : Real;ã beginã GetValue:=Value;ã end;ãã procedure TParserVar.SetValue(NewValue : Real);ã beginã Value:=NewValue;ã end;ãã procedure TParserVarColl.FreeItem(Item:Pointer);ã beginã if (Item <> NIL) then Dispose(PParserVar(Item),Done);ã end;ããã function TParserVarColl.GetVar(Name:String) : Real;ã varã Index:Integer;ã beginã Index:=GetVarIndex(Name);ãã if (Index<>-1) thenã GetVar:=PParserVar(At(Index))^.GetValueã else beginã OwnError('invalid variable');ã GetVar:=0;ã end;ãã end;ãã function TParserVarColl.GetVarIndex(Name:String) : Integer;ãã function isName(P:PParserVar):Boolean;ã beginã isName:=(P^.GetName = Name);ã end;ãã beginã GetVarIndex:=IndexOf(FirstThat(@isName));ã end;ãã procedure TParserVarColl.SetValue(Name:String;NewValue:Real);ã varã Index : Integer;ãã beginãã Index:=GetVarIndex(Name);ãã if (Index <> -1) thenã PParserVar(At(Index))^.SetValue(NewValue)ã elseã Insert(New(PParserVar,Init(Name,NewValue)));ãã end;ãã procedure OwnError(S:String);ã beginã MessageBox(S,nil,mfError + mfOkButton);ã end;ãã function Trim(Line:String) : String;ã varã Len: BYTE ABSOLUTE Line;ã beginã while (Len > 0) AND (Line[Len] = ' ') DO Dec(Len);ã Trim := Line;ã end ;ãã function MkStr (Len,Val:Byte): String;ã varã S:String;ã beginã S[0]:=chr(Len);ã fillchar (S[1],Len,Val);ã MkStr:=s;ã end;ãã procedure TStrColl.FreeItem(Item: Pointer);ã beginã if Item<>Nil then DisposeStr(Item);ã end;ããEND.ãã{ -------------------------------- DEMO PROGRAM -----------------------}ããPROGRAM PARDEMO;ãã{ã (C) M.Fiel 1993 Vienna - Austriaã CompuServe ID : 100041,2007ãã Use freely if you find it useful.ãã Demonstration of a Recursive descent Parser and a new Screensaverã object.ãã Infos watch the units and the parser.txt fileãã if problems or comments leave me a message or mail me.ãã}ããããUSESã Objects,Drivers,Menus,Views,App,Dialogs,ScrSaver,TVParser;ãã { NOTE - SCRSAVER UNIT CAN BE FOUND IN SWAG DISTRIBUTION ALSO !!}ã { AND WILL BE NEED BY THIS MODULE }ããCONSTã cmParser = 1001;ã cmScreenSave = 1002;ããTYPEãã PApp = ^Tapp;ã TApp = object(TApplication)ãã ScreenSaver : PScreenSaver; { defined in unit ScrSav }ã {add the screensaver object to the application}ãã constructor Init;ãã procedure HandleEvent (var event:Tevent); virtual;ã procedure InitMenuBar; virtual;ã procedure InitStatusLine; virtual;ã procedure ShowParser;ã procedure GetEvent(var Event: TEvent); virtual;ãã end;ãã VARã XApplic: TApp;ãã constructor TApp.Init;ã beginã if not inherited Init then FAIL;ãã ScreenSaver:=New(PScreenSaver,Init('I''m the Screensaver',180));ã Insert(ScreenSaver);ãã end;ãã procedure TApp.GetEvent(var Event: TEvent);ã beginã inherited GetEvent(Event);ã ScreenSaver^.GetEvent(Event); { don't forget this line }ã end;ãã procedure Tapp.InitStatusLine;ãã varã R: TRect;ã beginãã GetExtent(r);ã R.A.Y := R.B.Y - 1;ãã StatusLine:=New(PStatusLine, Init(R,ãã NewStatusDef (0, 1000,ã newstatuskey ('~F10~-Menu',kbF10,cmmenu,ã newstatuskey ('~Alt-X~ Exit', kbaltx, cmQuit,ã NIL)),ãã NIL)));ãã end;ãã procedure Tapp.InitMenuBar;ãã varã R : TRect;ã beginãã GetExtent(R);ã R.B.Y := R.A.Y + 1;ãã MenuBar:=New(PMenuBar,Init(R,NewMenu(ãã NewSubMenu('~ð~ ',hcNoContext,NewMenu(ã NewItem('~Alt-X~ Exit','',kbAltX,cmQuit,hcNoContext,ã NIL)),ãã NewItem('~P~arser','',0,cmParser,hcNoContext,ã NewItem('~S~creensave','',0,cmScreenSave,hcNoContext,ãã Nil))))));ã end;ãã procedure TApp.ShowParser;ã varã Parser:PVisionParser;ã beginã Parser:=New(PVisionParser,Init);ã if Parser<>NIL then beginã DeskTop^.ExecView(Parser);ã Dispose(Parser,Done);ã end;ã end;ããã procedure Tapp.HandleEvent (var Event:TEvent);ã beginãã case Event.What ofãã evCommand : beginãã case (Event.Command) ofãã cmParser : ShowParser;ã cmScreenSave : beginã DoneVideo;ã ScreenSaver^.Activ:=True;ã end;ã else inherited HandleEvent (Event);ãã end;ãã end;ãã else inherited HandleEvent (Event);ãã end;ãã end;ãããbeginãã XApplic.Init;ã XApplic.Run;ã XApplic.Done;ããend.ã
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/