ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/TOTSRC.ZIP/TOTMSG.PAS

Pascal/Delphi Source File | 1991-02-10 | 13.2 KB | 519 lines

{               Copyright 1991 TechnoJock Software, Inc.               }
{                          All Rights Reserved                         }
{                         Restricted by License                        }

{                             Build # 1.00                             }

Unit totMSG;
{$I TOTFLAGS.INC}

{
 Development Notes:

}

INTERFACE

uses DOS, CRT, totSYS, totINPUT, totFAST, totIO1, totWIN, totSTR;

CONST
   MaxButtons = 10;

TYPE
MsgNodePtr = ^MsgNode;
MsgNode = record
   Txt : pointer;
   Next: MsgNodePtr;
end; {MsgNode}

ButtonDetails = record
  Txt: stringbut;
  Code: tAction;
  HK: word;
  Len : byte;
end; {ButtonDetails}

pBaseMessageOBJ = ^BaseMessageOBJ;
BaseMessageOBJ = object
   vTxtStack: MsgNodePtr;
   vManager: WinFormOBJ;
   vTotLines: byte;
   vStyle: byte;
   vWidth : byte;
   vButtonDepth: byte;
   vMinWidth: byte;
   vTotButtons: byte;
   vButtons: array[1..MaxButtons] of pItemIOOBJ;
   {methods ...}
   constructor Init(Style:byte;Tit:string);
   procedure   AddLine(Str:string);
   function    MsgTxt(LineNo:byte): string;
   function    WinForm: WinFormPtr;
   procedure   AssignButton(var Button:ItemIOOBJ);
   procedure   CalcSize;
   function    Show: tAction;
   destructor  Done;                                     VIRTUAL;
end; {BaseMessageOBJ}

pMessageOBJ = ^MessageOBJ;
MessageOBJ = object (BaseMessageOBJ)
   vButtonText : stringbut;
   vButtonHK: word;
   {methods ...}
   constructor Init(Style:byte;Tit:string);
   procedure   SetOption(Str:string;Hotkey:word);
   procedure   Show;
   destructor  Done;                                     VIRTUAL;
end; {MessageOBJ}

pButtonMessageOBJ = ^ButtonMessageOBJ;
ButtonMessageOBJ = object (MessageOBJ)
   {methods ...}
   constructor Init(Style:byte;Tit:string);
   procedure   Show;
   destructor  Done;                                     VIRTUAL;
end; {ButtonMessageOBJ}

pPromptOBJ = ^PromptOBJ;
PromptOBJ = object (BaseMessageOBJ)
   vButtonInfo : array [1..3] of ButtonDetails;
   vTotPrompts: byte;
   {methods ...}
   constructor Init(Style:byte;Tit:string);
   procedure   SetOption(ID:byte; Str:stringbut;HotKey:word; Act:tAction);
   procedure   LoadButtonRecord(Rec:byte;Str:stringbut;Hotkey:word;Act:tAction);
   function    Show: tAction;
   destructor  Done;                                     VIRTUAL;
end; {PromptOBJ}

pButtonPromptOBJ = ^ButtonPromptOBJ;
ButtonPromptOBJ = object (promptOBJ)
   {methods ...}
   constructor Init(Style:byte;Tit:string);
   function    Show: tAction;
   destructor  Done;                                     VIRTUAL;
end; {ButtonPromptOBJ}

procedure MsgInit;

IMPLEMENTATION

{|||||||||||||||||||||||||||||||||||||||||||||||||||}
{                                                   }
{    B a s e M e s s a g e O B J   M E T H O D S    }
{                                                   }
{|||||||||||||||||||||||||||||||||||||||||||||||||||}
constructor BaseMessageOBJ.Init(Style:byte;Tit:string);
{}
begin
   vTotLines := 0;
   vStyle := Style;
   vTxtStack := Nil;
   vWidth := length(Tit) + 10;
   vMinWidth := 10;
   vTotButtons := 0;
   vButtonDepth := 1;
   with vManager do
   begin
      Init;
      Win^.SetTitle(Tit);
   end;
end; {BaseMessageOBJ.Init}

procedure BaseMessageOBJ.AddLine(Str:string);
{}
var L : byte;
    Temp: MsgNodePtr;
begin
   L := succ(length(Str));
   if vTxtStack = Nil then
   begin
      getmem(vTxtStack,sizeof(vTxtStack^));
      vTxtStack^.Next := nil;
      if Str <> '' then
      begin
         getmem(vTxtStack^.Txt,L);
         move(Str[0],vTxtStack^.Txt^,L);
      end
      else
         vTxtStack^.Txt := nil;
   end
   else
   begin
      Temp := vTxtStack;
      while Temp^.Next <> nil do
         Temp := Temp^.Next;
      getmem(Temp^.Next,sizeof(Temp^.Next^));
      Temp := Temp^.Next;
      Temp^.Next := nil;
      if Str <> '' then
      begin
         getmem(Temp^.Txt,L);
         move(Str[0],Temp^.Txt^,L);
      end
      else
         Temp^.Txt := nil;
   end;
   inc(vTotLines);
end; {BaseMessageOBJ.AddLine}

function BaseMessageOBJ.MsgTxt(LineNo:byte): string;
{}
var
   Temp: MsgNodePtr;
   I:integer;
   L : byte;
   Str: string;
begin
   Temp := vTxtStack;
   for I := 2 to LineNo do
      if Temp <> nil then
         Temp := Temp^.Next;
   if (Temp <> Nil) and (Temp^.Txt <> nil) then
   begin
      move(Temp^.Txt^,L,1);
      move(Temp^.Txt^,Str[0],succ(L));
   end
   else
      Str := '';
   MsgTxt := Str;
end; {BaseMessageOBJ.MsgTxt}

procedure BaseMessageOBJ.AssignButton(var Button:ItemIOOBJ);
{}
begin
   if vTotButtons < MaxButtons then
   begin
      inc(vTotButtons);
      vButtons[vTotButtons] := @Button
   end;
end; {BaseMessageOBJ.AssignButton}

procedure BaseMessageOBJ.CalcSize;
{}
var
   X1,Y1,X2,Y2: shortint;
   Height: byte;
   I : integer;
   Str : string;
begin
   for I := 1 to vTotLines do
   begin
      Str := MsgTxt(I);
      if length(Str) > vWidth then
         vWidth := length(Str);
   end;
   if vWidth < vMinWidth then
      vWidth := vMinWidth
   else if vWidth > 80 then
      vWidth := 76;
   if (vStyle <> 0) then
      vWidth := vWidth + 2;
   X1 := (Monitor^.Width - vWidth) div 2;
   X2 := X1 + pred(vWidth);
   case vStyle of
      0: Height := vTotLines;
      6: Height := vTotLines + 3;
      else Height := vTotLines + 2;
   end; {case}
   inc(Height,succ(vButtondepth));
   Y1 := (Monitor^.Depth - Height) div 2;
   Y2 := Y1 + pred(Height);
   vManager.Win^.SetSize(X1,Y1,X2,Y2,vStyle);
end; {BaseMessageOBJ.CalcSize}

function BaseMessageOBJ.Show:tAction;
{}
var
   I : integer;
   S : string;
begin
   for I := 1 to vTotButtons do
      vManager.AddItem(vButtons[I]^);
   vManager.Draw;
   for I := 1 to vTotLines do
   begin
      S := MsgTxt(I);
      if S <> '' then
         case S[1] of
            '^': begin
               delete(S,1,1);
               Screen.WriteCenter(I,vManager.Win^.GetBodyAttr,S);
            end;
            '"': begin
               delete(S,1,1);
               Screen.WriteRight(vWidth - 2*ord(vStyle<>0),I,
                                 vManager.Win^.GetBodyAttr,S);
            end;
            else   Screen.WritePlain(1,I,S);
         end;  {case}
   end;
   Show := vManager.Go;
   delay(100);
   vManager.Done;
end; {BaseMessageOBJ.Show}

function BaseMessageOBJ.WinForm: WinFormPtr;
{}
begin
   WinForm := @vManager;
end; {BaseMessageOBJ.WinForm}

destructor BaseMessageOBJ.Done;
{}
var
  L: byte;
  TempA,TempB: MsgNodePtr;
  I : integer;
begin
   TempA := vTxtStack;
   while TempA <> nil do
   begin
       TempB := TempA;
       TempA := TempB^.Next;
       if TempB^.Txt <> Nil then
       begin
          move(TempB^.Txt^,L,1);
          freemem(TempB^.Txt,succ(L)); {dispose of text}
       end;
       freemem(TempB,sizeof(tempB^));
   end;
end; {BaseMessageOBJ.Done}
{||||||||||||||||||||||||||||||||||||||||||||}
{                                            }
{     M e s s a g e O B J   M E T H O D S    }
{                                            }
{||||||||||||||||||||||||||||||||||||||||||||}
constructor MessageOBJ.Init(Style:byte;Tit:string);
{}
begin
   BaseMessageOBJ.Init(Style,Tit);
   vButtonText := '  ~O~K  ';
   vButtonHK :=  79;
end; {MessageOBJ.Init}

procedure MessageOBJ.SetOption(Str:string;HotKey: word);
{}
begin
   vButtonText := Str;
   vButtonHK := HotKey;
end; {MessageOBJ.SetOptionText}

procedure MessageOBJ.Show;
{}
var
   OK: Strip3dIOOBJ;
   EscHK: HotKeyIOOBJ;
   HK: HotKeyIOOBJ;
   TempAct: tAction;
begin
   vMinWidth := length(vButtonText) + 4;
   CalcSize;
   OK.Init((vWidth - length(vButtonText))div 2 ,succ(vTotLines),vButtonText,Finished);
   EscHK.Init(27,Finished);
   OK.SetHotkey(vButtonHK);
   AssignButton(OK);
   AssignButton(EscHK);
   TempAct := BaseMessageOBJ.Show;
   OK.Done;
   EscHK.Done;
end; {MessageOBJ.Show}

destructor MessageOBJ.Done;
{}
begin
   BaseMessageOBJ.Done
end; {MessageOBJ.Done}
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{                                                        }
{     B u t t o n M e s s a g e O B J   M E T H O D S    }
{                                                        }
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
constructor ButtonMessageOBJ.Init(Style:byte;Tit:string);
{}
begin
   MessageOBJ.Init(Style,Tit);
   vButtonDepth := 2;
end; {ButtonMessageOBJ.Init}

procedure ButtonMessageOBJ.Show;
{}
var
   OK: ButtonIOOBJ;
   EscHK: HotKeyIOOBJ;
   TempAct: tAction;
begin
   CalcSize;
   OK.Init((vWidth - length(vButtonText))div 2 ,succ(vTotLines),
             vButtonText,Finished);
   OK.SetHotkey(vButtonHK);
   EscHK.Init(27,Finished);
   AssignButton(OK);
   AssignButton(EscHK);
   TempAct := BaseMessageOBJ.Show;
   EscHk.Done;
end; {ButtonMessageOBJ.Show}

destructor ButtonMessageOBJ.Done;
{}
begin
   MessageOBJ.Done
end; {ButtonMessageOBJ.Done}
{||||||||||||||||||||||||||||||||||||||||||}
{                                          }
{     P r o m p t O B J   M E T H O D S    }
{                                          }
{||||||||||||||||||||||||||||||||||||||||||}
constructor PromptOBJ.Init(Style:byte;Tit:string);
{}
begin
   BaseMessageOBJ.Init(Style,Tit);
   SetOption(1,'  ~O~K  ',79,Finished);
   SetOption(2,' ~C~ancel ',67,Escaped);
   vTotPrompts := 2;
end; {PromptOBJ.Init}

procedure PromptOBJ.LoadButtonRecord(Rec:byte;Str:stringbut;
                                     Hotkey:word;Act:tAction);
{}
begin
   with vButtonInfo[Rec] do
   begin
      Txt := Str;
      Code := Act;
      Len := length(Strip('A','~',Str));
      HK := Hotkey;
   end;
end; {PromptOBJ.LoadButtonRecord}

procedure PromptOBJ.SetOption(ID:byte; Str:stringbut;HotKey:word; Act:tAction);
{}
begin
   if ID in [1..3] then
      LoadButtonRecord(ID,Str,HotKey,Act);
   if ID = 3 then
      vTotPrompts := 3;
end; {PromptOBJ.SetOptions}

function PromptOBJ.Show: tAction;
{}
type
   But = record
      Button: Strip3dIOOBJ;
      XCoord: byte;
   end;
var
   MoveKeys: ControlKeysIOOBJ;
   Buttons : array[1..3] of But;
   Temp: byte;
   I : integer;
begin
   Temp := 0;
   for I := 1 to vTotprompts do
     inc(Temp,vButtonInfo[I].Len);
   vMinWidth := Temp + succ(vTotPrompts);
   CalcSize;
   Temp := (vWidth - Temp) div succ(vTotPrompts);
   Buttons[1].XCoord := Temp;
   for I := 2 to vTotPrompts do
      Buttons[I].XCoord := Temp + Buttons[pred(I)].XCoord + vButtonInfo[pred(I)].Len;
   for I := 1 to vTotPrompts do
   begin
      with Buttons[I] do
      begin
        Button.Init(XCoord,succ(vTotLines),vButtonInfo[I].Txt,vButtonInfo[I].Code);
        if vButtonInfo[I].HK <> 0 then
          Button.Sethotkey(vButtonInfo[I].HK);
       AssignButton(Button);
      end;
   end;
   MoveKeys.Init;
   AssignButton(MoveKeys);
   Show := BaseMessageOBJ.Show;
   for I := 1 to vTotPrompts do
      Buttons[I].Button.Done;
   MoveKeys.Done;
end; {PromptOBJ.Show}

destructor PromptOBJ.Done;
{}
begin
    BaseMessageOBJ.Done;
end; {PromptOBJ.Done}
{||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{                                                      }
{     B u t t o n P r o m p t O B J   M E T H O D S    }
{                                                      }
{||||||||||||||||||||||||||||||||||||||||||||||||||||||}
constructor ButtonPromptOBJ.Init(Style:byte;Tit:string);
{}
begin
   PromptOBJ.Init(Style,Tit);
   vButtonDepth := 2;
end; {ButtonPromptOBJ.Init}

function ButtonPromptOBJ.Show: tAction;
{}
type
   But = record
      Button: ButtonIOOBJ;
      XCoord: byte;
   end;
var
   MoveKeys: ControlKeysIOOBJ;
   Buttons : array[1..3] of But;
   Temp: byte;
   I : integer;
begin
   Temp := 0;
   for I := 1 to vTotprompts do
     inc(Temp,vButtonInfo[I].Len+2);
   vMinWidth := Temp + succ(vTotPrompts);
   CalcSize;
   Temp := (vWidth - Temp) div succ(vTotPrompts);
   Buttons[1].XCoord := Temp;
   for I := 2 to vTotPrompts do
      Buttons[I].XCoord := Temp + Buttons[pred(I)].XCoord + vButtonInfo[pred(I)].Len + 2;
   for I := 1 to vTotPrompts do
   begin
      with Buttons[I] do
      begin
        Button.Init(XCoord,succ(vTotLines),vButtonInfo[I].Txt,vButtonInfo[I].Code);
        if vButtonInfo[I].HK <> 0 then
          Button.Sethotkey(vButtonInfo[I].HK);
       AssignButton(Button);
      end;
   end;
   MoveKeys.Init;
   AssignButton(MoveKeys);
   Show := BaseMessageOBJ.Show;
   for I := 1 to vTotPrompts do
      Buttons[I].Button.Done;
   MoveKeys.Done;
end; {ButtonPromptOBJ.Show}

destructor ButtonPromptOBJ.Done;
{}
begin
   PromptOBJ.Done
end; {ButtonPromptOBJ.Done}
{|||||||||||||||||||||||||||||||||||||||||||||||}
{                                               }
{     U N I T   I N I T I A L I Z A T I O N     }
{                                               }
{|||||||||||||||||||||||||||||||||||||||||||||||}
procedure MsgInit;
{initilizes objects and global variables}
begin
end;

{end of unit - add intialization routines below}
{$IFNDEF OVERLAY}
begin
   MsgInit;
{$ENDIF}
end.