Text 3800, 281 rader
Skriven 2019-01-31 19:20:24 av IGNATIUS (1:124/5013)
     Kommentar till en text av GRYPHON
Ärende: MPL
===========
Hey man, I was wondering if you could help me out with something. I have an
"auto message" MPL that needs to be re-worked. If you could take a look at
it, i'd really appreciate it.

--// snip ------------------------------------
 
Uses CFG;
Uses USER;

Var
  f           : file;
  Line1       : String;
  Line2       : String;
  Line3       : String;
  Line4       : String;
  Line5       : String;
  Line6       : String;
  Line7       : String;
  Line8       : String;
  automessage : String;
  Topic       : String;
  Date        : String;
  InStr       : String;
  Done        : Boolean;
  c1 : String; // Variables for the ColorScheme stuff: Colorscheme code thanks 
o Zoob
  c2 : String; // "          "          "        "
  c3 : String; // "          "          "        "
  p1 : String; // Variables for the DataField in the Menu Editor:
  p2 : String; //     i.e. "Menu" and "<color>"


//###########################
//##  Display Automesage  ###
//###########################

Procedure Write_Automsg
Begin
GetThisUser
     If InputYN ('|CRsave this message? ') then // Said after Should_We has run

       begin
          fassign (f, automessage, 66) // Opens automessage.DAT
          freset (f)
          fWriteLn (f, 'from : '+ UserAlias) // Writes the useralias to file
          fWriteLn (f, 'topic: '+ Topic)     // Writes topic to file
          fWriteLn (f, 'date : '+ Date)      // Writes date to file
          fWriteLn (f, '|CR')
          If Line1 <> '' then FWriteLn (f, ' '+ Line1) // Displays 1st line
          If Line2 <> '' then FWriteLn (f, ' '+ Line2) // Displays 2nd line
          If Line3 <> '' then FWriteLn (f, ' '+ Line3) // and 3rd
          If Line4 <> '' then FWriteLn (f, ' '+ Line4) // what the hay, 4th too
          If Line5 <> '' then FWriteLn (f, ' '+ Line5) // you guessed it, 5th
          If Line6 <> '' then FWriteLn (f, ' '+ Line6) // writes 8th line
          If Line7 <> '' then FWriteLn (f, ' '+ Line7) // writes 7th line
          If Line8 <> '' then FWriteLn (f, ' '+ Line8) // writes 6th line
          fClose (f)                         // Closes automessage.DAT
     End
Done := False // Is menu finished or not? <false = not>
end

//##########################
//##  Write automessage  ###
//##########################

Procedure Should_We
begin
// boy, that question was long, I write here for it. Would you like to write au
omessage, question.
If InputNY ('|CRchange automsg? ') then
  begin
     Write ('|CRtopic: ')
     Topic := Input (60, 60, 1, '')
  end

// If Topic doesn't exist, write a new one

/*

  If FileExist(Topic)
      fOpen(1, Text, ReWrite, Topic)
     fClose(1) // Close Topic file
  End If

*/

// Writing automessage now

     WriteLn ('|CRenter automsg now.. 8 lines max|CR')
     Write (': ')  Line1 := Input (77, 77, 1, '')
        If Line1 = '' then // If nothing entered on line1, abort
        begin  Write_Automsg
         WriteLn('aborted!')
         Halt
        End
     Write (': ')  Line2 := Input (77, 77, 1, '')
        If Line2 = '' then // If nothing entered on line2, save automessage?
        begin
         Write_Automsg
         Halt
        End
     Write (': ')  Line3 := Input (77, 77, 1, '')
        If Line3 = '' then // If nothing entered on line3, save automessage?
        begin
         Write_Automsg
         Halt
        End
     Write (': ')  Line4 := Input (77, 77, 1, '')
        If Line4 = '' then // If nothing entered on line4, save automessage?
        begin
         Write_Automsg
         Halt
        End
     Write (': ')  Line5 := Input (77, 77, 1, '')
        If Line5 = '' then // Get the idea?
        begin
         Write_Automsg
         Halt
        End
     Write (': ')  Line6 := Input (77, 77, 1, '')
        If Line6 = '' then // I'm done typing here
        begin
         Write_Automsg
         Halt
        End
     Write (': ')  Line7 := Input (77, 77, 1, '')
       If Line7 = '' then
        begin
         Write_Automsg
         Halt
        End
     Write (': ')  Line8 := Input (77, 77, 1, '')
     Write_Automsg
     DispFile (automessage)
End


//#########################
//##  automessage Menu  ###
//#########################

