Text-tricks

a pas prog that will do this

display a message that will display colors 1 - 15 randomly flashing
Procedure or Function, which ever is better

how to use this subprogram within the main program.

DispMsg('Welcome!,c or r');  or something similar

can be Consecative color #'s [1..15] as one option or Random as an other.
///an other option is posistioning of the message / shall it be centered?

or kewl stuff, such as gradients, shades of green flyby char by char

such as [W][E][L][C][O][M][E][!]
THE W WILL BE VERY LIGHT GREEN AND THE ! WILL BE BRIGHTEST, THEN THE DARK
CHARACTER WILL GET LIGHTER ONE BY ONE, AS THE COLORS ARE MOVING FROM CHAR
TO CHAR
weinrjAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

omsecCommented:
Hi there !

Below, i wrote a procedure that does that job for you. You can easily use another algorythm to set the colors...

The routine expects 3 parameters :

MSG : STRING - The sting that you wanna write
X,Y : BYTE   - The X/Y - Postion where you wanna place the MSG

Program Test;

Uses
  Crt;

Procedure DispMSG(Msg : String; X, Y : Byte);

Var
  L,
  C     : Byte;

Begin
  C := 1;
  For L := 1 To Length(MSG) Do
    Begin
      TextColor(C);
      Write((MSG[C]));
      Inc(C);
      If C = L Then
        C := 15;
    End;
End;

Begin
  ClrScr;
  DispMSG('welcome!', 10, 10);
  ReadLn;
End.

0
omsecCommented:
Hi there !

Below, i wrote a procedure that does that job for you. You can easily use another algorythm to set the colors...

The routine expects 3 parameters :

MSG : STRING - The sting that you wanna write
X,Y : BYTE - The X/Y - Postion where you wanna place the MSG

Program Test;

Uses
Crt;

Procedure DispMSG(Msg : String; X, Y : Byte);

Var
L,
C : Byte;

Begin
C := 1;
For L := 1 To Length(MSG) Do
 Begin
 TextColor(C);
 Write((MSG[C]));
 Inc(C);
 If C = L Then
 C := 15;
 End;
End;

Begin
ClrScr;
DispMSG('welcome!', 10, 10);
ReadLn;
End.
0
omsecCommented:
Hi there !

Below, i wrote a procedure that does that job for you. You can easily use another algorythm to set the colors...

The routine expects 3 parameters :

MSG : STRING - The sting that you wanna write
X,Y : BYTE - The X/Y - Postion where you wanna place the MSG

Program Test;

Uses
Crt;

Procedure DispMSG(Msg : String; X, Y : Byte);

Var
L,
C : Byte;

Begin
C := 1;
For L := 1 To Length(MSG) Do
 Begin
 TextColor(C);
 Write((MSG[C]));
 Inc(C);
 If C = L Then
 C := 15;
 End;
End;

Begin
ClrScr;
DispMSG('welcome!', 10, 10);
ReadLn;
End.

PS : Damn **** - i clicked on the wrong button - heheh
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
weinrjAuthor Commented:
thank you very much!!  

PS- i get a problem sometimes where an unknown charactor displays
on the screen and nowhere in the source.

how come this happens?
0
omsecCommented:
Hello out there !

Fist, sorry for this late answer, but usually i don't look at questions in the archive.

I wrote you here a more improved version of that DispMSG - Procedure. I saw u wrote "procedure or function, wich ever is better" that seems you don't really know the different between a procedure and a function. Well, the job of a procedure is to do a program part. it executes that part and at its end if changes back to the main program code. A function does someting (that can of course be a program part) and returns you a value, so it calculates someting. For example you cannot declare a something like this :

Function WriteText;

That would bring you an error from the compiler. For this you have to use the key word Procedure

Procedure WriteTexr; {= ok}

The job of a function would be this :

Function FileExist(FileName : String) : Boolean;

A function doesnt have to expect a parameter but usually its needed. You see this function would return TRUE (1) in the format of an 1-Bit Boolean - Variable. The whole code were :

Function FileExists(FileName : String) : Boolean;

Var
  WantedFile : File;  {needed file - variable}

Begin
Begin
  {$I-} {turn auto i/o - checkl off}
    Assign(WantedFile, FileName);
    Reset(WantedFile);
    Close(WantedFile);
  {$I+} {turn it back on}
  FileExists := (IoResult = 0) and (FileName <> '');
End;

ok, this about the Procedure/Function - Stuff...

Below is the source code of the improved color - algorytm :

Procedure DispMSG(Message : String; X, Y : Byte);

Var
  L,
  C           : Byte;

Begin
  C := 1;
  Gotoxy(X, Y);
  For L := 1 To Length(Message) Do
    Begin
      TextColor(C);
      Write((Message[L]));
      Inc(C);
      If C = 15 Then
        C := 1;
    End;
End;

I removed a bug there. Its now able to write long strings too.
As you can see at line "If C = 15 Then C := 1", this means if C
has the code 15 (White) set it back to 1 (Blue) and dont write a white char. I disabled white-chars cos they are very bright. If you wish to use write char color, just replace the "15" with a "16" and the line will look like this : "If C = 16 Then C := 1"

About your last problem...

Hm.. i dont really see what you mean. In Borland's String - Format (An array of chars) can you use all of the 255 characters of the extended char-set from IBM/MS - Standard. The Pascal - Compiler doesnt allow such chars in the source code, only in strings to write or work with.

I hope this could help :)

Greets, Omsec
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Pascal

From novice to tech pro — start learning today.