home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Boston 2
/
boston-2.iso
/
DOS
/
PROGRAM
/
PASCAL
/
OPPOWIN
/
OPPOPWIN.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-12-01
|
31KB
|
868 lines
Unit OpPopWin;
{$I OPDEFINE.INC}
{ ***************************************************************************
* *
* POPWINDOW Version 1.0 *
* Dated : 03/06/92 *
* Author : Hans Otten *
* *
* The latest version, allong with the author, can always *
* be found at the LONDON PC USERS GROUP BBS (519-472-9471) *
* *
************************************************************************** }
Interface
Uses OpCrt,
OpRoot,
{$IFDEF UseMouse}
OpMouse,
{$ENDIF}
OpCmd,
OpFrame,
OpWindow,
OpString,
OpKey,
OpInline;
Const
KeyMax = 120; { Maximum # of keys in keyset }
MaxNumPicks = 20; { Maximum number of selections in one menu }
MaxTopicLen = 80; { Maximum length of each topic }
ccScrollWin = ccUser50; { Command to allow window to move }
ppStick = $0001; { Stick on menu selections. }
ppCapitalize = $0002; { Capitalize the current highlighted menu choice }
ppUseLetters = $0004; { Use letters as selection choice, else use numbers }
ppAllowEsc = $0008; { Allow the user to exit the menu by pressing ESC }
DefPopWindowOptions = 0; { Default window options }
Ident : String[15] = 'Popwin Key Set';
KeySet : Array[0..KeyMax] of Byte = (
{ Length Keys Command Type Key sequence }
3, $00, $48, ccUp, { Up arrow }
3, $00, $50, ccDown, { Down Arrow }
3, $00, $4B, ccLeft, { Left Arrow }
3, $00, $4D, ccRight, { Right Arrow }
3, $00, $47, ccHome, { Home }
3, $00, $49, ccPageUp, { PgUp }
3, $00, $4F, ccEnd, { End }
3, $00, $51, ccPageDn, { PgDn }
3, $00, $52, ccIns, { Ins }
3, $00, $53, ccDel, { Del }
2, $09, ccTab, { Tab }
2, $0D, ccSelect, { Enter }
2, $1B, ccQuit,
3, $00, $3B, ccHelp, {F1}
3, $00, $3F, ccScrollWin, {Scroll lock}
{$IFDEF UseMouse}
3, $00, $EF, ccMouseSel, {click left = mouse select}
{$ELSE}
0, 0, 0, 0,
{$ENDIF}
0,0,0,0,0,0,0,0,0,0, {70}
0,0,0,0,0,0,0,0,0,0, {80}
0,0,0,0,0,0,0,0,0,0, {90}
0,0,0,0,0,0,0,0,0,0, {100}
0,0,0,0,0,0,0,0,0,0, {110}
0,0,0,0,0,0,0,0,0,0); {120}
CfgEnd : Byte = 0;
AllowSet : Array[1..2] of Set of Char =
(['1','2','3','4','5','6','7','8','9'],
['A'..'Z']);
PopWindowFrame : FrameArray = '▀'+' '+'▀'+' '+
'▀'+' '+' '+' ';
Type
TopicRec = Record { Record of each topic }
Name : String[MaxTopicLen];
Selected : Boolean;
Id : Byte;
End;
PopWindowPtr = ^PopWindow;
PopWindow =
Object(CommandWindow)
Options : Word; {Global options }
XTop, { Menu coordinates }
YTop,
XBottom,
YBottom : Byte;
Header1, { Top header # 1 }
Header2 : String[40]; { Top Header # 2 }
TextColor, { Color of normal text }
TextMono, { Mono color of normal text }
HeaderColor, { Color of header text }
HeaderMono, { Mono color of header text }
FrameColor, { Color of outside frame }
FrameMono, { Mono color of outside frame }
ChoiceColor, { Color of current choice }
ChoiceMono, { mono color of current choice }
HighLightColor, { Color of highlight option }
HighLightMono : Byte; { Mono color of highlight option }
DefaultSet : Byte; { 1 = Number's 1 thru 9, 2 = A .. T }
Headers : Byte; { Number of headers in use }
Choice : Byte; { The current highlighted choice }
MaxPicks : Byte; { Number of topics in menu }
Topics : Array[1..MaxNumPicks] of TopicRec;{ Menu record }
PadLen : Byte; { Size of left margin (minimun = 3) }
Selector : Char; { The selector character in left margin }
Function GetTopicNum(TopicId : Byte) : Byte;
{Get the physical location in the array based on topic ID }
Function GetTopicId(TopicNum : Byte) : Byte;
{ Get the Id of the physical location TOPICNUM in the array }
Constructor Init(X1, Y1, X2, Y2:Byte; NumHeaders : Byte; Var Colors : ColorSet);
{ The constructor to initialize the object }
Function AdjustMenu : Boolean;
{ This procedure will grow, or shrink, the menu (INTERNAL) }
Procedure AddHeaders(H1,H2 : String);
{ Add headers to the menu }
Procedure AddTopic(TopicName : String; TopicId : Byte);
{ Add a new menu topic }
Procedure SetDefaultChoice(TopicId : Byte);
{ Set the default choice to start on }
Function GetLastChoice : Byte;
{ Return the last selection by user, returns the choice ID}
Function GetMaxChoices : Byte;
{ Return total number of entries in menu }
Procedure GetCoordinates(Var X1, Y1, X2, Y2 : Byte);
{ Get the coordinates of the menu }
Procedure SetPadLength(Len : Byte);
{ Set the length of the left margin }
Procedure SetSelectorChar(CH : Char);
{ Set the selector character }
Function ppOptionsAreOn(SelOptions : Word) : Boolean;
{ Determine what options are turned on }
Procedure ppOptionsOn(SelOptions : Word);
{ Turn selected option(s) on }
Procedure ppOptionsOff(SelOptions : Word);
{ Turn selected option(s) off }
Procedure ScrollWindow(XT,YT,XB,YB : Byte);
{ Move the menu to another location, within the defined boundaries }
Procedure Redraw(LNum : Byte);
{ Redraw a menu option (internal) }
Procedure ChangeTopic(TopicNum : Byte; NewTopic : String; RedrawMenu : Boolean);
{ Change the topic entry }
Procedure RemoveTopic(TopicNum : Byte; MoveRemaining : Boolean);
{ Remove a topic and redraw the screen }
Procedure SwitchTopics(Topic1, Topic2 : Byte);
{ Procedure swith the topic entries for 2 topics }
Procedure Draw; Virtual;
{ Draw the menu }
Procedure Process; Virtual;
{ Process the menu commands }
End;
Var
PopCommands : CommandProcessor;
Implementation
Function PopWindow.GetTopicNum(TopicId : Byte) : Byte;
{ ***************************************************************************
Get the phisical location of a topic Id in the array, Returns 0 if TopicID
not found, else the location number.
*************************************************************************** }
Var i : Integer;
Found : Boolean;
Begin
i := 1;
Found := False;
While (i <= MaxPicks) and (Not Found) do
Begin
If (Topics[i].ID = TopicId) then
Found := True
Else
Inc(i);
End;
If Found then
GetTopicNum := i
Else
GetTopicNum := 0;
End;
Function PopWindow.GetTopicId(TopicNum : Byte) : Byte;
{ ***************************************************************************
Get the Id of the physical location TOPICNUM in the array.
*************************************************************************** }
Begin
If (TopicNum > 0) and (TopicNum <= MaxPicks) then
GetTopicId := Topics[TopicNum].Id
Else
GetTopicId := 0;
End;
Constructor PopWindow.Init(X1, Y1, X2, Y2:Byte; NumHeaders : Byte; Var Colors : ColorSet);
{ ***************************************************************************
Initialize the Pop up menu
*************************************************************************** }
Begin
Headers := NumHeaders;
If Headers > 2 then { No more than two headers can be initialized at once }
Headers := 2;
If Headers < 0 then
Headers := 0;
{ Initialize the command window }
If Not CommandWindow.InitCustom( X1, Y1+Headers, X2, Y2, { Window Coordinates }
Colors,
wBordered+WClear+WSaveContents,
PopCommands,
ucNone) then Fail;
{ Set the frame type and add a span header if there are any headers }
WFrame.SetFrameType(PopWindowFrame);
AdjustFrameCoords(X1-1,Y1-1-Headers,X2+1,Y2+1);
If (NumHeaders > 0) then
WFrame.AddSpanHeader('─','─','─',1+Headers,frTT);
{ Read the appropriate values from colors into the object }
TextColor := Colors.TextColor;
TextMono := Colors.TextMono;
HeaderColor := Colors.PromptColor;
HeaderMono := Colors.PromptMono;
FrameColor := Colors.FrameColor;
FrameMono := Colors.FrameMono;
ChoiceColor := Colors.HighItemColor;
ChoiceMono := Colors.HighItemMono;
HighLightColor:= Colors.HighLightColor;
HighLightMono := Colors.HighLightMono;
{ Read the coordinates in }
XTop := X1;
XBottom := X2;
YTop := Y1+Headers;
YBottom := Y2;
MaxPicks := 0;
Options := DefPopWindowOptions;
{ Set default startup values }
FillChar(Topics,SizeOf(Topics),0);
PadLen := 5;
Selector := #16;
Choice := 1;
DefaultSet := 2;
End;
Procedure PopWindow.AddHeaders(H1,H2 : String);
{ ***************************************************************************
Add the header strings to the menu
*************************************************************************** }
Begin
Header1 := H1;
Header2 := H2;
End;
Function PopWindow.GetLastChoice : Byte;
{ ***************************************************************************
Return the last selected choice by the user
*************************************************************************** }
Begin
GetLastChoice := Topics[Choice].Id;
End;
Function PopWindow.GetMaxChoices : Byte;
{ ***************************************************************************
Return the total number of entries into PopWindow
*************************************************************************** }
Begin
GetMaxChoices := MaxPicks;
End;
Procedure PopWindow.GetCoordinates(Var X1, Y1, X2, Y2 : Byte);
{ ***************************************************************************
Return the coordinates of the window (Not the frame)
*************************************************************************** }
Begin
X1 := XTop;
Y1 := YTop;
X2 := XBottom;
Y2 := YBottom;
End;
Procedure PopWindow.SetPadLength(Len : Byte);
{ ***************************************************************************
Set the number of spaces to pad the beginning of each menu item. The
minimum setting is 4. If entries already exist then the menu will be
redrawn.
*************************************************************************** }
Var
i : Byte;
Begin
If Len < 4 then
PadLen := 4
Else
PadLen := Len;
If (MaxPicks > 0) then { Already have entries }
Begin
For i := 1 to MaxPicks do
ChangeTopic(i,Copy(Topics[i].Name,Pos('.',Topics[i].Name)+2,
Length(Topics[i].Name)-Pos('.',Topics[i].Name)+2),False);
If AdjustMenu then
Begin
End;
If IsCurrent then
Draw;
End;
End;
Procedure PopWindow.SetSelectorChar(CH : Char);
{ ***************************************************************************
Set the character used when the highlight bar is on
*************************************************************************** }
Begin
Selector := Ch;
If (MaxPicks > 0) then { Entries already exist, so change current one }
Redraw(Choice);
End;
Function PopWindow.AdjustMenu : Boolean;
{ ***************************************************************************
This internal procedure attempts to redraw the menu in order to make it
as tight as possible. If the function returns True, then some form of the
menu has been altered.
*************************************************************************** }
Var
Wid, { Calculated width's and hieghts }
Hig : Byte;
Changed : Boolean;
Procedure AdjustEntries;
{ This procedure checks to see if Default set has enough entries to accomidate
the picks, if it doesn't, then change defaultset and rewrite entries }
Var
i : Byte;
Begin
If (MaxPicks > 9) and (DefaultSet = 1) then { Change to Letter set }
Begin
DefaultSet := 2;
ppOptionsOn(ppUseLetters);
Changed := True;
For i := 1 to MaxPicks do
ChangeTopic(i,Copy(Topics[i].Name,Pos('.',Topics[i].Name)+2,
Length(Topics[i].Name)-Pos('.',Topics[i].Name)+2),False);
End;
End;
Procedure GetWidth;
Var i : Byte;
Begin
Wid := 0;
For i := 1 to MaxPicks do
Begin
If (Length(Topics[i].Name) > Wid) then
Wid := Length(Topics[i].Name);
end;
End;
Procedure GetHieght;
Var i : Byte;
Begin
Hig := MaxPicks;
End;
Begin
Changed := False;
AdjustEntries;
GetWidth;
GetHieght;
If ( Wid > (XBottom-XTop)) then
Begin
If ((XTop+Wid) <= ScreenWidth) then
Begin
XBottom := XTop + Wid;
AdjustWindow(XTop,YTop,XBottom,YBottom);
Changed := True;
End;
End;
If (Hig > (YBottom - YTop+1)) then
Begin
If ((YTop+Hig) <= ScreenHeight) then
Begin
YBottom := YTop + Hig;
AdjustWindow(XTop,YTop,XBottom,YBottom);
Changed := True;
End;
End;
AdjustMenu := Changed;
End;
Procedure PopWindow.AddTopic(TopicName : String; TopicID : Byte);
{ ***************************************************************************
This procedure adds a new topic to the menu, If the menu already exists,
then the window is redrawn
*************************************************************************** }
Function GetValue : Char;
Begin
If (DefaultSet = 1) and (MaxPicks < 9) then
GetValue := Char(Ord('1')-1+MaxPicks)
Else
GetValue := Char(Ord('A')-1+MaxPicks);
End;
Begin
If ppOptionsAreOn(ppUseLetters) then
DefaultSet := 2
Else
DefaultSet := 1;
If ((MaxPicks + 1) <= MaxNumPicks) then
Begin
Inc(MaxPicks);
Topics[MaxPicks].Name := Pad('',PadLen-3)+GetValue+'. '+
Pad(TopicName,XBottom-Xtop-PadLen);
If MaxPicks = Choice then
Topics[MaxPicks].Selected := True
Else
Topics[MaxPicks].Selected := False;
Topics[MaxPicks].ID := TopicId;
End;
If AdjustMenu and IsCurrent then
Draw;
End;
Procedure PopWindow.SetDefaultChoice(TopicId : Byte);
{ ***************************************************************************
Set the start up choice.
*************************************************************************** }
Var Sel : Byte;
Begin
Sel := GetTopicNum(TopicId);
If (Sel <= MaxPicks) and (Sel > 0) then
Begin
Topics[Choice].Selected := False;
Choice := Sel;
Topics[Choice].Selected := True;
End;
End;
Function PopWindow.ppOptionsAreOn(SelOptions : Word) : Boolean;
{ ***************************************************************************
Determine which options have been turned on
*************************************************************************** }
Begin
ppOptionsAreOn := FlagIsSet(Options,SelOptions);
End;
Procedure PopWindow.ppOptionsOn(SelOptions : Word);
{ ***************************************************************************
Turn certain options on
*************************************************************************** }
Begin
SetFlag(Options,SelOptions);
End;
Procedure PopWindow.ppOptionsOff(SelOptions : Word);
{ ***************************************************************************
Turn certain options off
*************************************************************************** }
Begin
ClearFlag(Options,SelOptions);
End;
Procedure PopWindow.Redraw(LNum : Byte);
{ ***************************************************************************
Write one menu option (LNum) to the screen (Internal)
*************************************************************************** }
Var TChar : Char;
Begin
If (LNum <= MaxPicks) then
Begin
With Topics[LNum] do
Begin
If Selected then
Begin
MoveFast(Selector,Name[2],1);
If ppOptionsAreOn(ppCapitalize) then
wFastWrite(StUpCase(Name),LNum,1,ColorMono(HighLightColor,HighLightMono))
Else
wFastWrite(Name,LNum,1,ColorMono(HighLightColor,HighLightMono));
End
Else
Begin
TChar := ' ';
MoveFast(TChar,Name[2],1);
wFastWrite(Name,LNum,1,ColorMono(TextColor,TextMono));
wChangeAttribute(3,LNum,PadLen-3,ColorMono(ChoiceColor,ChoiceMono));
End;
End;
End;
End;
Procedure PopWindow.ChangeTopic(TopicNum : Byte; NewTopic : String; RedrawMenu : Boolean);
{ ***************************************************************************
Change the name of a topic to NewTopic.
*************************************************************************** }
Function GetValue : Char;
Begin
If (DefaultSet = 1) and (MaxPicks < 9) then
GetValue := Char(Ord('1')-1+TopicNum)
Else
GetValue := Char(Ord('A')-1+TopicNum);
End;
Begin
If (TopicNum <= MaxPicks) and (TopicNum > 0) then
Begin
If ppOptionsAreOn(ppUseLetters) then
DefaultSet := 2
Else
DefaultSet := 1;
Topics[TopicNum].Name := Pad('',PadLen-3)+GetValue+'. '+
Pad(NewTopic,XBottom-Xtop-PadLen);
If RedrawMenu and IsCurrent then
Begin
If AdjustMenu then
Begin
End;
ActivateWrite;
Redraw(TopicNum);
DeActivateWrite;
End;
End;
End;
Procedure PopWindow.RemoveTopic(TopicNum : Byte; MoveRemaining : Boolean);
{ ***************************************************************************
This procedure removes a particular topic from the menu. MoveRemaining
will shift all remaining topics up one space and compress the menu.
*************************************************************************** }
Var i : Integer;
WasSelected : Boolean;
Begin
If (TopicNum <= MaxPicks) and (TopicNum > 0) then
Begin
WasSelected := Topics[TopicNum].Selected;
FillChar(Topics[TopicNum],SizeOf(Topics[TopicNum]),0);
If MoveRemaining then
Begin
For i := (TopicNum + 1) to MaxPicks do
Topics[i-1] := Topics[i];
FillChar(Topics[MaxPicks],SizeOf(Topics[MaxPicks]),0);
Dec(MaxPicks);
For i := 1 to MaxPicks do
ChangeTopic(i,Copy(Topics[i].Name,Pos('.',Topics[i].Name)+2,
Length(Topics[i].Name)-Pos('.',Topics[i].Name)+2),False);
End;
If TopicNum > MaxPicks then
Topics[MaxPicks].Selected := WasSelected
Else
Topics[TopicNum].Selected := WasSelected;
ActivateWrite;
For i := 1 to MaxPicks do
Redraw(i);
DeActivateWrite;
End;
End;
Procedure PopWindow.SwitchTopics(Topic1, Topic2 : Byte);
{ ***************************************************************************
Swith topic1 and topic2, redrawing the menu
*************************************************************************** }
Var i : Byte;
TTopic : TopicRec;
Begin
If (Topic1 <= MaxPicks) and (Topic2 <= MaxPicks)
and (Topic1 > 0) and (Topic2 > 0) then
Begin
TTopic := Topics[Topic1];
Topics[Topic1] := Topics[Topic2];
Topics[Topic2] := TTopic;
ActivateWrite;
For i := 1 to MaxPicks do
Redraw(i);
DeActivateWrite;
End;
End;
Procedure PopWindow.ScrollWindow(XT,YT,XB,YB:Byte);
{ ***************************************************************************
This procedure will scroll the window within the region specified using the
arrow keys
*************************************************************************** }
Var
Ch : Word;
Function CheckMove(Direction : Word) : Boolean;
Begin
CheckMove := False;
Case Direction of
Left : If (XTop-1 <= XT) then Exit;
Right : If (XBottom+1 >= XB) then Exit;
Up : If (YTop-1 <= YT) then Exit;
Down : iF (YBottom+1 >= YB) then Exit;
End;
CheckMove := True;
End;
Procedure MoveWin(Direction : Word);
Begin
If CheckMove(Direction) then
Begin
Case Direction of
Left : Begin
AdjustWindow(XTop-1,YTop,XBottom-1,YBottom);
Dec(XTop);
Dec(XBottom);
End;
Right : Begin
AdjustWindow(XTop+1,YTop,XBottom+1,YBottom);
Inc(XTop);
Inc(XBottom);
End;
Up : Begin
AdjustWindow(XTop,YTop-1,XBottom,YBottom-1);
Dec(YTop);
Dec(YBottom);
End;
Down : Begin
AdjustWindow(XTop,YTop+1,XBottom,YBottom+1);
Inc(YTop);
Inc(YBottom);
End;
End;
End;
End;
Begin
Repeat
Ch := ReadKeyWord;
Case Ch of
Left,Right,
Up,Down : MoveWin(Ch);
End;
Until (Ch = Enter) or (Ch = Esc);
End;
Procedure PopWindow.Draw;
{ ***************************************************************************
Draw the menu
*************************************************************************** }
Var i : Byte;
Begin
If AdjustMenu then
Begin
End;
CommandWindow.Draw;
ActivateWrite;
If (Headers > 0) then
fFastWrite(Center(Header1,(XBottom-XTop)),1,1,ColorMono(HeaderColor,HeaderMono));
If (Headers > 1) then
fFastWrite(Center(Header2,(XBottom-XTop)),2,1,ColorMono(HeaderColor,HeaderMono));
For i := 1 to MaxPicks do
Redraw(i);
DeActivateWrite;
End;
Procedure PopWindow.Process;
{ ***************************************************************************
Process all menu commands
*************************************************************************** }
Var TChar : Char;
Tsel : Byte;
Finished : Boolean;
Procedure MoveBar(Old,New : Byte);
Begin
Topics[Old].Selected := False;
Topics[New].Selected := True;
ActivateWrite;
ReDraw(Old);
Redraw(New);
DeActivateWrite;
Choice := New;
End;
{$IFDEF UseMouse}
Function CheckMouseMove : Boolean;
Var MX,MY : Byte;
Line : Byte;
Begin
CheckMouseMove := False;
MX := MouseWhereXAbs;
MY := MouseWhereYAbs;
If (MX >= XTop) and (MX <= XBottom) and (MY >= YTop) and (MY <= YBottom) then
Begin
Line := MY - YTop +1;
If (Line >= 1) and (Line <= MaxPicks) then
Begin
If (Not ppOptionsAreOn(ppStick)) then
Begin
MoveBar(Choice,Line);
CheckMouseMove := True;
End
Else
Begin
If Line = Choice then
CheckMouseMove := True
Else
MoveBar(Choice,Line);
End;
End;
End;
End;
{$ENDIF}
Begin
HiddenCursor;
{$IFDEF UseMouse}
If PopCommands.MouseEnabled then
ShowMouse;
{$ENDIF}
Finished := False;
Repeat
GetNextCommand;
Case GetLastCommand of
ccUp : Begin
If (Choice = 1) then
Begin
If (Not ppOptionsAreOn(ppStick)) then
MoveBar(Choice,MaxPicks);
End
Else
MoveBar(Choice,Choice-1);
End;
ccDown : Begin
If (Choice = MaxPicks) then
Begin
If (Not ppOptionsAreOn(ppStick)) then
MoveBar(MaxPicks,1);
End
Else
MoveBar(Choice,Choice+1);
End;
{$IFDEF UseMouse}
ccMouseSel : Begin
If PopCommands.MouseEnabled then
Finished := CheckMouseMove;
End;
{$ENDIF}
ccPageUp : MoveBar(Choice,1);
ccPageDn : MoveBar(Choice,MaxPicks);
ccSelect : Finished := True;
ccScrollWin : ScrollWindow(1,1,80,24);
ccChar : Begin
TChar := UpCase(Char(Lo(GetLastKey)));
If (TChar in AllowSet[DefaultSet]) then
Begin
If (DefaultSet = 1) then
TSel := Ord(TChar) - Ord('1') + 1
Else
TSel := Ord(TChar) - Ord('A') + 1;
If (TSel <= MaxPicks) then
Begin
MoveBar(Choice,TSel);
If (not ppOptionsAreOn(ppStick)) then
Finished := True
Else
Finished := False;
End;
End;
End;
ccQuit : If ppOptionsAreOn(ppAllowEsc) then
Finished := True
Else
Begin
Finished := False;
MoveBar(Choice,MaxPicks);
End;
End;
Until (Finished) or (GetLastCommand = ccError);
NormalCursor;
End;
Begin
PopCommands.Init(@KeySet,KeyMax);
End.