Procedure Make_Menu
begin
Repeat // Repeat this stuff until Done := True(until user presses "Q")
   WriteLn ('                lQ-automessage v2.2')
   WriteLn ('')
   WriteLn ('{V} View automessage')
   WriteLn ('{W} Write automessage')
   WriteLn ('(R) Reply to Author of automessage')
   WriteLn ('')
   Write ('lQ-automessage [Q/Quit] ['+ StrRep(' ', 2)+ ')'+ StrRep(Chr(8), 3))

InStr := Input(2, 2, 12, '') // The Input area is 2 characters long
 If InStr = 'V' Then         // If user presses "V" then it displays the autome
sage
   DispFile (automessage)    // Display file "automessage.DAT"
 Else If InStr = 'W' Then     // If "W" then Write the automessage
   Should_We                 // Run Should_We procedure
 Else If
 InStr = 'R' Then           // If "R" then reply to Author of automessage
   MenuCmd('MW', UserAlias) // Write to the author of automessage
 Else If InStr = 'Q' Then    // Quiting the menu
   Done := True             // Finally!
Until Done
End

//###########################
//##  Color Scheme Codes  ###
//###########################

Procedure Color_Me_Blind
begin
If p1='BLUE' then                            // If 1st word in menu data entry
    begin
    c1 :=''    c2 :=''  c3 :='' // equals BLUE then display those colors
    end
  Else If p1='GREEN' then                // Same as above, but for GREEN
    begin
    c1 :=''    c2 :=''  c3 :=''
    end
  Else If p1='CYAN'then                       // Same as above.
    begin
    c1 :=''    c2 :=''  c3 :=''
    end
  Else If p1='RED' then
    begin
    c1 :=''    c2 :=''  c3 :=''
    end
  Else If p1='MAGENTA' then
   begin
    begin
    c1 :=''    c2 :=''  c3 :=''
    end
  Else If p1='YELLOW' then
    begin
    c1 :=''    c2 :=''  c3 :=''
    end
  Else If p1='GREY' then
    begin
    c1 :=''    c2 :=''  c3 :=''
    end
  Else If p2='BLUE' then                  // Changed to if 2nd word in menudata
field
   begin
    c1 :=''    c2 :=''  c3 :='' // equals BLUE then display these codes
   end
  Else If p2='GREEN' then // Same as p2='BLUE'
  begin
    c1 :=''    c2 :=''  c3 :=''
  end
  Else If p2='CYAN' then                 // Same as the other p2="<Color>"'s
    begin
    c1 :=''    c2 :=''  c3 :=''
    end
  Else If p2='RED' then
   begin
    c1 :=''    c2 :=''  c3 :=''
   end
  Else If p2='MAGENTA' then
    begin
    c1 :=''    c2 :=''  c3 :=''
    end
  Else If p2='YELLOW' then
    begin
    c1 :=''    c2 :=''  c3 :=''
     end
  Else If p2='GREY' then
   begin
    c1 :=''    c2 :=''  c3 :=''
   end
   Else                                  // If no color entered then use these
    c1 :=''    c2 :=''  c3 :='' // Color Codes
End


Begin
automessage := CfgDataPath + 'automsg.dat'

  p1 := Upper(ParamStr(1)) // What the variables mean... This tells Mystic to
  p2 := Upper(ParamStr(2)) // look n the menu data field for the 1st & 2nd word


If p1='MENU'then       // If 1st word in menudatafield equals this then display
 Make_Menu         // the menu
 Else If p2='MENU' then  // If the 2nd word in menudatafield equals this then d
splays
 Make_Menu         // the menu. Just so you can have these things in any order(
he menu and color)
End

automessage := CfgDataPath + 'automsg.dat'

  p1 := Upper[ParamStr(1)] // What the variables mean... This tells Mystic to
  p2 := Upper[ParamStr(2)] // look n the menu data field for the 1st & 2nd word




// Putting the Date the automessage was written to a temp file.

  If FileExist(Date);
       fOpen(1, Text, ReWrite, Date);
     fClose(1);
  End If



Date := DateStr(DateTime, 1) // Date equals this
Color_Me_Blind                 // Run this procedure(the color scheme)
DispFile(automessage)          // Run this procedure(display automessage)
Should_We                      // Run this procedure(change automessage?)
End

--// snip -----------------------------------------------------

Thanks again,

|09ignatius |07(|15cia|07/|15scrollz|07)

--- Mystic BBS v1.10 A52 (Linux)
 * Origin: catch22bbs.com (46:1/124)