On 09/15/14, ignatius said the following...
I'll take a look at it. What exactly is wrong with it?
It doesn't execute. :/
I reworked it some. I noticed that there are no colord mci codes, where there obviously should be some. I'm thinking that they may have gotten stripped off since it was posted to the message area here.
--------------------------------
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 un
begin
fassign (f, automessage, 66) // Opens automessage.DAT
freset (f)
fWriteLn (f, 'from : '+ UserAlias) // Writes the useralias to f le
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 li e
If Line2 <> '' then FWriteLn (f, ' '+ Line2) // Displays 2nd li e
If Line3 <> '' then FWriteLn (f, ' '+ Line3) // and 3rd
If Line4 <> '' then FWriteLn (f, ' '+ Line4) // what the hay, 4 h 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 message, 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 automesage
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 A thor 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 ield
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 Mysti
to
p2 := Upper(ParamStr(2)) // look n the menu data field for the 1st & 2n
word
If p1='MENU'then // If 1st word in menudatafield equals this then isplay
Make_Menu // the menu
Else
If p2='MENU' then // If the 2nd word in menudatafield equals t is then dsplays
Make_Menu // the menu. Just so you can have these things in any order(the menu and color)
/*
If FileExist(Date) Then Begin
fOpen(1, Text, ReWrite, Date);
fClose(1);
End
*/
Date := DateStr(DateTime, 1) // Date equals this
Color_Me_Blind // Run this procedure(the color scheme)
DispFile(automessage) // Run this procedure(display automessag )
Should_We // Run this procedure(change automessage )
End
------------------------------
"No matter where you go, there you are!" - B. Bonzai
--- Mystic BBS v1.10 A51 (Linux)
* Origin: Cyberia BBS | Cyberia.Darktech.Org | Kingwood, TX (46:1/116)
þ Synchronet þ thePharcyde_ >>
telnet://bbs.pharcyde.org (Wisconsin)