Category : Pascal Source Code
Archive   : OOPWIN.ZIP
Filename : OWWIND.PAS
{ Copyright (c) 1989 by Micro System Solutions }
{$A+ align on word boundry}
{$B- short circuit boolean evaluation}
{$E+ coprocessor emulation on}
{$F+ force far calls on - this is used for pick window }
{$I- disable IO checking}
{$N- do real-type calcs in software}
{$O+ enable overlay code generation - used if overlays used }
{$R- disable range checking}
{$S- disable stack overflow checking}
{$V- disable variable checking}
unit OWWind;
{ Define and manipulate the file OOP window }
interface
uses
TPCrt,
TPDOS,
ColorDef,
TPInLine,
TPString,
TPEdit,
TPPick,
TPWindow,
TPVarray,
DMVars;
type
Location = object
XLow, YLow,
XHigh, YHigh: Integer;
procedure Init(InitXLow, InitYLow,
InitXHigh, InitYHigh : Integer);
function GetX : Integer;
function GetY : Integer;
end;
KpWndwPtr = ^OOPWindow;
OOPWindow = object (Location)
Changed, { if OOP entries were modified }
Visible: Boolean; { if OOP window is displayed }
KpWndwWindowAttr, { window color attributes }
KpWndwFrameAttr,
KpWndwHeaderAttr: byte;
constructor Init( InitXLow, InitYLow,
InitXHigh, InitYHigh: Integer;
WColor, FColor, HColor: byte;
OOPFile: fileStr);
destructor Done; virtual;
procedure ShowWindow; virtual;
function WildSearch(wStr: FileStr): boolean; virtual;
end;
implementation
const
NumOOPFiles = 16; { only allow 16 OOP files }
KPColors: PickColorArray = ( WhiteOnRed, { unselected item color }
WhiteOnRed, { frame color }
WhiteOnRed, { title color }
YellowOnBlack, { selected item color }
WhiteOnLtGray, { alternate unselected }
YellowOnLtGray); { alternate selected }
var
row, { selected row in pick window }
choice: word; { pick choice }
OOPFileRecord: FileStr; { this is the array record image }
KpWndw: WindowPtr; { TPro Window Pointer }
KpArray: TpArray; { OOP array for file names }
{--------------------------------------------------------}
{ Location's method implementations: }
{--------------------------------------------------------}
procedure Location.Init(InitXLow, InitYLow, InitXHigh, InitYHigh : Integer);
begin
XLow := InitXLow; { initial window position }
YLow := InitYLow; { upper left corner }
XHigh := InitXHigh; { lower }
YHigh := InitYHigh; { right corner }
end;
function Location.GetX : Integer;
begin
GetX := XLow;
end;
function Location.GetY : Integer;
begin
GetY := YLow;
end;
{--------------------------------------------------------}
{ OOPWindows's method implementations: }
{--------------------------------------------------------}
constructor OOPWindow.Init(InitXLow, InitYLow, InitXHigh, InitYHigh : Integer;
WColor, FColor, HColor: byte;
OOPFile: fileStr);
const
ClearValue: string[12] = ' - blank - '; { initailize to spaces }
begin
Location.Init( InitXLow,
InitYLow,
InitXHigh,
InitYHigh); { initialize window location }
Visible := False; { the window is not visible }
KpWndwWindowAttr := WColor; { set window colors }
KpWndwFrameAttr := FColor;
KpWndwHeaderAttr := HColor;
if existFile(OOPFile) then
LoadA(KpArray, OOPFile, 250) { load OOP file }
else begin { allocate space for 16 expanded wild card filenames }
MakeA(KpArray, 16, 1, sizeof(FileStr), OOPFile, 250);
ClearA(KpArray, ClearValue, ExactInit); { initialize }
end;
end;
destructor OOPWindow.Done;
begin { dispose of OOP array if it was ever created }
if not changed then exit;
StoreA(KpArray); { close the array, save the file }
end;
function GetwildCard(wStr: filestr): filestr;
var
point: byte; { location of period in filename }
filName: string[8]; { 8 char filename only }
extname: string[3]; { 3 char extension only }
begin
if wStr = '' then begin { null means everything }
GetWildCard := '????????.???';
exit;
end;
point := pos('.',wStr); { find separator of filename extension}
extName := pad(justExtension(wStr),3); { remove extension }
if point > 0 then { if extension is present }
filName := copy(wStr,1,pred(point)) { unpack the file name }
else { - else - }
filName := copy(wStr,1,8); { nothing to separate }
if pos('*', filName) > 0 then begin { if filename contains an * }
delete(filName, pos('*', filName), length(filName)); { clear everything after * }
filName := padch(filName,'?', 8); { and pad with ?'s }
end;
if pos('*', extName) > 0 then begin { then do the same with extension }
delete(extName, pos('*', extName), length(extName)); { clear everything after * }
extName := padch(extName,'?', 3); { adn pad with ?'s }
end;
GetWildCard := filName + '.' + extName;
end;
function OOPFiles(Item: Word): string;
begin { return each expanded file entry }
RetA(KpArray, Item-1, 0, OOPFileRecord); { Get the requested file mask }
OOPFiles := OOPFileRecord;
end;
procedure OOPWindow.ShowWindow;
var
escaped: boolean;
begin { create the window and set visible flag }
Visible := True; { window will be visible }
if not MakeWindow(KpWndw, XLow, YLow, XHigh, YHigh,
true, true, false,
KPColors[WindowAttr],
KPColors[FrameAttr],
KPColors[HeaderAttr],
'OOP Files') then exit; { make the window }
Choice := 1; { initiate choice }
Row := 1; { and row }
FillPickWindow(KpWndw, @OOPFiles, NumOOPFiles,
KPColors, Choice, Row); { fill the window }
repeat
PickBar(KPWndw, @OOPFiles, NumOOPFiles,
KPColors, false,
Choice, Row); { select an entry }
if PickCmdNum = PKSSelect then begin
WindowRelative := true; { input is inside window bounds }
forceUpper := true; { files are all upper case }
houseCursorAtEnd := false; { don't extend entry box }
ReadString('', Row, 1, sizeof(FileStr)-1,
KpColors[AltHigh],KpColors[AltHigh],KpColors[AltHigh],
escaped, OOPFileRecord);
if not escaped then begin { expand wildcard and store in array }
OOPFileRecord := GetWildCard(OOPFileRecord);
SetA(KpArray, Choice-1, 0, OOPFileRecord);
end;
end;
until PickCmdNum <> PKSSelect;
DisposeWindow(EraseTopWindow); { remove the window }
end;
function OOPWindow.WildSearch(wStr: FileStr): boolean;
var
KR, i, j: byte;
ext: string[3];
found: boolean;
posit: byte;
begin
found := false;
KR := 0;
repeat
RetA(KpArray, KR, 0, OOPFileRecord); { return an array record }
posit := pos('.', OOPFileRecord); { position of extension . }
i := 1;
repeat
if (wStr[i] = '.') {test end of filename }
and (OOPFileRecord[i] = '.') then i := 8
else
if (OOPFileRecord[i] = '?')
or (OOPFileRecord[i] = wStr[i]) then
found := true { compares so far - }
else { no compare - }
found := false; { terminate check }
inc(i);
until (not found) or (i > 8);
if found = true then begin { compare extension }
ext := pad(justExtension(wStr),3); { extract extension }
j := 1;
repeat
if (OOPFileRecord[j+posit] = '?')
or (OOPFileRecord[j+posit] = Ext[j]) then
found := true { compares so far - }
else { no compare - }
found := false; { terminate check }
inc(j);
until (not found) or (j > 3);
end;
if found then begin { exit if found }
WildSearch := true; { check no more entries }
exit;
end;
inc(KR); { to next array }
until KR = NumOOPFiles; { to maximum }
WildSearch := found;
end;
{ No initialization section }
end.
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/