SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00033 OOP/TVVISION ROUTINES 1 05-28-9313:53ALL SWAG SUPPORT TEAM CENTRDLG.PAS IMPORT 7 {π > 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 {π> 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 {π▒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 {π> 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 {π>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π<g>... 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 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 SWAG SUPPORT TEAM OBJ-DESC.PAS IMPORT 34 {π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 {π 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 {π> 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 <Alt> 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 <Alt> next time released }ππProcedure tmyapp.Idle;πVar Event: TEvent;πbeginπ inherited Idle;π if AltDown then { <Alt> key is down }π AltPressed := True { remember this }π else begin { <Alt> 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, <Alt> is up again }π IgnoreAlt := False { so we don't need to ignore it }π end; { the next time <Alt> is released }πend;ππVar myapp: tmyapp; { create an Object of class 'tmyapp' }ππbeginπ myapp.init; { you know these three lines, don't you? <g> }π 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 <Alt>. The only thing not implemented isπ'closing' the menu bar by a second <Alt> stroke.π} 10 05-28-9313:53ALL SWAG SUPPORT TEAM OOP-STRG.PAS IMPORT 44 {π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 <g> 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 {π 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 SWAG SUPPORT TEAM OOPCOPY.PAS IMPORT 86 {************************************************}π{ }π{ 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 könnte 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 könnte 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 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 {π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 SWAG SUPPORT TEAM OOPOBJS.PAS IMPORT 46 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 {π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 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 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 {π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 (*π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 (*π> 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 {π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 11-02-9318:39ALL BRIAN PAPE PICKLIST in Turbo Vision SWAG9311 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.ππ 24 11-02-9316:45ALL BRIAN RICHARDSON Efficient Turbo Vision SWAG9311 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.ππ 25 11-02-9318:37ALL TODD HOLMES Flexible OOP Array SWAG9311 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.π 26 05-25-9408:00ALL BRIAN RICHARDSON Printing A tcollection SWAG9405 31 d πunit BPrint;πinterfaceπuses Objects, Prt; { Prt is included after! }πprocedure PrintCollection(const Port : word; P : PStringCollection); πimplementation πuses MsgBox, Views; πfunction WriteStr(Port : word; Str : String): boolean; πvar x : boolean; π q : word;π i : byte; πbegin π repeat π x := Ready(Port); π if not x then q := MessageBox(^C'Printer not Ready. Try Again?', nil, π mfYesButton + mfNoButton + mfError); π until x or (q = cmNo); π i := 1; π while (Ready(Port)) and (q <> cmNo) and (i <> Length(Str)+1) do begin π x := Ready(Port); π if not x then q := MessageBox(^C'Printer Error! Try Again?', nil, π mfYesButton + mfNoButton + mfError);π if q <> cmNo then π if WriteChar(Port, Str[i]) then Inc(i);π end; π WriteStr := False; π if Ready(Port) and (q <> cmNo) then begin π WriteChar(Port, #13); π WriteChar(Port, #10); π WriteStr := True; π end; πend; π πprocedure PrintCollection(const Port : word; P : PStringCollection);πvar x : integer; π q : word; πbegin π q := MessageBox(^C'To print, ready your printer and Press OK', nil, π mfInformation + mfOkCancel); π if q = cmOk then begin π x := -1; π repeat π inc(x); π until not WriteStr(Port, PString(P^.At(x))^) or (X = P^.Count - 1);π end;ππend;πend.ππ{ ---- CUT HERE -------- }ππunit Prt;πinterface πuses objects; πconst π Lpt1 = 0; Lpt2 = 1; π Lpt3 = 2; lf = #10; π cr = #13; pTimeOut = $01; π pIOError = $08; pNoPaper = $20; π pNotBusy = $80;π pTestAll = pTimeOut + pIOError + pNoPaper; πfunction WriteChar(const APort : word; s : char): boolean; πfunction Ready(const APort : word): boolean; πfunction Status(const APort : word): byte; πprocedure InitPrinter(const APort : word); πimplementation πprocedure InitPrinter(const APort : word); assembler; πasm π mov ah, 1 π mov bx, APortπ int 17h πend;πfunction Status(const APort : word): byte; assembler; πasm π mov ah, 2 { Service 2 - Printer Status } π mov dx, APort { Printer Port } π int 17h { ROM Printer Services } π mov al, ah { Set function value } πend; πfunction Ready(const APort : word): boolean; πbegin π Ready := Status(APort) and pTestAll = $00; πend; πfunction WriteChar(const APort : word; s : char): boolean;πbegin π if Ready(APort) then π asm π mov ah, 0 { Printer Service - Write Char } π mov al, s { Char to write } π mov dx, APort { Printer Port }π int 17h { ROM Printer Services } π mov al, 0 { Set procedure to false } π and ah, 1 { Check for Error } π jnz @End { Jump to end if error } π mov al, 1 { Set procedure to true } π @End:π end; πend;ππend.ππ{ ---------------- CUT HERE --------------------- }π{π Here's a sample test program so you don't have to write one yourselfπ :).π}ππuses BPrint, Prt;π πfunction Int2Str(const i : longint): string; πvar s : string; πbegin π Str(i, s); π Int2Str := s; πend; π πvar x : integer; π q : PStringCollection; πbegin π q := New(PStringCollection, Init(10, 10)); π for x := 0 to 64 do q^.Insert(NewStr(Int2Str(Random(4000)))); π PrintCollection(Lpt1 {Change for your printer}, q); πend. π 27 05-26-9410:58ALL SWAG SUPPORT TEAM INI files in TV/OWL SWAG9405 184 d {$A+,F+,I-,R-,S-,V-}ππunit IniTV; {unit for managing INI files using TurboVision/OWL}ππ{*********************************************}π{* INITV.PAS 1.04 *}π{* Copyright (c) Steve Sneed 1993 *}π{*********************************************}ππ{*πNOTE: This code was quickly adapted from some using Object Professional'sπDoubleList object.π*}ππ{$IFNDEF Ver70}π !! STOP COMPILE: This unit requires BP7 !!π{$ENDIF}ππ{if Object Professional is available, use its string routines}π{.$DEFINE UseOPro}ππinterfaceππusesπ{$IFDEF UseOPro}π OpString,π{$ENDIF}π Objects;ππconstπ EncryptionKey : String[80] = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';π FBufSize = 4096;ππtypeπ PLine = ^TLine;π TLine =π object(TObject)π PL : PString;ππ constructor Init(S : String);π destructor Done; virtual;π procedure Update(S : String);π end;πππ PIni = ^TIni;π TIni =π object(TCollection)π IniName : String;π FBufr : PChar;ππ constructor Init(ALimit, ADelta : Integer;π FN : String;π Sparse, Create : Boolean);π {-Construct our INI file object. if Sparse=True, load only "active"π lines (file is considered read-only.) File always updates onπ changes; use SetFlushMode to control.}π destructor Done; virtual;π {-Destroy object when done}π procedure Reload;π {-Reload the INI file after it may have changed externally}π procedure FlushFile;π {-Force an update of the physical file from the current list}π procedure SetFlushMode(Always : Boolean);π {-Turn off/on auto-updating of file when an item is modified}π procedure SetExitFlushMode(DoIt : Boolean);π {-Turn off/on updating of file when the object is disposed}π function GetProfileString(Title, Group, Default : String) : String;π {-Return string item "Title" in "[Group]", or default if not found}π function GetEncryptedProfileString(Title, Group, Default : String) : String;π {-Same as GetProfileString but decrypts the found string}π function GetProfileBool(Title, Group : String; Default : Boolean) : Boolean;π {-Return boolean item "Title" in "[Group]", or default if not found}π function GetProfileByte(Title, Group : String; Default : Byte) : Byte;π {-Return byte item "Title" in "[Group]", or default if notπ found or Not A Number}π function GetProfileInt(Title, Group : String; Default : Integer) : Integer;π {-Return integer item "Title" in "[Group]", or default if notπ found or NAN}π function GetProfileWord(Title, Group : String; Default : Word) : Word;π {-Return word item "Title" in "[Group]", or default if notπ found or NAN}π function GetProfileLong(Title, Group : String; Default : LongInt) : LongInt;π {-Return longint item "Title" in "[Group]", or default if notπ found or NAN}π function SetProfileString(Title, Group, NewVal : String) : Boolean;π {-Change existing item "Title" in "[Group]" to "NewVal"}π function SetEncryptedProfileString(Title, Group, NewVal : String) : Boolean;π {-Change existing item "Title" in "[Group]" to "NewVal"}π function AddProfileString(Title, Group, NewVal : String) : Boolean;π {-Add new item "Title=NewVal" to "[Group]". Creates [Group] if notπ found or if "Title" = '', else adds "Title=NewVal" as last item inπ [Group]}π function AddEncryptedProfileString(Title, Group, NewVal : String) : Boolean;π {-Same as AddProfileString but encrypts "NewVal" when adding}π function KillProfileItem(Title, Group : String) : Boolean;π {-Completely remove the "Title" entry in "[Group]"}π function KillProfileGroup(Group : String) : Boolean;π {-Kill the entire group "[Group]", including group header}π function EnumGroups(P : PStringCollection; Clr : Boolean) : Boolean;π {-Return P loaded with the names of all groups in the file. Returnsπ false only on error. On return P is in file order rather thanπ sorted order.}π function EnumGroupItems(P : PStringCollection; Group : String; Clr : Boolean) : Boolean;π {-Return P loaded with all items in group [Group]. Returns falseπ if Group not found or error. On return P is in file order ratherπ than sorted order}ππ private {these used internally only}π IniF : Text;π NeedUpd : Boolean;π AlwaysUpd : Boolean;π IsSparse : Boolean;π ExitFlush : Boolean;ππ function GetIniNode(Title, Group : String) : PLine;π function GetLastNodeInGroup(Group : String) : PLine;π function GetProfilePrim(Title, Group : String) : String;π end;ππprocedure SetEncryptionKey(NewKey : String);π {-define the encryption key}ππimplementationππ function NewStr(const S: String): PString;π {-NOTE: The default NewStr returns a nil pointer for empty strings. Thisπ will cause problems, so we define a NewStr that always allocates a ptr.}π varπ P: PString;π beginπ GetMem(P, Length(S) + 1);π P^ := S;π NewStr := P;π end;ππ procedure CleanHexStr(var S : string);π {-handle ASM- and C-style hex notations}π varπ SLen : Byte absolute S;π beginπ while S[SLen] = ' ' doπ Dec(SLen);π if (SLen > 1) and (Upcase(S[SLen]) = 'H') then beginπ Move(S[1], S[2], SLen-1);π S[1] := '$';π endπ else if (SLen > 2) and (S[1] = '0') and (Upcase(S[2]) = 'X') then beginπ Dec(SLen);π Move(S[3], S[2], SLen-1);π S[1] := '$';π end;π end;ππ{$IFNDEF UseOPro}π{-If we're not using OPro, define the string manipulation routines we need.}ππconstπ Digits : Array[0..$F] of Char = '0123456789ABCDEF';ππ function HexB(B : Byte) : string;π {-Return hex string for byte}π beginπ HexB[0] := #2;π HexB[1] := Digits[B shr 4];π HexB[2] := Digits[B and $F];π end;ππ function Trim(S : string) : string;π {-Return a string with leading and trailing white space removed}π varπ I : Word;π SLen : Byte absolute S;π beginπ while (SLen > 0) and (S[SLen] <= ' ') doπ Dec(SLen);ππ I := 1;π while (I <= SLen) and (S[I] <= ' ') doπ Inc(I);π Dec(I);π if I > 0 thenπ Delete(S, 1, I);ππ Trim := S;π end;ππ function StUpcase(S : String) : String;π {-Convert a string to all uppercase. Ignores internationalization issues}π varπ I : Byte;π beginπ for I := 1 to Length(S) doπ S[i] := Upcase(S[i]);π StUpcase := S;π end;π{$ENDIF}ππ function StripBrackets(S : String) : String;π varπ B : Byte absolute S;π beginπ S := Trim(S);π if S[b] = ']' thenπ Dec(B);π if S[1] = '[' then beginπ Move(S[2], S[1], B-1);π Dec(B);π end;π StripBrackets := StUpcase(S);π end;ππ procedure SetEncryptionKey(NewKey : String);π {-Define the encryption key to use}π beginπ EncryptionKey := NewKey;π end;ππ function Crypt(S : String) : String;π {-simple self-reversing xor encryption}π varπ SI, KI : Byte;π T : String;π beginπ T := '';π KI := 1;π for SI := 1 to Length(S) do beginπ T := T + Chr(Byte(S[SI]) xor Byte(EncryptionKey[KI]));π Inc(KI);π if KI > Length(EncryptionKey) thenπ KI := 1;π end;π Crypt := T;π end;ππ function Encrypt(S : String) : String;π {-Convert S to XOR-encrypted string, then "hex-ize"}π varπ T, U : String;π I : Integer;π beginπ U := '';π T := Crypt(S);π for I := 1 to Length(T) doπ U := U + HexB(Byte(T[i]));π Encrypt := U;π end;ππ function Decrypt(S : String) : String;π {-Convert "hex-ized" string to encrypted raw string, and decrypt}π varπ T,U : String;π I,C : Integer;π beginπ T := '';π while S <> '' do beginπ U := '$'+Copy(S, 1, 2);π Delete(S, 1, 2);π Val(U, I, C);π T := T + Char(I);π end;π Decrypt := Crypt(T);π end;ππ{---------------------------------------------------------------------------}ππ constructor TLine.Init(S : String);π beginπ inherited Init;π PL := NewStr(S);π end;ππ destructor TLine.Done;π beginπ DisposeStr(PL);π inherited Done;π end;ππ procedure TLine.Update(S : String);π beginπ DisposeStr(PL);π PL := NewStr(S);π end;ππ{---------------------------------------------------------------------------}ππ constructor TIni.Init(ALimit, ADelta : Integer;π FN : String;π Sparse, Create : Boolean);π varπ P : PLine;π S : String;π beginπ inherited Init(ALimit, ADelta);π GetMem(FBufr, FBufSize);ππ IsSparse := Sparse;π NeedUpd := False;π AlwaysUpd := False;π ExitFlush := False;ππ {load INI file}π IniName := FN;π Assign(IniF, IniName);π SetTextBuf(IniF, FBufr[0], FBufSize);π Reset(IniF);π if IOResult <> 0 then beginπ {file doesn't yet exist; drop out}π if not Create then beginπ Done;π Fail;π endπ else beginπ NeedUpd := True;π Exit;π end;π end;ππ while not EOF(IniF) do beginπ ReadLn(IniF, S);π if IOResult <> 0 then beginπ {read error here means something is wrong; bomb it}π Close(IniF); if IOresult = 0 then ;π Done;π Fail;π end;ππ {add the string to the collection}π S := Trim(S);π if (not(Sparse)) or ((S <> '') and (S[1] <> ';')) then beginπ New(P, Init(S));π if P = nil then beginπ {out of memory, bomb it}π Close(IniF);π if IOResult = 0 then ;π Done;π Fail;π end;π Insert(P);π end;π end;π Close(IniF);π if IOResult = 0 then ;ππ AlwaysUpd := True;π ExitFlush := True;π end;ππ destructor TIni.Done;π beginπ if (NeedUpd) and (ExitFlush) thenπ FlushFile;π FreeMem(FBufr, FBufSize);π inherited Done;π end;ππ procedure TIni.Reload;π varπ P : PLine;π S : String;π beginπ FreeAll;π Assign(IniF, IniName);π SetTextBuf(IniF, FBufr[0], FBufSize);π Reset(IniF);π if IOResult <> 0 thenπ Exit;ππ while not EOF(IniF) do beginπ ReadLn(IniF, S);π if IOResult <> 0 then beginπ {read error here means something is wrong; bomb it}π Close(IniF); if IOresult = 0 then ;π Exit;π end;ππ S := Trim(S);π if (not(IsSparse)) or ((S <> '') and (S[1] <> ';')) then beginπ New(P, Init(S));π if P = nil then beginπ {out of memory, bomb it}π Close(IniF); if IOResult = 0 then ;π Exit;π end;π Insert(P);π end;π end;π Close(IniF);π if IOResult = 0 then ;π end;ππ procedure TIni.SetFlushMode(Always : Boolean);π beginπ AlwaysUpd := Always;π end;ππ procedure TIni.SetExitFlushMode(DoIt : Boolean);π beginπ ExitFlush := DoIt;π end;ππ procedure TIni.FlushFile;π {-Force the INI file to be rewritten}π varπ S : String;π P : PLine;π I : Integer;π beginπ if IsSparse thenπ Exit;ππ Assign(IniF, IniName);π SetTextBuf(IniF, FBufr[0], FBufSize);π Rewrite(IniF);π if IOResult <> 0 thenπ Exit;ππ I := 0;π while I < Count do beginπ P := PLine(At(I));π WriteLn(IniF, P^.PL^);π if IOResult <> 0 then beginπ Close(IniF);π if IOResult = 0 then ;π exit;π end;π Inc(I);π end;ππ Close(IniF);π if IOResult = 0 then ;π NeedUpd := False;π end;ππ function TIni.GetIniNode(Title, Group : String) : PLine;π {-Return the Title node in Group, or nil if not found}π varπ P : PLine;π S : String;π I : Integer;π GroupSeen : Boolean;π beginπ GetIniNode := nil;π if Count = 0 then exit;ππ {fixup strings as needed}π if Group[1] <> '[' thenπ Group := '['+Group+']';π Group := StUpcase(Group);π Title := StUpcase(Title);ππ {search}π GroupSeen := False;π I := 0;π while I < Count do beginπ P := PLine(At(I));π if P^.PL^[1] = '[' then beginπ {a group header...}π if StUpcase(P^.PL^) = Group thenπ {in our group}π GroupSeen := Trueπ else if GroupSeen thenπ {exhausted all options in our group; get out}π exit;π endπ else if (GroupSeen) and (P^.PL^[1] <> ';') then beginπ {in our group, see if the title matches}π S := Copy(P^.PL^, 1, Pos('=', P^.PL^)-1);π S := Trim(S);π S := StUpcase(S);π if Title = S then beginπ GetIniNode := P;π exit;π end;π end;π Inc(I);π end;π end;ππ function TIni.GetLastNodeInGroup(Group : String) : PLine;π {-Return the last node in Group, or nil if not found}π varπ P,Q : PLine;π S : String;π I : Integer;π GroupSeen : Boolean;π beginπ GetLastNodeInGroup := nil;π if Count = 0 then exit;ππ {fixup strings as needed}π if Group[1] <> '[' thenπ Group := '['+Group+']';π Group := StUpcase(Group);ππ {search}π GroupSeen := False;π Q := nil;π I := 0;π while I < Count do beginπ P := PLine(At(I));π if P^.PL^[1] = '[' then beginπ {a group header...}π if StUpcase(P^.PL^) = Group thenπ {in our group}π GroupSeen := Trueπ else if (GroupSeen) then beginπ {exhausted all lines in our group, return the last pointer}π if Q = nil thenπ Q := PLine(At(I-1));π I := IndexOf(Q);π while (I >= 0) and (PLine(At(I))^.PL^ = '') doπ Dec(I);π if I < 0 thenπ GetLastNodeInGroup := nilπ elseπ GetLastNodeInGroup := PLine(At(I));π exit;π end;π end;π Q := P;π Inc(I);π end;π if GroupSeen thenπ GetLastNodeInGroup := Qπ elseπ GetLastNodeInGroup := nil;π end;ππ function TIni.GetProfilePrim(Title, Group : String) : String;π {-Primitive to return the string at Title in Group}π varπ P : PLine;π S : String;π B : Byte absolute S;π beginπ P := GetIniNode(Title, Group);π if P = nil thenπ GetProfilePrim := ''π else beginπ S := P^.PL^;π S := Copy(S, Pos('=', S)+1, 255);π S := Trim(S);π if (S[1] = '"') and (S[b] = '"') then beginπ Move(S[2], S[1], B-1);π Dec(B, 2);π end;π GetProfilePrim := S;π end;π end;ππ function TIni.KillProfileItem(Title, Group : String) : Boolean;π {-Removes Title item in Group from the list}π varπ P : PLine;π beginπ KillProfileItem := False;π if IsSparse then Exit;ππ P := GetIniNode(Title, Group);π if P <> nil then beginπ Free(P);π KillProfileItem := True;π if AlwaysUpd thenπ FlushFileπ elseπ NeedUpd := True;π end;π end;ππ function TIni.KillProfileGroup(Group : String) : Boolean;π {-Removes all items in Group from the list}π varπ P : PLine;π I : Integer;π S : String;π beginπ KillProfileGroup := False;π if IsSparse then Exit;ππ {fixup string as needed}π if Group[1] <> '[' thenπ Group := '['+Group+']';π Group := StUpcase(Group);ππ {search}π I := 0;π while I < Count do beginπ P := PLine(At(I));π if (P^.PL^[1] = '[') and (StUpcase(P^.PL^) = Group) then beginπ Inc(I);π while (I < Count) and (PLine(At(I))^.PL^[1] <> '[') doπ Free(At(I));π Free(P);π KillProfileGroup := True;π if AlwaysUpd thenπ FlushFileπ elseπ NeedUpd := True;π Exit;π end;π Inc(I);π end;π end;ππ function TIni.GetProfileString(Title, Group, Default : String) : String;π {-Returns Title item in Group, or Default if not found}π varπ S : String;π beginπ S := GetProfilePrim(Title, Group);π if S = '' thenπ S := Default;π GetProfileString := S;π end;ππ function TIni.GetEncryptedProfileString(Title, Group, Default : String) : String;π {-Returns decrypted Title item in Group, or Default if not found}π varπ S : String;π beginπ S := GetProfilePrim(Title, Group);π if S = '' thenπ S := Defaultπ elseπ S := DeCrypt(S);π GetEncryptedProfileString := S;π end;ππ function TIni.GetProfileBool(Title, Group : String; Default : Boolean) : Boolean;π varπ S : String;π beginπ S := Trim(GetProfilePrim(Title, Group));π if S <> '' then beginπ S := StUpcase(S);π if (S = 'TRUE') or (S = '1') or (S = 'Y') or (S = 'YES') or (S = 'ON') thenπ GetProfileBool := Trueπ else if (S = 'FALSE') or (S = '0') or (S = 'N') or (S = 'NO') or (S = 'OFF') thenπ GetProfileBool := Falseπ elseπ GetProfileBool := Default;π endπ elseπ GetProfileBool := Default;π end;ππ function TIni.GetProfileByte(Title, Group : String; Default : Byte) : Byte;π varπ S : String;π C : Integer;π B : Byte;π beginπ S := Trim(GetProfilePrim(Title, Group));π if S <> '' then beginπ CleanHexStr(S);π Val(S, B, C);π if C = 0 thenπ GetProfileByte := Bπ elseπ GetProfileByte := Default;π endπ elseπ GetProfileByte := Default;π end;ππ function TIni.GetProfileInt(Title, Group : String; Default : Integer) : Integer;π varπ S : String;π I,C : Integer;π beginπ S := Trim(GetProfilePrim(Title, Group));π if S <> '' then beginπ CleanHexStr(S);π Val(S, I, C);π if C = 0 thenπ GetProfileInt := Iπ elseπ GetProfileInt := Default;π endπ elseπ GetProfileInt := Default;π end;ππ function TIni.GetProfileWord(Title, Group : String; Default : Word) : Word;π varπ S : String;π W : Word;π C : Integer;π beginπ S := Trim(GetProfilePrim(Title, Group));π if S <> '' then beginπ CleanHexStr(S);π Val(S, W, C);π if C = 0 thenπ GetProfileWord := Wπ elseπ GetProfileWord := Default;π endπ elseπ GetProfileWord := Default;π end;ππ function TIni.GetProfileLong(Title, Group : String; Default : LongInt) : LongInt;π varπ S : String;π I : LongInt;π C : Integer;π beginπ S := Trim(GetProfilePrim(Title, Group));π if S <> '' then beginπ CleanHexStr(S);π Val(S, I, C);π if C = 0 thenπ GetProfileLong := Iπ elseπ GetProfileLong := Default;π endπ elseπ GetProfileLong := Default;π end;ππ function TIni.SetProfileString(Title, Group, NewVal : String) : Boolean;π varπ S : String;π P : PLine;π beginπ SetProfileString := False;π if IsSparse then exit;ππ P := GetIniNode(Title, Group);π if P = nil thenπ SetProfileString := AddProfileString(Title, Group, NewVal)π else beginπ S := P^.PL^;π System.Delete(S, Pos('=', S)+1, 255);π S := S + NewVal;π P^.Update(S);π SetProfileString := True;π if AlwaysUpd thenπ FlushFileπ elseπ NeedUpd := True;π end;π end;ππ function TIni.SetEncryptedProfileString(Title, Group, NewVal : String) : Boolean;π varπ S : String;π P : PLine;π beginπ SetEncryptedProfileString := False;π if IsSparse then exit;ππ P := GetIniNode(Title, Group);π if P = nil thenπ SetEncryptedProfileString := AddEncryptedProfileString(Title, Group, NewVal)π else beginπ S := P^.PL^;π System.Delete(S, Pos('=', S)+1, 255);π S := S + EnCrypt(NewVal);π P^.Update(S);π SetEncryptedProfileString := True;π if AlwaysUpd thenπ FlushFileπ elseπ NeedUpd := True;π end;π end;ππ function TIni.AddProfileString(Title, Group, NewVal : String) : Boolean;π {-add new node and/or group to the list}π varπ P : PLine;π I : Integer;π beginπ AddProfileString := False;π if IsSparse then exit;ππ {fixup strings as needed}π if Group[1] <> '[' thenπ Group := '['+Group+']';ππ P := GetLastNodeInGroup(Group);π if P = nil then beginπ {group not found, create a new one}π {add a blank line for spacing}π New(P, Init(''));π if P = nil then Exit;π Insert(P);π New(P, Init(Group));π if P = nil then Exit;π Insert(P);π I := Count;π endπ elseπ I := IndexOf(P)+1;ππ {add our new element after}π if Title = '' thenπ AddProfileString := Trueπ else beginπ New(P, Init(Title+'='+NewVal));π if P <> nil then beginπ AtInsert(I, P);π AddProfileString := True;π if AlwaysUpd thenπ FlushFileπ elseπ NeedUpd := True;π end;π end;π end;ππ function TIni.AddEncryptedProfileString(Title, Group, NewVal : String) : Boolean;π {-add new encrypted node and/or group to the list}π varπ P,Q : PLine;π I : Integer;π beginπ AddEncryptedProfileString := False;π if IsSparse then exit;ππ {fixup strings as needed}π if Group[1] <> '[' thenπ Group := '['+Group+']';ππ P := GetLastNodeInGroup(Group);π if P = nil then beginπ {group not found, create a new one}π {add a blank line for spacing}π New(P, Init(''));π if P = nil then Exit;π Insert(P);π New(P, Init(Group));π if P = nil then Exit;π Insert(P);π I := Count;π endπ elseπ I := IndexOf(P)+1;ππ {add our new element after}π if Title = '' thenπ AddEncryptedProfileString := Trueπ else beginπ New(P, Init(Title+'='+Encrypt(NewVal)));π if P <> nil then beginπ AtInsert(I, P);π AddEncryptedProfileString := True;π if AlwaysUpd thenπ FlushFileπ elseπ NeedUpd := True;π end;π end;π end;ππ function TIni.EnumGroups(P : PStringCollection; Clr : Boolean) : Boolean;π {-Return P loaded with the names of all groups in the file. Returnsπ false only on error. Uses AtInsert rather than Insert so collectionπ items are in file order rather than sorted order.}π varπ Q : PLine;π R : PString;π I : Integer;π beginπ EnumGroups := False;π if Clr thenπ P^.FreeAll;ππ I := 0;π while I < Count do beginπ Q := PLine(At(I));π if Q^.PL^[1] = '[' then beginπ R := NewStr(StripBrackets(Q^.PL^));π P^.AtInsert(P^.Count, R);π end;π Inc(I);π end;π EnumGroups := True;π end;ππ function TIni.EnumGroupItems(P : PStringCollection; Group : String; Clr : Boolean) : Boolean;π {-Return P loaded with all items in group [Group]. Returns falseπ if Group not found or error. Uses AtInsert rather than Insert soπ collection items are in file order rather than sorted order.}π varπ Q : PLine;π R : PString;π S : String;π I : Integer;π beginπ EnumGroupItems := False;π if Clr thenπ P^.FreeAll;ππ {fixup strings as needed}π if Group[1] <> '[' thenπ Group := '['+Group+']';π Group := StUpcase(Group);ππ I := 0;π while I < Count do beginπ Q := PLine(At(I));π if StUpcase(Q^.PL^) = Group then beginπ Inc(I);π while (I < Count) and (PLine(At(I))^.PL^[1] <> '[') do beginπ S := Trim(PLine(At(I))^.PL^);π if (S <> '') and (S[1] <> ';') then beginπ if Pos('=', S) > 0 thenπ S[0] := Char(Pos('=', S)-1);π S := Trim(S);π R := NewStr(S);π P^.AtInsert(P^.Count, R);π end;π Inc(I);π end;π EnumGroupItems := True;π Exit;π end;π Inc(I);π end;π end;ππend.π 28 05-26-9411:04ALL DEVIN COOK TV Library Objects SWAG9405 390 d Unit Misc;ππ{π MISC.PASπ A Turbo Vision Object Libraryππ By Devin Cookπ MSD - 1990ππI haven't been exactly overwhelmed by the amount of Turbo Vision objects sharedπby TP users, so I thought I would thow my hat into the ring and spread a fewπobjects I have developed around.ππI am not an expert in Turbo Vision ( who can be in 3 weeks? ), or in OOP, so Iπhave probably broken quite a few rules, but you might get some ideas from theπwork I have done.ππThis unit has some of the my more mainstream objects included. I have a fewπother, less general objects which I may spread around later.ππThese objects have not been used enough to verify they are 100% bug free, soπif you find any problems, or have any comments, please send me some Emailπ( D.Cook on Genie ).ππ OBJECTS:ππTDateView - A date text box, much like TClockView in TVDemos.ππTPushButton - A descendend of TButton, with "feel" for keyboard users.ππTNum_Box - A number only input box with an adjustable number of digitsπ before and after the decimal point, along with selectableπ negative number acceptance.ππTLinked_Dialog - A descendent of TDialog which allows you to set "Links"π between items ( i.e. item selection through cursor keys ).ππAlso, FormatDate, a function used by TDateView is provided.πππ ╔═════════════╗π ║ TDateView ║π ╚═════════════╝πππTDateView is almost identicle to TClockView ( in TVDemos - Gadget.Pas ).ππINITIALIZATION:ππTDateView is initialized by sending TDateView a TRect giving it's location.ππUSAGE:ππOnce TDateView is initialized, an occasional call to TDateView.Update keepsπthe displayed date current.ππExample:ππ Var TR : TRect ;π DateV : TDateView ;π Beginπ TR.Assign( 60 , 0 , 78 , 1 );π DateV.Init( TR );π DateV.Update ;π End;ππππ ╔═══════════════╗π ║ TPushButton ║π ╚═══════════════╝πππTPushButton is identicle to TButton in every way except that when it isπ"pressed", it actually draws itself pressed.ππThis gives visual feedback to those using non-mouse systems.ππThe delay values in TPushButton.Press may need to be altered to adjust theπ"feel".ππ ╔════════════╗π ║ TNum_Box ║π ╚════════════╝πππTNum_Box is a numerical entry box with definable precision.ππINITIALIZATION:ππTNum_Box is initialized by sending TNum_Box.Init:π Location : TPointπ Max Digits before the decimal point : Integerπ Max Digits after the decimal point : Integerπ Negative Numbers allowed flag : Booleanπ Default Value : ExtendedππIf the digits after the decimal point = 0, no decimal point is displayedπ( or excepted ).ππIf negative numbers are allowed, one extra space is reserved for a negativeπsign. No digits can be entered in this spot.ππOnly Backspace is used to edit the numberical field.ππUSAGE:ππThe value of the input box can be read directly from TNum_Box.Curr_Val.ππThis value may not be up to date if editing is still taking place, or noπdata has been entered. To ensure a correct reading, a call toπTNum_Box.Update_Value is recommended.ππAfter initilization, the box is displayed with blanks for the number of digits.πIf you wish to display the default value instead, use TNum_Box.Update_Value.ππExample:ππ Var TP : TPoint ;π Int_Box1 : TNum_Box ;π Int_Box2 : TNum_Box ;π Flt_Box1 : TNum_Box ;π Beginπ Tp.X := 10 ;π Tp.Y := 5 ;ππ (* Define a box at 10,5 with 3 digits, no decimals, no negatives and aπ default of 0 *)ππ Int_Box1.Init( TP , 3 , 0 , False , 0 )ππ TP.X := 15 ;ππ (* Define a box at 10,15 with 5 digits, no decimals, negatives and aπ default of 1. Then, update the box displaying the default *)ππ Int_Box2.Init( TP , 5 , 0 , True , 1 )π Int_Box2.Update_Value ;ππ TP.X := 25 ;ππ (* Define a box at 10,25 with 5 digits, 2 decimal places , negatives andπ a default of 0. Leave the box a blank. *)ππ flt_Box1.Init( TP , 5 , 2 , True , 0 )ππ End;ππ ╔══════════════════╗π ║ TLinked_Dialog ║π ╚══════════════════╝πππTLinked_Dialog is descendant of TDialog with improved cursor movement betweenπfields.ππDeveloping for a non-mouse system ( even a mouse system ) where your dialogsπhave over about 10 fields gets a bit ugly. The tab key becomes impracticleπand setting hotkeys for each field may not be practicle.ππThe program EXAMPLE.PAS is not an exageration, it is a SIMPLIFIED version ofπa dialog I am developing at work. Try getting to a field #54 via tabs!ππTLinked_Dialog solves the problem by having the Dialog jump between linksπyou define. Cursor keys are used to select the link direction, though 2 spareπlinks are defined for object future use or for object use.ππ Example of a linking: 11π 21 22π 31ππ Object 21 would want links defined for 11 ( DLink_Up ), 22 ( DLink_Right ),π and 31 ( DLink_Down ).ππ Once the links are defined, HandleEvent switches the focus according to theπ cursor keys.πππINITIALIZATION:ππTDialog is initialized exactly the same as TDialog. ( Refer to the Turbo Visionπmanual for details. )ππTLinked_Dialog.Init calls TDialog.Init and the initialized a collection ofπlinks to track item linking.ππUSAGE:ππOnce TLinked_Dialog is initialized, you insert items into the TLinked_Dialogπjust as you would a normal dialog.ππAfter the items are inserted, you set up links.ππ***** NOTE: Do not set up links for an item before it is inserted! *****ππLinks are created by calling TLinked_Dialog.Set_Link withπ Item to set link for : PViewπ Direction of link : Integerπ Use the constants:π DLink_Up, Dlink_Down, DLink_Right,π DLink_Left, DLink_Spare1, Dlink_Spare2π Pointer to linked item : PointerππAll links are 1 way. If you wish Button55 <--> Button56, you must defineπtwo links, Button55 right to Button56 and Button56 left to Button55. This isπbecause multiple items may be linked to the same item, which would make findingπthe reverse link impossible.ππYou can select another object via a link by calling TLinked_Dialog.Select_Linkπwith the link direction. The currently selected object's link will be tracedπto the next object ( If possible ).ππExample:ππ Var TR : TRect ;π TP : TPoint ;π TLD : TLinked_Dialog ;π Butt1 : TPushButton ;π Box1 : TNum_Box ;π Box2 : TNum_Box ;π Box3 : TNum_Box ;π Box4 : TNum_Box ;ππ Beginπ TR.Assign( 10 , 1 , 70 , 10 );π TLD.Init( TR ,'Test Linked Dialog');πππ (* Set up a button and insert it *)ππ TR.Assign( 5 , 3 , 15 , 5 );π Butt1.Init(TR,'~P~ush',cmOk,bfDefault));π TLD.Insert( Butt1 );ππ (* Set up box1 and insert it *)π TP.Y := 8 ;π TP.X := 3 ;ππ Box1.Init( TP , 3 , 2 , FALSE , 1 );π TLD.Insert( Box1 );ππ (* Set up box2 and insert it *)π TP.X := TP.X + 10 ;ππ Box2.Init( TP , 3 , 2 , FALSE , 1 );π TLD.Insert( Box2 );ππ TP.Y := 9 ;π TP.X := 3 ;ππ (* Set up box3 and insert it *)ππ Box3.Init( TP , 3 , 2 , FALSE , 1 );π TLD.Insert( Box3 );ππ TP.X := TP.X + 10 ;ππ (* Set up box and insert it *)ππ Box4.Init( TP , 3 , 2 , FALSE , 1 );π TLD.Insert( Box4 );ππ (* Boxes at [1] [2] *)π (* [3] [4] *)ππ (* Link Box1 -> Box2 *)π TDL.Set_Link( @BOX1 , DLink_Right , @BOX2 );ππ (* Link Box1 <- Box2 *)π TDL.Set_Link( @BOX2 , DLink_Left , @BOX1 );ππ (* Link Box3 -> Box4 *)π TDL.Set_Link( @BOX3 , DLink_Right , @BOX4 );ππ (* Link Box3 <- Box4 *)π TDL.Set_Link( @BOX4 , DLink_Left , @BOX3 );ππ (* Link Box1 -> Box3 *)π TDL.Set_Link( @BOX1 , DLink_Down , @BOX3 );ππ (* Link Box1 <- Box3 *)π TDL.Set_Link( @BOX3 , DLink_Up , @BOX1 );ππ (* Link Box2 -> Box4 *)π TDL.Set_Link( @BOX2 , DLink_Down , @BOX4 );ππ (* Link Box2 <- Box4 *)π TDL.Set_Link( @BOX4 , DLink_Up , @BOX2 );ππEnd;πππ}ππ{ Note: Tab Size = 4 }ππ(* Set conditions to allow for "Extended" type *)π{$N+,E+}ππ(**************************************************************************)π(* *)π(* Library of objects for Turbo Vision V1.00 *)π(* *)π(* By: Devin Cook *)π(* copyright (c) 1990 MSD *)π(* Public Domain Object library *)π(* *)π(* Object: TDateView *)π(* Same as TClockView, except displays the date *)π(* *)π(* Object: TPushButton *)π(* Same as TButton, except button "Show" press by keyboard *)π(* *)π(* Object: TNum_Box *)π(* An editable number only entry box - configurable *)π(* *)π(* Object: TLinked_Dialog *)π(* A normal dialog which handles cursor links to other *)π(* items *)π(* *)π(* Func: FormatDate *)π(* Formats a date into a string *)π(* *)π(**************************************************************************)ππ{$F+,O+,S-,D+}ππInterfaceππUses Crt, Dos, Objects, Views, Dialogs, Drivers;ππ(* Constents for Linked_Dialog *)ππConst DLink_Left = 1 ;π DLink_Right = 2 ;π DLink_Up = 3 ;π DLink_Down = 4 ;π DLink_Spare1 = 5 ;π DLink_Spare2 = 6 ;ππTypeππ(**************************************************************************)π(* *)π(* Object: TDateView *)π(* *)π(* Desc: TDateView is a static text object of the date, in a formated *)π(* string, usually placed on the status or menu lines. *)π(* *)π(* Format: Sun Dec 16, 1990 *)π(* *)π(* This format can be altered by changing Function FormatDate. *)π(* *)π(* Init: Initialization is done by supply a TRect to the INIT method. *)π(* *)π(* Note: The UPDATE method checks to see if the Day-of-Week value still *)π(* matches the system Day-of-Week, and updates it's view if they *)π(* don't match. An occasional call to TDateView.UPDATE will keep *)π(* your date indicator up to date. *)π(* *)π(**************************************************************************)ππ PDateView = ^TDateView;π TDateView = Object(TView)π DateStr: string[19];π Last_DOW: Word;π Constructor Init(var Bounds: TRect);π Procedure Draw; virtual;π Procedure Update; virtual;π End;ππ(**************************************************************************)π(* *)π(* Object: TPushButton *)π(* *)π(* Desc: TPushButton is a TButton except that it indicates being *)π(* pressed from the keyboard. *)π(* *)π(* Note: You may wish to adjust with the delay values in the *)π(* TPushButton.Press method to suit your taste. *)π(* *)π(* See TButton for method descriptions. *)π(* *)π(**************************************************************************)ππ PPushButton = ^TPushButton;π TPushButton = Object(Tbutton)π Procedure Press ; Virtual ;π End;ππ(**************************************************************************)π(* *)π(* Object: TNum_Box *)π(* *)π(* Desc: TInt_Box is a number only input box with an adjustable number *)π(* of digits before and after the decimal point. *)π(* *)π(* It can be flagged not to accept negative numbers if desired. *)π(* *)π(* Init: Initialization is done by providing your desired configuration *)π(* to TNum_Box.Init. *)π(* *)π(* TNum_Box.Init( *)π(* Loc - TPoint with location for num *)π(* MaxWh - Integer with #digits before the decimal *)π(* point *)π(* MaxDs - Integer with #digits after the decimal *)π(* point *)π(* NegOk - Boolean. True if neg values allowed *)π(* Deflt - Extended floating point with default value *)π(* ) *)π(* *)π(* Box width = MaxWh + *)π(* MaxDs + 1 ( if MaxDs > 0 ) + *)π(* 1 if Negok *)π(* *)π(* To read the value back, simply access the Curr_Val variable for the *)π(* TNum_Box. It is an extended floating point varaible, so you should *)π(* convert it to the desired precision. *)π(* *)π(* Note: A call to TNum_Box.Update_Val "Locks" the edited number into *)π(* the curr_val field, loading the default value if no number has *)π(* been entered. *)π(* *)π(**************************************************************************)ππ PNum_Box = ^TNum_Box;π TNum_Box = Object ( TView )π Max_Whole : Integer ;π Max_Decs : Integer ;π Max_Len : Integer ;π Neg_Ok : Boolean ;π Default_val : Extended ;π Num_Str : String[24] ;π Curr_Val : Extended ;π Dec_Pos : Integer ;π First_Char : Boolean ;ππ Constructor Init( Loc : TPoint ;π MaxWh : Integer ;π MaxDs : Integer ;π NegOk : Boolean ;π Dflt : Extended );π Procedure Draw; Virtual;π Procedure HandleEvent( Var Event:TEvent ); Virtual;π Procedure SetState( AState:Word; Enable:Boolean);π Virtual;π Procedure Add_Digit( Charcode : Char ); Virtual;π Procedure Do_Edit( Keycode : Word ); Virtual;π Procedure Update_Value;π End;ππ(* Record used by TLinked_Dialog *)ππ DLink_Record = Recordπ Item : Pointer ;π Left_Link : Pointer ;π Right_Link : Pointer ;π Up_Link : Pointer ;π Down_Link : Pointer ;π Spare1_Link : Pointer ;π Spare2_Link : Pointer ;π End;ππ(* Object for TLinked_Dialog's collection *)ππ PLink_Item = ^TLink_Item ;π TLink_Item = Objectπ Item : Pointer ;π Pointers : Array[1..6] of Pointer ;π Constructor Init( Link_Rec : DLink_Record );π Procedure Add_Link( Link_Direc : Integer ;π Link : Pointer );π End;ππ(* TLinked_Dialog's collection of links *)ππ PLinked_List = ^TLinked_List ;π TLinked_List = Object( TCollection )π Function Search( key : Pointer ) : Integer ;π End;ππ(**************************************************************************)π(* *)π(* Object: TLinked_Dialog *)π(* *)π(* Desc: TLinked_Dialog is a variation of a standard dialog which *)π(* allows for improved cursor movement between items. *)π(* *)π(* You can define which objects to "Link" to on the right, left, *)π(* above and below. These objects are focused by use of the *)π(* cursor keys. *)π(* *)π(* Two spare links are defined for item use ( such as switching *)π(* to a certain box once a button is pressed. ) *)π(* *)π(* Init: Initialization is identical to TDialog's init. Refer to the *)π(* Turbo Vision manual for details. *)π(* *)π(* Inserting an item is identical to a normal TDialog.Insert. When an *)π(* item is inserted into a TLinked_Dialog, a record is created for *)π(* tracking links. *)π(* *)π(* Defining a Link *)π(* *)π(* Once you have inserted all items into your dialog, links are created *)π(* to other items using TLinked_Dialog.Setlink. *)π(* *)π(* TLinked_Dialog.Setlink( *)π(* P - PView or descendant. *)π(* This is a pointer to the item you wish to add *)π(* the link to. *)π(* Link_Direc - Integer with link direction. *)π(* This should be one of the following constants: *)π(* DLink_Up : Up *)π(* DLink_Down : Down *)π(* DLink_Right : Right *)π(* DLink_Left : Left *)π(* DLink_Spare1 : Spare 1 *)π(* DLink_Spare2 : Spare 2 *)π(* Link - A pointer to the item you want to link to *)π(* ) *)π(* *)π(* Accesing a link *)π(* *)π(* Items within a dialog can switch to a linked item by calling: *)π(* *)π(* TLinked_Dialog.Select_link( *)π(* Direc - Integer with link direction. *)π(* ) *)π(* *)π(**************************************************************************)ππ PLinked_Dialog = ^TLinked_Dialog ;π TLinked_Dialog = Object( TDialog )π Link_List : TLinked_List ;π Constructor Init(var Bounds: TRect;π ATitle: TTitleStr);π Procedure Insert(P: PView); Virtual;π Procedure Set_Link( P: PView ;π Link_Direc : Integer ;π Link : Pointer );π Procedure HandleEvent( Var Event : TEvent );π Virtual;π Procedure Select_Link( Direc : Integer );π End;πππ(**************************************************************************)π(* *)π(* Function: FormatDate *)π(* *)π(* Desc: The format date function used by TDateView, made public for *)π(* other possible uses. *)π(* *)π(**************************************************************************)ππFunction FormatDate( Year , Month , Day , DOW : Word ): String;ππImplementationππ(**************************************************************************)π(* *)π(* Object: TDateView *)π(* *)π(**************************************************************************)ππConstructor TDateView.Init(var Bounds: TRect);πBeginπ TView.Init(Bounds);π DateStr := '';π LAST_DOW := 8 ; (* Force an update! *)πEnd;πππ(* Draw the TDateView object *)ππProcedure TDateView.Draw;πVarπ B: TDrawBuffer;π C: Byte;πBeginπ C := GetColor(2);π MoveChar(B, ' ', C, Size.X);π MoveStr(B, DateStr, C);π WriteLine(0, 0, Size.X, 1, B);πEnd;ππ(* Verify the TDateView object is up to date *)π(* Redisplaying it if it needs updating *)ππProcedure TDateView.Update;πVar Year, Month, Day, DOW : word;πBeginπ GetDate( Year , Month , Day , Dow );π If (DOW <> LAST_DOW) thenπ Beginπ DateStr := FormatDate( Year , Month , Day , DOW );π DrawView;π LAST_DOW := DOW ;π End;πEnd;ππ(**************************************************************************)π(* *)π(* Object: TPushButton *)π(* *)π(**************************************************************************)ππProcedure TPushButton.Press;πBeginπ DrawState(TRUE); (* Draw Button "Pressed" *)π Delay(150);π DrawState(FALSE); (* Draw Button "Released" *)π Delay(50);π TButton.Press;πEnd;ππ(**************************************************************************)π(* *)π(* Object: TNum_Box *)π(* *)π(**************************************************************************)ππConstructor TNum_Box.Init( Loc : TPoint ; MaxWh, MaxDs : Integer ;π NegOk : Boolean ; Dflt : Extended );πVar R : TRect ;π X : Integer ;π Wrk_Str : String ;ππBeginππ Wrk_Str := '' ;π If ( NegOk ) thenπ Wrk_Str := ' ' ;π For X := 1 to MaxWh doπ Wrk_Str := Wrk_Str + ' ' ;ππ If ( MaxDs > 0 ) thenπ Beginπ Wrk_Str := Wrk_Str + '.';π For X := 1 to MaxDs doπ Wrk_Str := Wrk_Str + ' ' ;π End;π R.Assign( Loc.X , Loc.Y , Loc.X + Length( Wrk_Str ) , Loc.Y + 1 );π TView.Init( R ) ;ππ Num_Str := Wrk_Str ;ππ Neg_Ok := NegOk ;π Max_Whole := MaxWh ;π Max_Decs := MaxDs ;ππ Max_Len := Length( Num_Str );ππ Options := Options OR ofSelectable ;ππ Default_Val := Dflt ;π Curr_Val := Dflt ;π Dec_Pos := Pos( '.' , Num_Str );ππ If ( Dec_Pos < 1 ) thenπ Dec_Pos := Max_Len + 1 ;πππ Cursor.X := Dec_Pos - 2;ππ First_Char := True ;π ShowCursor;πEnd;ππ(* Draw the TNum_Box on the view. *)π(* Color depends on the state of *)π(* the object. *)ππProcedure TNum_Box.Draw;πVar Buff : TDrawBuffer ;π Colr : Word;πBeginπ Colr := GetColor(19);π If GetState(sfFocused) thenπ If First_Char thenπ Colr := GetColor(20)π elseπ Colr := GetColor(22);ππ MoveChar( Buff,' ',Colr, Size.X);π MoveStr( Buff,Num_Str,0);π Writeline(0,0,Size.X,1,Buff);ππEnd;ππ(* Updated SetState to watch for changes in the *)π(* selected and focused flags. *)ππProcedure TNum_Box.SetState(AState: Word; Enable: Boolean);πBeginπ TView.SetState(AState, Enable);π If ( AState = sfFocused ) thenπ Draw ;π If ( AState = sfFocused ) And ( Enable ) thenπ First_Char := TRUE ;πEnd;ππ(* HandleEvent, routing keystrokes *)ππProcedure TNum_Box.HandleEvent( Var Event : TEvent );πVar NextCmd: TEvent;π test:PEvent;πBeginπ TView.HandleEvent( Event );π If Event.What = evKeydown thenπ Beginπ Case ( Event.Charcode ) ofπ #00 : Beginπ End;π #08 : Beginπ Do_Edit( Event.keyCode );π ClearEvent( Event );π End;π #13 : Beginπ ClearEvent( Event );π Update_Value ;π End;π '0'..'9': Beginπ Add_Digit( Event.Charcode );π ClearEvent( Event );π End;π '.','-': Beginπ Add_Digit( Event.Charcode );π ClearEvent( Event );π End;π End;π End;πEnd;ππ(* Perform normal charector addition to the number string *)ππProcedure TNum_Box.Add_Digit( Charcode : Char );πVar X : Integer ;π First_Dig : Integer ;πBeginππ If ( First_Char ) thenπ Beginπ For X := 1 to Length( Num_Str ) doπ If (Num_Str[X]<>'.') thenπ Num_Str[X]:=' ';ππ First_Char := False ;π Cursor.X := Dec_Pos - 2;π ShowCursor;π End;ππ If Neg_Ok thenπ First_Dig := 2π elseπ First_Dig := 1;ππ If ( Cursor.X < Dec_Pos ) thenπ Case ( Charcode ) ofπ '0'..'9' : If Not( Num_Str[ First_Dig ] IN ['0'..'9']) thenπ Beginπ For X := 1 to Cursor.X doπ Num_Str[X] := Num_Str[X+1] ;π Num_Str[ Cursor.X + 1 ] := Charcode ;π End;π '-' : Beginπ If (Neg_Ok) thenπ Beginπ if (Num_Str[ Cursor.X + 1 ] = ' ') thenπ Num_Str[ Cursor.X + 1 ] := '-'π End;π End;π '.' : Beginπ If (Max_Decs>0) and ( Cursor.X < Dec_Pos ) thenπ Beginπ Cursor.X := Dec_Pos ;π ShowCursor;π End;π End;π Endπ elseπ Case ( Charcode ) ofπ '0'..'9' : Beginπ If ( Cursor.X < ( Max_Len - 1 )) thenπ Beginπ Num_Str[Cursor.X+1] := Charcode ;π Inc( Cursor.X );π ShowCursor;π Endπ elseπ if Num_Str[Cursor.X+1] = ' ' thenπ Num_Str[Cursor.X+1] := Charcode ;π End;π End;ππ Draw;πEnd;ππ(* Perform any editing on the number string *)π(* ( Only the <Backspace> key is currently *)π(* supported ). *)ππProcedure TNum_Box.Do_Edit( Keycode : Word );πVar X : Integer ;πBeginπ First_Char := False ;π If ( Dec_Pos = 0 ) or ( Cursor.X < Dec_Pos ) thenπ Beginπ If (Keycode = kbBack) thenπ Beginπ For X := Cursor.X+1 downto 2 doπ Num_Str[X] := Num_Str[X-1] ;π Num_Str[ 1 ] := ' ' ;π End;π Endπ elseπ Beginπ If (Keycode = kbBack) thenπ Beginπ If Num_Str[Cursor.X+1] = ' ' thenπ Beginπ Dec( Cursor.X );π Num_Str[Cursor.X+1] := ' ';π Endπ elseπ Num_Str[Cursor.X+1] := ' ';ππ If Num_Str[ Cursor.X ] = '.' thenπ Cursor.X := Cursor.X - 2 ;π ShowCursor;π End;π End;ππ Draw;πEnd;ππ(* "Lock" the number string value in the box. *)π(* Use the default value if no number is present. *)ππProcedure TNum_Box.Update_Value;πVar Code : Integer ;π Work_str: String[24];πBeginπ Work_Str := Num_Str ;π While (( Length( Work_Str )>0 ) and ( Work_Str[Length( Work_Str )] IN ['.',' '])) doπ Work_Str := Copy( Work_Str , 1 , length( Work_Str ) -1 );ππ Code := 0 ;ππ If ( Work_Str = '' ) thenπ Curr_Val := Default_Valπ elseπ Val( Work_Str, Curr_Val , Code );π Str( Curr_Val:Max_Len:Max_Decs , Num_Str );ππ Cursor.X := Max_Len - 1 ;π First_Char := True ;π Draw;πEnd;ππ(**************************************************************************)π(* *)π(* Object: TLink_Item *)π(* *)π(* Used by TLinked_Dialog to track links *)π(* *)π(**************************************************************************)ππConstructor TLink_Item.Init( Link_Rec : DLink_Record );πBeginπ Item := Link_Rec.Item ;π With Link_Rec doπ Beginπ Pointers[DLink_Left] := Left_Link;π Pointers[DLink_Right] := Right_Link;π Pointers[DLink_Up] := Up_Link;π Pointers[DLink_Down] := Down_Link;π Pointers[DLink_Spare1] := Spare1_Link;π Pointers[DLink_Spare2] := Spare2_Link;π End;πEnd;ππProcedure TLink_Item.Add_Link( Link_Direc : Integer ; Link : Pointer );πBeginπ Pointers[ Link_Direc ] := Link ;πEnd;ππ(**************************************************************************)π(* *)π(* Object: TLink_List *)π(* *)π(* Used by TLinked_Dialog to track links *)π(* *)π(**************************************************************************)ππFunction TLinked_List.Search( Key : Pointer ) : Integer ;πVar X : Integer ;π Found : Boolean ;π Linked_Item : PLink_Item ;πBeginπ Search := -1 ;π Found := False ;π X := 0 ;π While ( X < Count ) AND ( NOT FOUND ) doπ Beginπ Linked_Item := at( X );π Found := Linked_Item^.Item = Key ;π X := X + 1 ;π End;ππ If ( Found ) thenπ Search := X - 1 ;πEnd;ππ(**************************************************************************)π(* *)π(* Object: TLinked_Dialog *)π(* *)π(**************************************************************************)ππConstructor TLinked_Dialog.Init(var Bounds: TRect; ATitle: TTitleStr);πBeginπ TDialog.Init( Bounds , ATitle );π Link_List.Init(10, 5);πEnd;ππProcedure TLinked_Dialog.Insert(P: PView);πVar Linked_Item : PLink_Item ;π Blank_Rec : DLink_Record ;πBeginπ With Blank_Rec doπ Beginπ Item := P ;π Left_Link := Nil ;π Right_Link := Nil ;π Up_Link := Nil ;π Down_Link := Nil ;π Spare1_Link := Nil ;π Spare2_Link := Nil ;π End;π Linked_Item := New( PLink_Item , Init( Blank_Rec ) );π TDialog.Insert( P );π Link_List.Insert( Linked_Item );πEnd;ππProcedure TLinked_Dialog.Set_Link(P:PView;Link_Direc:Integer;Link:Pointer);πVar Linked_Item : PLink_Item ;π X : Integer ;πBeginπ X := Link_List.Search( P );π If ( X < 0 ) thenπ Exit ;π Linked_Item := Link_List.at( X );π Linked_Item^.Pointers[ Link_Direc ] := Link ;πEnd;ππProcedure TLinked_Dialog.Select_Link( Direc : Integer );πVar X : Integer ;π LL_Item : PLink_Item ;π Item : PView ;πBeginπ X := Link_List.Search( Current );π LL_Item := Link_List.at(X);π Item := LL_Item^.Pointers[ Direc ];π If ( Item <> Nil ) thenπ Item^.Select ;πEnd;ππProcedure TLinked_Dialog.HandleEvent( Var Event : TEvent );πVar X : Integer ;π LL_Item : PLink_Item ;π Item : PView ;πBeginπ TDialog.HandleEvent( Event );ππ If ( Event.What = evKeydown ) thenπ Case Event.keycode ofπ kbUp : Beginπ Select_Link( DLink_Up );π ClearEvent( Event );π End;π kbDown : Beginπ Select_Link( DLink_Down );π ClearEvent( Event );π End;π kbRight : Beginπ Select_Link( DLink_Right );π ClearEvent( Event );π End;π kbLeft : Beginπ Select_Link( DLink_Left );π ClearEvent( Event );π End;π End;πEnd;ππ(**************************************************************************)π(* *)π(* Function: FormatDate *)π(* *)π(**************************************************************************)ππFunction FormatDate( Year , Month , Day , DOW : Word ): String;πConstπ DAYS : Array[0..6] of String = ( 'Sun','Mon','Tue','Wed','Thu','Fri','Sat');π MONTHS : Array[1..12] of String = ( 'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');πVar Work1,Work2 : String[4] ;πBeginπ Str( Day,Work1 );π If ( Day < 10 ) thenπ Work1 := '0' + Work1 ;π Str( Year,Work2 );π FormatDate := DAYS[DOW]+' '+MONTHS[Month]+' '+Work1+', '+Work2;πEnd;ππBeginπend.ππ{----------------------- DEMO CODE --------------------- }ππProgram Example;ππUses Crt,App, Objects, Views, Dialogs, Drivers, Misc;ππTypeπ PMyApp = ^TMyApp ;π TMyApp = Object( TApplication )π Constructor Init;π End;ππVarπ MyApp : TMyApp ;π Dialog : PLinked_Dialog;ππ Screen_Array : Array[1..70] of TNum_Box;ππProcedure Build_Links;πVar P : TPoint ;π X,Y : Integer ;π N : Integer ;πBeginππ For N := 1 to 50 doπ Beginπ P.Y := ( N - 1 ) DIV 10 + 8 ;π P.X := ( N - 1 ) MOD 10 * 4 + 20 ;ππ Screen_Array[N].Init( P , 3 , 0 , FALSE , N );π Screen_Array[N].Update_Value;π End;ππ For N := 1 to 8 doπ Beginπ P.Y := ( N - 1 ) Div 3 * 2 + 8 ;π P.X := ( N - 1 ) Mod 3 * 4 + 60 ;π If ( N > 6 ) thenπ P.X := P.X + 4 ;π Screen_Array[N+50].Init( P , 3 , 0 , FALSE , N+50 );π Screen_Array[N+50].Update_Value;π End;ππ P.Y := 6 ;ππ(* Initialize 5 floating point boxes *)ππ For N := 1 to 5 doπ Beginπ P.X := ( N * 12 ) ;π Screen_Array[N+58].Init( P , 4 , 2 , True , N+58 );π End;ππ(* Insert all boxes before setting links! *)ππ For N := 1 to 63 doπ Dialog^.Insert( @Screen_Array[N] );ππ For N := 1 to 50 doπ Beginπ if ( N MOD 10 ) <> 1 thenπ Dialog^.Set_Link(@Screen_array[N],DLink_Left ,@Screen_array[N-1]);π if ( N MOD 10 ) <> 0 thenπ Dialog^.Set_Link(@Screen_array[N],DLink_Right,@Screen_array[N+1]);π if ( N > 10 ) thenπ Dialog^.Set_Link(@Screen_array[N],DLink_Up ,@Screen_array[N-10])π elseπ Dialog^.Set_Link(@Screen_array[N],DLink_Up ,@Screen_array[59]);ππ if ( N <41 ) thenπ Dialog^.Set_Link(@Screen_array[N],DLink_Down ,@Screen_array[N+10]);ππ if ( N=10 ) or ( N=20 ) thenπ Dialog^.Set_Link(@Screen_array[N],DLink_Right,@Screen_array[51]);ππ if ( N=30 ) or ( N=40 ) thenπ Dialog^.Set_Link(@Screen_array[N],DLink_Right,@Screen_array[54]);π End;ππ Dialog^.Set_Link(@Screen_array[50],DLink_Right,@Screen_array[57]);ππ Dialog^.Set_Link(@Screen_array[51],DLink_Left ,@Screen_array[10]);π Dialog^.Set_Link(@Screen_array[51],DLink_Right,@Screen_array[52]);π Dialog^.Set_Link(@Screen_array[51],DLink_Down ,@Screen_array[54]);ππ Dialog^.Set_Link(@Screen_array[52],DLink_Left ,@Screen_array[51]);π Dialog^.Set_Link(@Screen_array[52],DLink_Right,@Screen_array[53]);π Dialog^.Set_Link(@Screen_array[52],DLink_Down ,@Screen_array[55]);ππ Dialog^.Set_Link(@Screen_array[53],DLink_Left ,@Screen_array[52]);π Dialog^.Set_Link(@Screen_array[53],DLink_Down ,@Screen_array[56]);ππ Dialog^.Set_Link(@Screen_array[54],DLink_Left ,@Screen_array[30]);π Dialog^.Set_Link(@Screen_array[54],DLink_Right,@Screen_array[55]);π Dialog^.Set_Link(@Screen_array[54],DLink_Down ,@Screen_array[57]);π Dialog^.Set_Link(@Screen_array[54],DLink_Up ,@Screen_array[51]);ππ Dialog^.Set_Link(@Screen_array[55],DLink_Left ,@Screen_array[54]);π Dialog^.Set_Link(@Screen_array[55],DLink_Right,@Screen_array[56]);π Dialog^.Set_Link(@Screen_array[55],DLink_Down ,@Screen_array[57]);π Dialog^.Set_Link(@Screen_array[55],DLink_Up ,@Screen_array[52]);ππ Dialog^.Set_Link(@Screen_array[56],DLink_Left ,@Screen_array[55]);π Dialog^.Set_Link(@Screen_array[56],DLink_Down ,@Screen_array[58]);π Dialog^.Set_Link(@Screen_array[56],DLink_Up ,@Screen_array[53]);ππ Dialog^.Set_Link(@Screen_array[57],DLink_Left ,@Screen_array[50]);π Dialog^.Set_Link(@Screen_array[57],DLink_Right,@Screen_array[58]);π Dialog^.Set_Link(@Screen_array[57],DLink_Up ,@Screen_array[55]);ππ Dialog^.Set_Link(@Screen_array[58],DLink_Left ,@Screen_array[57]);π Dialog^.Set_Link(@Screen_array[58],DLink_Up ,@Screen_array[56]);ππ For N := 59 to 63 doπ Beginπ if ( N > 59 ) thenπ Dialog^.Set_Link(@Screen_array[N],DLink_Left ,@Screen_array[N-1]);π if ( N < 63 ) thenπ Dialog^.Set_Link(@Screen_array[N],DLink_Right,@Screen_array[N+1]);π Dialog^.Set_Link(@Screen_array[N],DLink_Down,@Screen_array[1]);π End;πEnd;ππProcedure Do_Dialog;πVar R : TRect ;π TP : TPoint ;π N : Integer ;π Button : PButton ;πBeginππ R.Assign( 0 , 10 , 80 , 24 );π Dialog := New( PLinked_Dialog , Init( R , 'Linked Dialog Example' ));π Dialog^.SetState(sfShadow,False );ππ Build_Links;ππ R.Assign( 5 , 8 , 15 , 10 );π Button := New(PPushButton,Init(R,'~P~ush',cmOk,bfDefault));π Dialog^.Insert( Button );ππ R.Assign( 5 , 11 , 15 , 13 );π Button := New(PPushButton,Init(R,'~E~xit',cmQuit,bfDefault));π Dialog^.Insert( Button );ππ Dialog^.Set_Link(Button,DLink_Right,@Screen_array[1]);ππ MyApp.Insert( Dialog );ππEnd;πππConstructor TMyApp.Init;πBeginπ TApplication.Init ;π Do_Dialog;πEnd;ππBeginπ ClrScr;π MyApp.Init ;π MyApp.Run ;π MyApp.Done ;πEnd. 29 08-24-9417:56ALL PAB SUNGENIS TurboVison BUTTONS SWAG9408 ¼ÿ'S 20 d π{πButtons are best done in TurboVision or ObjectWindows. Re-read theπsections dealing with the above in your manual and/or references.ππIf you want to use TurboVision (for the DOS environment), this is a unitπfor a derived object type I created to ease creation of dialog boxes.πYou might want to use it in addition to the TurboVision units:π}ππUnit XBoxes;ππInterfaceππUses Dialogs, Objects, Menus, Views;ππTypeπ XDialog = Object(TDialog)π Procedure TxtEntry(x,y : Byte; txt : string; max : Byte);π Procedure MakeButton(x,y,w: Byte; Txt: string; cmd,mode: Word)π Procedure OKButton(x,y : Byte);π Procedure CancelButton(x,y : Byte);π Procedure Static(x,y : Byte; txt : string);π Procedure CheckBoxes(x,y,w,z : Byte; Items : PSItem);π End;π PXDialog = ^XDialog;ππImplementationππProcedure XDialog.MakeButton(x,y,w: Byte; Txt: string; cmd, mode: Word)π{ Insert a button with the specified text, command, width, and mode atπ the x,y coordinates in the dialog box }π R : TRect;π Temp : PButton;πBegin;π R.Assign(x,y,x+w,y+2);π Temp := New(PButton,Init(R,Txt,cmd,mode));π Insert(Temp);πEnd;ππProcedure XDialog.OKButton(x,y : Byte);π{ Create and insert an 'OK' Button at x,y coordinates }πBegin;π MakeButton(x,y,10,'~O~K',cmOK,bfDefault);πEnd;ππProcedure XDialog.CancelButton(x,y : Byte);π{ Create and insert a 'Cancel' button }πBegin;π MakeButton(x,y,10,'Cancel',cmCancel,bfNormal);πEnd;ππProcedure XDialog.TxtEntry(x,y : Byte; txt : string; max : Byte);π{ Create a text entry line and label starting at x,y and expanding toπ fill the rest of the line in the box. }πVarπ w : Byte;π ID : PView;π R : TRect;πBegin;π GetExtent(R);π R.Assign(x+Length(txt)+2,y,R.B.X-2,y+1);π ID := New(PInputLine,Init(R,max));π Insert(ID);π R.Assign(x,y,x+Length(txt)+1,y+1);π Insert(New(PLabel,Init(R,txt,ID)));πEnd;ππProcedure XDialog.Static(x,y : Byte; txt : string);π{ Static text at x,y }πVarπ R : TRect;πBegin;π R.Assign(x,y,x+Length(txt)+1,y+1);π Insert(New(PStaticText,Init(R,txt)));πEnd;ππProcedure XDialog.CheckBoxes(x,y,w,z : Byte; Items : PSItem);π{ Insert check boxes for cluster 'Items' at x,y with a maximum width ofπ w and a total of z items. }πVarπ R : TRect;πBegin;π R.Assign(x,y,x+(w+3)+1,y+z+1);π Insert(New(PCheckBoxes,Init(R,Items)));πEnd;ππEnd.π 30 08-25-9409:07ALL RANDALL WOODMAN String List Object SWAG9408 KÇ}ε 41 d UNIT filelist;π{π Contains Object List for keeping a list of files.π}πINTERFACEπUSES DOS, OPString;ππTYPE CmdPtr = ^CmdRec;π CmdRec = RECORDπ CmdStr : PathStr; {79 char to allow for maximum path length}π Next : CmdPtr;π end;ππ List = OBJECTπ First, Last, Current : CmdPtr;π ListCount : Word;ππ CONSTRUCTOR Init;π Procedure AddName( Name : String );π Procedure SortList;π Procedure SortListReverse;π Function Compare( A, B : String ) : Boolean;π Function FirstName : String;π Function LastName : String;π Function CurrentName : String;π Function NextName : String;π Function TotalCount : Word;π Procedure ClearList;π Function InList( Name : String; CheckCase : Boolean ) : Boolean;π DESTRUCTOR Done;π END;ππIMPLEMENTATIONππCONSTRUCTOR LIST.INIT;πBEGINπ FIRST := NIL;π LAST := NIL;π CURRENT := NIL;π LISTCOUNT := 0;πEND;ππPROCEDURE LIST.ADDNAME( NAME : STRING );π { Add a new CmdRec to the list }πVARπ TempCmdPtr : CmdPtr;πBEGINπ NEW(TempCmdPtr);π If First = NIL then beginπ First := TempCmdPtr;π Current := TempCmdPtr;π end elseπ Last^.Next := TempCmdPtr;π TempCmdPtr^.Next := NIL;π TempCmdPtr^.CmdStr := Name;π Last := TempCmdPtr;π INC(ListCount);πEND;ππPROCEDURE LIST.SORTLIST;πVARπ TempCmdPtr : CmdPtr;π P, Q : CmdPtr;πBEGINπ if (First = NIL) or (First^.Next = NIL) then EXIT;π TempCmdPtr := First;π First := First^.Next;π TempCmdPtr^.Next := Nil;ππ repeatπ p := TempCmdPtr;ππ if not Compare( p^.CmdStr, First^.CmdStr ) thenπ beginπ TempCmdPtr := First;π First := First^.Next;π TempCmdPtr^.Next := p;π endπ elseπ beginπ while (compare( p^.CmdStr, First^.CmdStr ) ANDπ (p <> NIL)) doπ beginπ q := p;π p := p^.Next;π end;ππ if p = NIL thenπ beginπ p := First;π First := First^.Next;π q^.Next := p;π p^.Next := NIL;π endπ elseπ beginπ q^.next := First;π First := First^.next;π q^.next^.next := p;π end;π end;π until First = NIL;ππ First := TempCmdPtr;π Current := First;π Last := First;ππ repeatπ Last := Last^.Next;π until Last^.Next = NIL;ππEND;ππPROCEDURE LIST.SORTLISTREVERSE;πVARπ TempCmdPtr : CmdPtr;π CheckPtr : CmdPtr;π tempstr : string;πBEGINπ if (First = NIL) or (First^.Next = NIL) then EXIT;π TempCmdPtr := First;π CheckPtr := First^.Next;ππ While (TempCmdPtr <> NIL) DOπ BEGINπ While (CheckPtr <> NIL) DOπ BEGINπ { if the tempcmdptr string is less then the checkptr string }π If compare(TempCmdPtr^.CmdStr, CheckPtr^.CmdStr) thenπ BEGINπ { then swap the strings }π tempstr := tempCmdPtr^.cmdstr; { save temp's string }π TempCmdPtr^.cmdStr := CheckPtr^.Cmdstr; { assign check's string to tempπ CheckPtr^.Cmdstr := tempstr; { assign tempptr's string to chπ end;π CheckPtr := Checkptr^.next; { get a pointer to next node }π end; { while checkptr }π TempCmdPtr := TempCmdPtr^.Next; { get the next compairson base π end; { while tempcmdptr }πend; { SortListReverse }ππFUNCTION LIST.COMPARE( A, B : String ) : BOOLEAN;πbeginπ Compare := (CompUCString( A,B ) = Less);πend;πππFUNCTION LIST.FIRSTNAME : String;πBEGINπ if First <> NIL then beginπ FirstName := First^.CmdStr;π Current := First;π end elseπ FirstName := '';πEND;ππFUNCTION LIST.LASTNAME : String;πBEGINπ if Last <> NIL then beginπ LastName := Last^.CmdStr;π Current := Last;π end elseπ LastName := '';πEND;ππFUNCTION LIST.CURRENTNAME : String;πBEGINπ if Current <> NIL thenπ CurrentName := Current^.CmdStrπ elseπ CurrentName := '';πEND;ππFUNCTION LIST.NEXTNAME : String;πBEGINπ if (Current <> NIL) Then beginπ Current := Current^.Next;π if (Current <> NIL) thenπ NextName := Current^.CmdStrπ elseπ NextName := '';π end elseπ NextName := '';πEND;ππFUNCTION LIST.TOTALCOUNT : Word;πBEGINπ TotalCount := ListCount;πEND;ππPROCEDURE LIST.CLEARLIST;πBEGINπ if First <> NIL thenπ repeatπ Current := First^.Next;π Dispose(First);π First := Current;π until First = nil;π Last := First;π ListCount := 0;πEND;ππFunction List.InList(Name:String; CheckCase : Boolean) : Boolean;π{ returns true if string was in list }πVARπ TempPtr : CmdPtr;π OK : Boolean;πBEGINπ Ok := false;π TempPtr := Current;π Current := First;π If checkCase then OK := (CompString(FirstName,Name) = Equal)π Else Ok := (CompUCString(FirstName,Name) = Equal);π If Not OK thenπ BEGINπ While (Current <> Nil) AND Not OK DOπ If CheckCase then OK := (CompString(NextName,Name) = Equal)π Else OK := (CompUCString(NextName,Name) = Equal);π end;π InList := OK;π Current := TempPtr;πend;ππDESTRUCTOR LIST.DONE;πBEGINπ ClearList;πEND;ππBEGINπEND.ππ 31 08-25-9409:10ALL KEN.BURROWS@TELOS.ORG Defining array sizes SWAG9408 O╛╝8 35 d {π RJS> Just a quick question... In the variable declaration field, you defineπ RJS> an array with array [0..9] of foo, But let's say I didn't know exactlyπ RJS> how big the array was going to be... How would I declare an array withπ RJS> a variable endpoint?ππThere are a couple of ways around this, and they employ the use of pointers,πwhich in turn, require a little additional code to maintain. If you are useingπBorlands Pascal 6 or 7, the tCollection objects work quite well, or else makeπuse of linked lists. There is still the option of using a variable lengthedπarray too.ππAs an example,π}π{$A+,B-,D-,E-,F+,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y-}π{$M 16384,0,655360}πProgram VariableArrayETC;πuses objects;πTypeπ Data = Recordπ name : string[80];π age : integer;π end;ππ VArray = array[0..0] of Data; {variable sized array}π VAPtr = ^Varray;ππ VLPtr = ^VList; {linked list}π VList = Recordπ rec : Data;π next,π prev: VLPtr;π end;ππ DataPtr = ^data; {OOP types from the objects unit}π VObj = Object(tCollection)π procedure FreeItem(item:pointer); virtual;π end;π VObjPtr = ^VObj;π Procedure VObj.FreeItem(item:pointer);π beginπ dispose(DataPtr(item));π end;πππprocedure MakeTestFile;π var i:integer;π f:file of Data;π d:data;π Beginπ writeln;π writeln('blank name will exit');π assign(f,'test.dat');π rewrite(f);π fillchar(d,sizeof(d),0);π repeatπ write('name : '); readln(d.name);π if d.name <> ''π then beginπ repeatπ write('age : '); readln(d.age);π until ioresult = 0;π write(f,d);π end;π until d.name = '';π close(f);π End;ππProcedure VariableArrayExample; {turn Range Checking off...}π var f:file;π v:VAPtr;π i,res:integer;π d:data;π m:longint;π Beginπ writeln;π Writeln('output of variable array ... ');π m := memavail;π assign(f,'test.dat');π reset(f,sizeof(data));π getmem(v,filesize(f)*SizeOf(Data));π blockRead(f,v^,filesize(f),res);π for i := 0 to res - 1 doπ beginπ writeln(v^[i].name);π writeln(v^[i].age);π end;π freemem(v,filesize(f)*SizeOf(Data));π close(f);π if m <> memavail then writeln('heap ''a trouble...');π End;ππProcedure LinkedListExample;π var f:file of Data;π curr,hold : VLPtr;π m:longint;π Beginπ curr := nil; hold := nil;π writeln;π writeln('Linked List example ... ');π m := memavail;π assign(f,'test.dat');π reset(f);π while not eof(f) doπ beginπ new(curr);π curr^.prev := hold;π read(f,curr^.rec);π curr^.next := nil;π if hold <> nil then hold^.next := curr;π hold := curr;π end;π close(f);π hold := curr;π if hold <> nilπ then beginπ while hold^.prev <> nil do hold := hold^.prev;π while hold <> nil doπ beginπ writeln(hold^.rec.name);π writeln(hold^.rec.age);π hold := hold^.next;π end;π hold := curr;π while hold <> nil doπ beginπ hold := curr^.prev;π dispose(curr);π curr := hold;π end;π end;π if m <> memavail then writeln('heap ''a trouble...');π End;ππProcedure tCollectionExample; {requires the object unit}π var p:VObjPtr;π d:DataPtr;π f:file of Data;π m:longint;π procedure WriteEm(dp:DataPtr); far;π beginπ writeln(dp^.name);π writeln(dp^.age);π end;π beginπ writeln;π writeln('object tCollection example ... ');π m := memavail;π assign(f,'test.dat');π new(p,init(5,2));π reset(f);π while not eof(f) doπ beginπ new(d);π system.read(f,d^);π p^.insert(d);π end;π close(f);π p^.forEach(@WriteEm);π dispose(p,done);π if m <> memavail then writeln('heap ''a trouble...');π end;πππBeginπ maketestfile;π variablearrayexample;π linkedListExample;π tcollectionExample;πEnd.ππ 32 08-26-9408:32ALL DANNY THORPE Clock on Menubar SWAG9408 Oßï 95 d unit clocks;π{$X+} {allow discardable function results}ππ{ Clock-on-a-menubar OOP extension to Turbo Vision appsππ Copyright (c) 1990 by Danny Thorpeππ Alarms have not been implemented.π}ππinterfaceπuses dos, objects, drivers, views, menus, dialogs, app, msgbox;ππconst cmClockChangeDisplay = 1001;π cmClockSetAlarm = 1002;ππ ClockNoSecs = 0;π ClockDispSecs = 1;π Clock12hour = 0;π Clock24hour = 1;ππtypeππ ClockDataRec = recordπ Format: word;π Seconds: word;π RefreshStr: String[2];π end;πππ PClockMenu = ^TClockMenu;π TClockMenu = object(TMenuBar)π ClockOptions: ClockDataRec;π Refresh: byte;π LastTime: DateTime;π TimeStr: string[10];π constructor Init(var Bounds: TRect; Amenu: PMenu);π procedure Draw; virtual;π procedure Update; virtual;π procedure SetRefresh(Secs: integer); virtual;π procedure SetRefreshStr( Secs: string); virtual;π procedure ClockChangeDisplay; virtual;π procedure HandleEvent( var Event: TEvent); virtual;π function FormatTimeStr(h,m,s:word):string; virtual;π end;πππππimplementationπππfunction LeadingZero(w : Word) : String;πvarπ s : String;πbeginπ Str(w:0,s);π if Length(s) = 1 thenπ s := '0' + s;π LeadingZero := s;πend;ππππconstructor TClockMenu.Init(var Bounds: TRect; AMenu: PMenu);π var Temp: PMenuBar;π ClockMenu: PMenu;π R: TRect;π beginπ ClockMenu:= NewMenu(NewSubMenu('~'#0'~Clock ', hcNoContext, NewMenu(π NewItem('~C~hange display','',0,cmClockChangeDisplay, hcNoContext,π NewItem('Set ~A~larm','', 0, cmClockSetAlarm, hcNoContext,π nil))),π AMenu^.Items));π { ^^ tack passed menubar on end of new clock menu }π ClockMenu^.Default:= AMenu^.Default;ππ TMenuBar.Init(Bounds, ClockMenu);ππ fillchar(LastTime,sizeof(LastTime),#$FF); {fill with 65000's}π TimeStr:='';π ClockOptions.Format:= Clock24Hour;π ClockOptions.Seconds:= ClockDispSecs;π SetRefresh(1);π end;ππππprocedure TClockMenu.Draw;π var P: PMenuItem;π beginπ P:= FindItem(#0);π if P <> nil thenπ beginπ DisposeStr(P^.Name);π P^.Name:= NewStr('~'#0'~'+TimeStr);π end;π TMenuBar.Draw;π end;ππππprocedure TClockMenu.Update;π var h,m,s,hund: word;π beginπ GetTime(h,m,s,hund);π if abs(s-LastTime.sec) >= Refresh thenπ beginπ with LastTime doπ beginπ Hour:=h;π Min:=m;π Sec:=s;π end;π TimeStr:= FormatTimeStr(h,m,s);π DrawView;π end;π end;πππππprocedure TClockMenu.SetRefresh(Secs: integer);π beginπ if Secs > 59 thenπ Secs := 59;π if Secs < 0 thenπ Secs := 0;π Refresh:= Secs;π Str(Refresh:2,ClockOptions.RefreshStr);π end;ππππprocedure TClockMenu.SetRefreshStr( Secs: string);π var temp,code: integer;π beginπ val(Secs, temp, code);π if code = 0 thenπ SetRefresh(temp);π end;πππππprocedure TClockMenu.ClockChangeDisplay;ππ varπ D: PDialog;π Control: PView;π Command: word;π temp,code: integer;π R: TRect;π ClockData : ClockDataRec;ππ beginππ ClockData := ClockOptions;ππ R.Assign(14,3,48,15);π D:= new(PDialog, Init(R, 'Clock Display'));ππ R.Assign(3,3,20,5);π Control:= new(PRadioButtons, Init(R,π NewSItem('~1~2 hour',π NewSItem('~2~4 hour',π nil))));π D^.Insert(Control);ππ R.Assign(3,2,20,3);π Control:= new(Plabel, Init(R, '~F~ormat', Control));π D^.Insert(Control);ππ R.Assign(3,6,20,7);π Control:= new(PCheckBoxes, Init(R,π NewSItem('~S~econds',π nil)));π D^.Insert(Control);ππ R.Assign(16,9,20,10);π Control:= new(PInputLine, Init(R, 2));π D^.Insert(Control);ππ R.Assign(2,8,20,9);π Control:= new(PLabel, Init(R, '~R~efresh Rate', Control));π D^.Insert(Control);ππ R.Assign(2,9,15,10);π Control:= new(PLabel, Init(R, '0-59 seconds', PLabel(Control)^.Link));π D^.Insert(Control);ππ R.Assign(21,3,31,5);π Control:= new(PButton, Init(R, '~O~k', cmOk, bfDefault));π D^.Insert(Control);ππ R.Assign(21,6,31,8);π Control:= new(PButton, Init(R, '~C~ancel', cmCancel, bfNormal));π D^.Insert(Control);πππ D^.SelectNext(False);π D^.SetData(ClockData);π repeatπ Command:= Desktop^.ExecView(D);π if Command = cmOK thenπ beginπ D^.GetData(ClockData);π val(ClockData.RefreshStr,temp,code);π if (code <> 0) or ((temp<0) or (temp>59)) thenπ MessageBox('Refresh rate must be between 0 and 59 seconds.',nil,π mfOKButton+mfError);π end;π until (Command = cmCancel)π or ((code=0) and ((temp>=0) and (temp<=59)));ππ Dispose(D, Done);ππ if Command = cmOk thenπ beginπ ClockOptions:= ClockData;π SetRefreshStr(ClockData.RefreshStr);π end;ππ { update display to reflect changes immediately }π TimeStr:= FormatTimeStr(LastTime.hour, LastTime.min, LastTime.sec);π DrawView;π end;ππππππprocedure TClockMenu.HandleEvent( var Event: TEvent);π beginπ TMenuBar.HandleEvent( Event);π if Event.What = evCommand thenπ beginπ case Event.Command ofπ cmClockChangeDisplay: ClockChangeDisplay;π cmClockSetAlarm: ;π end;π end;π end;πππππfunction TClockMenu.FormatTimeStr(h,m,s: word): string;π var st, tail: string;π beginπ tail:='';π if ClockOptions.Format = Clock24Hour thenπ st:= LeadingZero(h)π elseπ beginπ if h >= 12 thenπ beginπ tail:= 'pm';π if h>12 thenπ dec(h,12);π endπ elseπ tail:= 'am';π if h=0 then h:=12; {12 am}π str(h:0,st); { no leading space on hours }π end;ππ st:=st+':'+ LeadingZero(m);πππ if ClockOptions.Seconds = ClockDispSecs thenπ st:= st+':'+LeadingZero(s);ππ FormatTimeStr:= st + tail;π end;πππππend.ππ{ ----------------------------- DEMO ---------------------- }ππprogram TestPlatform;ππuses Objects, Drivers, Views, Menus, App,π Dos, { for the paramcount and paramstr funcs}π Clocks; { for the clock on the menubar object, TClockMenu }ππ{ This generic test platform has been hooked up to the clock-on-the-menubarπ object / unit. Search for *** to find hook-up points.ππ Copyright (c) 1990 by Danny Thorpeπ}πππconst cmNewWin = 100;π cmFileOpen = 101;ππ WinCount : Integer = 0;π MaxLines = 50;πππtype PInterior = ^TInterior;π TInterior = object(TScroller)π constructor init(var Bounds: TRect; AHScrollbar, AVScrollbar: PScrollbar);π procedure Draw; virtual;π end;πππ PDemoWindow = ^TDemoWindow;π TDemoWindow = object(TWindow)π constructor Init(WindowNo: integer);π end;πππ TMyApp = object(TApplication)π procedure InitStatusLine; virtual;π procedure InitMenuBar; virtual;π procedure NewWindow;π procedure HandleEvent( var Event: TEvent); virtual;π procedure Idle; virtual;π end;πππvar MyApp: TMyApp;π Lines: array [0..MaxLines-1] of PString;π LineCount: Integer;πππconstructor TInterior.Init(var Bounds: TRect; AHScrollbar, AVScrollbar: PScrollbar);π beginπ TScroller.Init(Bounds,AHScrollbar,AVScrollbar);π Growmode := gfGrowHiX + gfGrowHiY;π Options := Options or ofFramed;π SetLimit(128,LineCount);π end;πππprocedure TInterior.Draw;π var color: byte;π y,i: integer;π B: TDrawBuffer;ππ beginπ TScroller.Draw;π Color := GetColor($01);π for y:= 0 to Size.Y -1 doπ beginπ MoveChar(B,' ',Color,Size.X);π I := Delta.Y + Y;π if (I<Linecount) and (Lines[I] <> nil) thenπ MoveStr(B,Copy(Lines[I]^,Delta.X+1,size.x),Color);π WriteLine(0,y,size.x,1,B);π end;π end;πππprocedure ReadFile;π var F: text;π S: string;ππ beginπ LineCount:=0;π if paramcount = 0 thenπ assign(F,'clockwrk.pas')π elseπ assign(F,paramstr(1));π reset(F);π while not eof(F) and (linecount < maxlines) doπ beginπ readln(f,s);π Lines[Linecount] := NewStr(S);π Inc(LineCount);π end;π Close(F);π end;ππππππconstructor TDemoWindow.Init(WindowNo: Integer);π var LInterior, RInterior: PInterior;π HScrollbar, VScrollbar: PScrollbar;π R: TRect;π Center: integer;ππ beginπ R.Assign(0,0,40,15);π R.Move(Random(40),Random(8));ππ TWindow.Init(R, 'Window', wnNoNumber);π GetExtent(R);π Center:= (R.B.X + R.A.X) div 2;π R.Assign(Center,R.A.Y+1,Center+1,R.B.Y-1);π VScrollbar:= new(PScrollbar, Init(R));π with VScrollbar^ do Options := Options or ofPostProcess;π Insert(VScrollbar);π GetExtent(R);π R.Assign(R.A.X+2,R.B.Y-1,Center-1,R.B.Y);π HScrollbar:= new(PScrollbar, Init(R));π with HScrollbar^ do Options := Options or ofPostProcess;π Insert(HScrollbar);π GetExtent(R);π R.Assign(R.A.X+1,R.A.Y+1,Center,R.B.Y-1);π LInterior:= new(PInterior, Init(R, HScrollbar, VScrollbar));π with LInterior^ doπ beginπ Options:= Options or ofFramed;π Growmode:= GrowMode or gfGrowHiX;π SetLimit(128,LineCount);π end;π Insert(LInterior);ππ GetExtent(R);π R.Assign(R.B.X-1,R.A.Y+1,R.B.X,R.B.Y-1);π VScrollbar:= new(PScrollbar, Init(R));π with VScrollbar^ do Options := Options or ofPostProcess;π Insert(VScrollbar);π GetExtent(R);π R.Assign(Center+2,R.B.Y-1,R.B.X-2,R.B.Y);π HScrollbar:= new(PScrollbar, Init(R));π with HScrollbar^ doπ beginπ Options := Options or ofPostProcess;π GrowMode:= GrowMode or gfGrowLoX;π end;π Insert(HScrollbar);π GetExtent(R);π R.Assign(Center+1,R.A.Y+1,R.B.X-1,R.B.Y-1);π RInterior:= new(PInterior, Init(R, HScrollbar, VScrollbar));π with RInterior^ doπ beginπ Options:= Options or ofFramed;π Growmode:= GrowMode or gfGrowLoX;π SetLimit(128,LineCount);π end;π Insert(RInterior);π end;πππππprocedure TMyApp.InitStatusLine;π var R: TRect;ππ beginπ GetExtent(R); { find out how big the current view is }π R.A.Y := R.B.Y-1; { squeeze R down to one line at bottom of frame }π StatusLine := New(PStatusline, Init(R,π NewStatusDef(0, $FFFF,π NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,π NewStatusKey('~F4~ New', kbF4, cmNewWin,π NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,π nil))),π nil)π ));π end;πππ{ *** The vvv below indicate the primary hook-up point for the menubar-clock.π This programmer-defined normal menu structure will be tacked onto theπ end of the clock menubar in TClockMenu.Init.π}ππprocedure TMyApp.InitMenuBar;π var R: TRect;ππ beginπ GetExtent(R); {***}π r.b.y:= r.a.y+1; { vvv }π Menubar := New(PClockMenu, Init(R, NewMenu(π NewSubMenu('~F~ile', hcNoContext, NewMenu(π NewItem('~O~pen','F3', kbF3, cmFileOpen, hcNoContext,π NewItem('~N~ew','F4', kbF4, cmNewWin, hcNoContext,π NewLine(π NewItem('E~x~it','Alt-X', kbAltX, cmQuit, hcNoContext,π nil))))),π NewSubMenu('~W~indow', hcNoContext, NewMenu(π NewItem('~N~ext','F6', kbF6, cmNext, hcNoContext,π NewItem('~Z~oom','F7', kbF7, cmZoom, hcNoContext,π nil))),π nil)) { one ) for each menu defined }π )));π end;πππprocedure TMyApp.NewWindow;π varπ Window: PDemoWindow;π R: TRect;ππ beginπ inc(WinCount);π Window:= New(PDemoWindow, Init(WinCount));π Desktop^.Insert(Window);π end;πππππ{*** clock hook-up point - typecasting required to access "new" method }ππprocedure TMyApp.Idle;π beginπ TApplication.Idle;π PClockMenu(MenuBar)^.Update;π end;πππππprocedure TMyApp.HandleEvent( var Event: TEvent);π beginπ TApplication.HandleEvent(Event);π if Event.What = evCommand thenπ beginπ case Event.Command ofπ cmNewWin: NewWindow;π else { case }π Exit;π end; { case }π ClearEvent(Event);π end; {if}π end;πππππππππbeginππreadfile;ππMyApp.Init;πMyApp.run;πMyApp.done;πend.π 33 08-26-9408:32ALL SWAG SUPPORT TEAM Change T.V. Colors SWAG9408 ?G 39 d program Color;ππ{$R color.res }ππusesπ WinProcs,π WinTypes,π WObjects;ππconstπ White = $00FFFFFF;π Black = $00000000;π LightGray = $00C0C0C0;π DarkGray = $00808080;π Cyan = $00FFFF00;π Magenta = $00FF00FF;π Yellow = $0000FFFF;π Red = $000000FF;π Green = $0000FF00;π Blue = $00FF0000;π LightBlue = $00800000;π LightCyan = $00808000;π LightMagenta = $00800080;π Brown = $00008080;π LightRed = $00000080;π LightGreen = $00008000;ππconstπ id_Color = 101;ππtypeπ PColorDialog = ^TColorDialog;π TColorDialog = object(TDialog)π ColorPtr : ^longint;π constructor Init(AParent : PWindowsObject; var AColor : longint);π procedure SetupWindow; virtual;π function CanClose : boolean; virtual;π procedure wmDrawItem(var Msg : TMessage); virtual wm_First+wm_DrawItem;π procedure wmMeasureItem(var Msg : TMessage); virtual wm_First+wm_MeasureItem;π end;ππconstructor TColorDialog.Init(AParent : PWindowsObject; var AColor : longint);πbeginπ TDialog.Init(AParent,'ColorDlg');π ColorPtr := @AColor;πend; { Init }ππprocedure TColorDialog.SetupWindow;πconstπ NColors = 16;π StdColors : array[1..NColors] of longint =π (White, Black, LightGray, DarkGray, Cyan, Magenta, Yellow, Red, Green,π Blue, LightBlue, LightCyan, LightMagenta, Brown, LightRed, LightGreen);ππ procedure SetupColors(ID : integer; Color : longint);π varπ i,Sel : integer;π beginπ Sel := -1;π for i := 1 to NColors do beginπ SendDlgItemMsg(ID,cb_AddString,0,StdColors[i]);π if StdColors[i] = Color then Sel := pred(i);π end;π if Sel = -1 then beginπ SendDlgItemMsg(ID,cb_AddString,0,Color);π Sel := NColors;π end;π SendDlgItemMsg(ID,cb_SetCurSel,Sel,0);π end; { SetupColors }ππbegin { SetupWindow }π TDialog.SetupWindow;π SetupColors(id_Color,ColorPtr^);πend; { SetupWindow }ππfunction TColorDialog.CanClose : boolean;ππ procedure GetCol(ID : integer; var Color : longint);π varπ Sel : integer;π beginπ Sel := SendDlgItemMsg(ID,cb_GetCurSel,0,0);π if Sel > -1 thenπ SendDlgItemMsg(ID,cb_GetLBText,Sel,longint(@Color));π end; { GetCol }ππbegin { CanClose }π GetCol(id_Color,ColorPtr^);π CanClose := true;πend; { CanClose }πππprocedure TColorDialog.wmDrawItem(var Msg : TMessage);πvarπ Brush : HBrush;πbeginπ with PDrawItemStruct(Msg.lParam)^ do beginπ if CtlType = odt_ComboBox then beginπ if ((ItemAction and oda_DrawEntire) <> 0) orπ ((ItemAction and oda_Select) <> 0) then beginπ Brush := CreateSolidBrush(ItemData);π FillRect(hDC,rcItem,Brush);π DeleteObject(Brush);π end;π if ((ItemState and ods_Focus) <> 0) orπ ((ItemState and ods_Selected) <> 0) then beginπ InflateRect(rcItem,-2,-2);π DrawFocusRect(hDC,rcItem);π end;π end;π end;πend; { wmDrawItem }ππprocedure TColorDialog.wmMeasureItem(var Msg : TMessage);πbeginπ PMeasureItemStruct(Msg.lParam)^.ItemHeight := 16;πend; { wmMeasureItem }ππconstπ cm_Color = 100;ππtypeπ PColorWindow = ^TColorWindow;π TColorWindow = object(TWindow)π Color : longint;π constructor Init;π procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;π procedure CMColor(var Msg: TMessage);π virtual cm_First + cm_Color;π end;ππconstructor TColorWindow.Init;πbeginπ Color := White;π TWindow.Init(nil, 'Color Combo Demo');π Attr.Menu := LoadMenu(HInstance, 'Menu');πend; { Init }ππprocedure TColorWindow.cmColor(var Msg: TMessage);πbeginπ if Application^.ExecDialog(π New(PColorDialog,Init(@Self,Color))) = id_Ok thenπ InvalidateRect(HWindow,nil,true);πend; { cmColor }ππprocedure TColorWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);πvarπ Brush : HBrush;πbeginπ Brush := CreateSolidBrush(Color);π FillRect(PaintDC,PaintInfo.rcPaint,Brush);π DeleteObject(Brush);πend; { Paint }ππtypeπ TColorApp = object(TApplication)π procedure InitMainWindow; virtual;π end;ππprocedure TColorApp.InitMainWindow;πbeginπ MainWindow := New(PColorWindow,Init);πend; { InitMainWindow }ππvarπ ColorApp: TColorApp;ππbeginπ ColorApp.Init('Menu');π ColorApp.Run;π ColorApp.Done;πend.ππ{ ------------------------- COLOR.RES ----------------------- }ππ{ USE XX3402 to decode the following block }π{ Cut out and name COLOR.XX. Use XX3402 d COLOR.XX to create COLOR.RES }ππ{ ------------------------ CUT -----------------------------}ππ*XX3402-000206-140792--72--85-25021-------COLOR.RES--1-OF--1πzkE+HIJCJE+k2+w+++++++++U+-Y+0N1PqljQU1z-E-1HolDIYFAFk+k25I+++1++AW+-3Q+π7U-l+2s+++-1O4xjQqIUMqxgPr6+0+-6NKlq++Q+0E+M++c+zzw+++-EUYBjP4xmCU++6++4π+-s+D+-Z+-A+6J03++-4++M+6k+A++2++E+-I6-DOk++FU+N+0A+1++0+++++J0+Eq3iMqJgπ++1z1k1z+E+k2-s++++A++E++M++HIJCJE+E++I++c++EoxAHp72H2Q+++++π***** END OF BLOCK 1 *****ππ