Why this fader VB code dont work on paltalk

This topic has 2 replies, 3 voices, and was last updated 17 years ago by s k 8 e r.

Viewing 3 posts - 1 through 3 (of 3 total)

Author

Posts

December 19, 2004 at 8:27 pm #190120

Admin

Administrator

Well I bein trying to figure this out for couple of days I got this code from vb source.

Anyways here the module

'ÃƒÆ’Ã†â€™Ãƒâ€ Ã¢â‚¬â„¢ÃƒÆ’Ã¢â‚¬Å¡Ãƒâ€šÃ‚Â¢ÃƒÆ’Ã†â€™Ãƒâ€šÃ‚Â¢ÃƒÆ’Ã‚Â¢ÃƒÂ¢Ã¢â‚¬Å¡Ã‚Â¬Ãƒâ€¦Ã‚Â¡ÃƒÆ’Ã¢â‚¬Å¡Ãƒâ€šÃ‚Â¬ÃƒÆ’Ã†â€™ÃƒÂ¢Ã¢â€šÂ¬Ã…Â¡ÃƒÆ’Ã¢â‚¬Å¡Ãƒâ€šÃ‚Â¢MONKEFADE.BASÃƒÆ’Ã†â€™Ãƒâ€ Ã¢â‚¬â„¢ÃƒÆ’Ã¢â‚¬Å¡Ãƒâ€šÃ‚Â¢ÃƒÆ’Ã†â€™Ãƒâ€šÃ‚Â¢ÃƒÆ’Ã‚Â¢ÃƒÂ¢Ã¢â‚¬Å¡Ã‚Â¬Ãƒâ€¦Ã‚Â¡ÃƒÆ’Ã¢â‚¬Å¡Ãƒâ€šÃ‚Â¬ÃƒÆ’Ã†â€™ÃƒÂ¢Ã¢â€šÂ¬Ã…Â¡ÃƒÆ’Ã¢â‚¬Å¡Ãƒâ€šÃ‚Â¢

'by monk-e-god (e-mail: monkegod@hotmail.com)

'and

'aDRaMoLEk (e-mail: adramolek@angelfire.com)



'version: 3

'updates: The fade preview sub was

'highly improved by aDRaMoLEk.  It no

'longer requires a richtext box or an

'invisible textbox.  It simply requires

'a picture box.  You can now also preview

'wavy fades and the sub automatically

'interprets bold, italic, underline and

'strikethru!  I also added a function

'called MultiFade where you give it an

'array of colors and you can fade as many

'different colors as you want in one

'function!  I also added a FormFade sub

'where you choose the colors to fade.



'This is the best fader bas available

'with tons of unique and cool features.

'This bas isn't jam packed with every

'color combination in its own function

'taking up tons of space, however this

'bas allows you more combinations than

'ever before.  You get to choose to fade

'by color or by Red Green and Blue

'values.  With as many colors as you want

'per fade the combinations are endless.

'This bas also contains unique fade

'preview subs that allows you to view

'fades in a picture or RichText box.



'Please do not steal our subs and functions,

'there is no reason to add them to your

'bas, why not just use my bas too instead

'of being a code thief.  And also please

'add me to your greets, especially if

'your prog is just a fader, I mean with

'this bas you could make a really leet

'fader very very easily.

'ÃƒÆ’Ã†â€™Ãƒâ€ Ã¢â‚¬â„¢ÃƒÆ’Ã¢â‚¬Å¡Ãƒâ€šÃ‚Â¢ÃƒÆ’Ã†â€™Ãƒâ€šÃ‚Â¢ÃƒÆ’Ã‚Â¢ÃƒÂ¢Ã¢â‚¬Å¡Ã‚Â¬Ãƒâ€¦Ã‚Â¡ÃƒÆ’Ã¢â‚¬Å¡Ãƒâ€šÃ‚Â¬ÃƒÆ’Ã†â€™ÃƒÂ¢Ã¢â€šÂ¬Ã…Â¡ÃƒÆ’Ã¢â‚¬Å¡Ãƒâ€šÃ‚Â¢ monk-e-god ÃƒÆ’Ã†â€™Ãƒâ€ Ã¢â‚¬â„¢ÃƒÆ’Ã¢â‚¬Å¡Ãƒâ€šÃ‚Â¢ÃƒÆ’Ã†â€™Ãƒâ€šÃ‚Â¢ÃƒÆ’Ã‚Â¢ÃƒÂ¢Ã¢â‚¬Å¡Ã‚Â¬Ãƒâ€¦Ã‚Â¡ÃƒÆ’Ã¢â‚¬Å¡Ãƒâ€šÃ‚Â¬ÃƒÆ’Ã†â€™ÃƒÂ¢Ã¢â€šÂ¬Ã…Â¡ÃƒÆ’Ã¢â‚¬Å¡Ãƒâ€šÃ‚Â¢



'-FADE FUNCTIONS-

'Some subs in this bas may not be

'self-explanatory at first because

'they require you to type in the red,

'green and blue values of each color.

'Some of you might not know the RGB

'values of certain colors so here are

'a few:



'Red = R: 255, G: 0, B:0

'Green = R: 0, G: 255, B:0

'Blue = R: 0, G: 0, B: 255

'Yellow = R: 255, G: 255, B: 0

'White = R: 255, G: 255, B: 255

'Black = R: 0, G: 0, B: 0



'So to fade from Blue to Black to

'Blue you would do:

'FadedText$ = FadeThreeColor(0, 0, 255, 0, 0, 0, 0, 0, 255, Text2Fade$, False)

'Or you could use the easier subs by

'doing:

'FadedText$ = FadeByColor3(FADE_BLUE, FADE_BLACK, FADE_BLUE, Text2Fade$, False)

'To make the text wavy all you have

'to do is set the last parameter(Wavy)

'to True.



'-MULTIFADE-

'To use this you need to declare an array

'and fill it with the colors to fade.

'Example:



'Dim ColorArray(4)

'ColorArray(1) = FADE_RED

'ColorArray(2) = FADE_BLACK

'ColorArray(3) = FADE_BLUE

'ColorArray(4) = FADE_BLACK

'FadedText$ = MultiFade(4, ColorArray, "The Text You Want To Fade", False)



Declare Function sendmessagebynum& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)

Public Declare Function findwindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Declare Function SendMessageLong& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)

Public Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long

Public Declare Function ReleaseCapture Lib "user32" () As Long

Public Const FADE_RED = &HFF&

Public Const FADE_GREEN = &HFF00&

Public Const FADE_BLUE = &HFF0000

Public Const FADE_YELLOW = &HFFFF&

Public Const FADE_WHITE = &HFFFFFF

Public Const FADE_BLACK = &H0&

Public Const FADE_PURPLE = &HFF00FF

Public Const FADE_GREY = &HC0C0C0

Public Const FADE_PINK = &HFF80FF

Public Const FADE_TURQUOISE = &HC0C000



Type COLORRGB

Red As Long

Green As Long

Blue As Long

End Type

Sub FormFade(FormX As Form, Color1, Color2)

'by monk-e-god (modified from a sub by MaRZ)

B1 = GetRGB(Colr1).Blue

G1 = GetRGB(Colr1).Green

R1 = GetRGB(Colr1).Red

B2 = GetRGB(Colr2).Blue

G2 = GetRGB(Colr2).Green

R2 = GetRGB(Colr2).Red



On Error Resume Next

Dim intLoop As Integer

FormX.DrawStyle = vbInsideSolid

FormX.DrawMode = vbCopyPen

FormX.ScaleMode = vbPixels

FormX.DrawWidth = 2

FormX.ScaleHeight = 256

For intLoop = 0 To 255

FormX.Line (0, intLoop)-(Screen.Width, intLoop - 1), RGB(((R2 - R1) / 255 * intLoop) + R1, ((G2 - G1) / 255 * intLoop) + G1, ((B2 - B1) / 255 * intLoop) + B1), B

Next intLoop

End Sub



Sub FadeForm(FormX As Form, Colr1, Colr2)

'by monk-e-god (modified from a sub by MaRZ)

B1 = GetRGB(Colr1).Blue

G1 = GetRGB(Colr1).Green

R1 = GetRGB(Colr1).Red

B2 = GetRGB(Colr2).Blue

G2 = GetRGB(Colr2).Green

R2 = GetRGB(Colr2).Red



On Error Resume Next

Dim intLoop As Integer

FormX.DrawStyle = vbInsideSolid

FormX.DrawMode = vbCopyPen

FormX.ScaleMode = vbPixels

FormX.DrawWidth = 2

FormX.ScaleHeight = 256

For intLoop = 0 To 255

FormX.Line (0, intLoop)-(Screen.Width, intLoop - 1), RGB(((R2 - R1) / 255 * intLoop) + R1, ((G2 - G1) / 255 * intLoop) + G1, ((B2 - B1) / 255 * intLoop) + B1), B

Next intLoop

End Sub

Sub FadePreview(PicB As PictureBox, ByVal FadedText As String)

'by aDRaMoLEk

FadedText$ = Replacer(FadedText$, Chr(13), "+chr13+")

OSM = PicB.ScaleMode

PicB.ScaleMode = 3

TextOffX = 0: TextOffY = 0

StartX = 2: StartY = 0

PicB.Font = "Arial": PicB.FontSize = 10

PicB.FontBold = False: PicB.FontItalic = False: PicB.FontUnderline = False: PicB.FontStrikethru = False

PicB.AutoRedraw = True: PicB.ForeColor = 0&: PicB.Cls

For x = 1 To Len(FadedText$)

c$ = Mid$(FadedText$, x, 1)

If c$ = "<" Then

TagStart = x + 1

TagEnd = InStr(x + 1, FadedText$, ">") - 1

T$ = LCase$(Mid$(FadedText$, TagStart, (TagEnd - TagStart) + 1))

x = TagEnd + 1

Select Case T$

Case "u"

PicB.FontUnderline = True

Case "/u"

PicB.FontUnderline = False

Case "s"

PicB.FontStrikethru = True

Case "/s"

PicB.FontStrikethru = False

Case "b"    'start bold

PicB.FontBold = True

Case "/b"   'stop bold

PicB.FontBold = False

Case "i"    'start italic

PicB.FontItalic = True

Case "/i"   'stop italic

PicB.FontItalic = False

Case "sup"  'start superscript

TextOffY = -1

Case "/sup" 'end superscript

TextOffY = 0

Case "sub"  'start subscript

TextOffY = 1

Case "/sub" 'end subscript

TextOffY = 0

Case Else

If Left$(T$, 10) = "font color" Then 'change font color

ColorStart = InStr(T$, "#")

ColorString$ = Mid$(T$, ColorStart + 1, 6)

RedString$ = Left$(ColorString$, 2)

GreenString$ = Mid$(ColorString$, 3, 2)

BlueString$ = Right$(ColorString$, 2)

RV = Hex2Dec!(RedString$)

GV = Hex2Dec!(GreenString$)

BV = Hex2Dec!(BlueString$)

PicB.ForeColor = RGB(RV, GV, BV)

End If

If Left$(T$, 9) = "font face" Then 'added by monk-e-god

Dim Y

Y = Y + 1

End If

End Select

Else  'normal text

If c$ = "+" And Mid(FadedText$, x, 7) = "+chr13+" Then ' added by monk-e-god

StartY = StartY + 16

TextOffX = 0

x = x + 6

Else

PicB.CurrentY = StartY + TextOffY

PicB.CurrentX = StartX + TextOffX

PicB.Print c$

TextOffX = TextOffX + PicB.TextWidth(c$)

End If

End If

Next x

PicB.ScaleMode = OSM

End Sub



Function GetRGB(ByVal CVal As Long) As COLORRGB

GetRGB.Blue = Int(CVal / 65536)

GetRGB.Green = Int((CVal - (65536 * GetRGB.Blue)) / 256)

GetRGB.Red = CVal - (65536 * GetRGB.Blue + 256 * GetRGB.Green)

End Function

Sub FadePreview2(RichTB As Control, ByVal FadedText As String)

'Modified by monk-e-god for use in a RichTextBox



'NOTE: RichTB must be a RichTextBox.

'NOTE: You cannot preview wavy fades with this sub.

Dim StartPlace%

StartPlace% = 0

RichTB.SelStart = StartPlace%

RichTB.Font = "Arial": RichTB.SelFontSize = 10

RichTB.SelBold = False: RichTB.SelItalic = False: RichTB.SelUnderline = False: RichTB.SelStrikeThru = False

RichTB.SelColor = 0&: RichTB.Text = ""

For x = 1 To Len(FadedText$)

c$ = Mid$(FadedText$, x, 1)

RichTB.SelStart = StartPlace%

RichTB.SelLength = 1

If c$ = "<" Then

TagStart = x + 1

TagEnd = InStr(x + 1, FadedText$, ">") - 1

T$ = LCase$(Mid$(FadedText$, TagStart, (TagEnd - TagStart) + 1))

x = TagEnd + 1

RichTB.SelStart = StartPlace%

RichTB.SelLength = 1

Select Case T$

Case "u"

RichTB.SelUnderline = True

Case "/u"

RichTB.SelUnderline = False

Case "s"

RichTB.SelStrikeThru = True

Case "/s"

RichTB.SelStrikeThru = False

Case "b"    'start bold

RichTB.SelBold = True

Case "/b"   'stop bold

RichTB.SelBold = False

Case "i"    'start italic

RichTB.SelItalic = True

Case "/i"   'stop italic

RichTB.SelItalic = False



Case Else

If Left$(T$, 10) = "font color" Then 'change font color

ColorStart = InStr(T$, "#")

ColorString$ = Mid$(T$, ColorStart + 1, 6)

RedString$ = Left$(ColorString$, 2)

GreenString$ = Mid$(ColorString$, 3, 2)

BlueString$ = Right$(ColorString$, 2)

RV = Hex2Dec!(RedString$)

GV = Hex2Dec!(GreenString$)

BV = Hex2Dec!(BlueString$)

RichTB.SelStart = StartPlace%

RichTB.SelColor = RGB(RV, GV, BV)

End If

If Left$(T$, 9) = "font face" Then

fontstart% = InStr(T$, Chr(34))

dafont$ = Right(T$, Len(T$) - fontstart%)

RichTB.SelStart = StartPlace%

RichTB.SelFontName = dafont$

End If

End Select

Else  'normal text

RichTB.SelText = RichTB.SelText + c$

StartPlace% = StartPlace% + 1

RichTB.SelStart = StartPlace%

End If

Next x

End Sub



Function Hex2Dec!(ByVal strHex$)

'by aDRaMoLEk

If Len(strHex$) > 8 Then strHex$ = Right$(strHex$, 8)

Hex2Dec = 0

For x = Len(strHex$) To 1 Step -1

CurCharVal = GETVAL(Mid$(UCase$(strHex$), x, 1))

Hex2Dec = Hex2Dec + CurCharVal * 16 ^ (Len(strHex$) - x)

Next x

End Function



Function GETVAL%(ByVal strLetter$)

'by aDRaMoLEk

Select Case strLetter$

Case "0"

GETVAL = 0

Case "1"

GETVAL = 1

Case "2"

GETVAL = 2

Case "3"

GETVAL = 3

Case "4"

GETVAL = 4

Case "5"

GETVAL = 5

Case "6"

GETVAL = 6

Case "7"

GETVAL = 7

Case "8"

GETVAL = 8

Case "9"

GETVAL = 9

Case "A"

GETVAL = 10

Case "B"

GETVAL = 11

Case "C"

GETVAL = 12

Case "D"

GETVAL = 13

Case "E"

GETVAL = 14

Case "F"

GETVAL = 15

End Select

End Function



Function CLRBars(RedBar As Control, GreenBar As Control, BlueBar As Control)

'This gets a color from 3 scroll bars

CLRBars = RGB(RedBar.Value, GreenBar.Value, BlueBar.Value)



'Put this in the scroll event of the

'3 scroll bars RedScroll1, GreenScroll1,

'& BlueScroll1.  It changes the backcolor

'of ColorLbl when you scroll the bars

'ColorLbl.BackColor = CLRBars(RedScroll1, GreenScroll1, BlueScroll1)



End Function



Function FadeByColor10(Colr1, Colr2, Colr3, Colr4, Colr5, Colr6, Colr7, Colr8, Colr9, Colr10, thetext$, Wavy As Boolean)

'by monk-e-god

dacolor1$ = RGBtoHEX(Colr1)

dacolor2$ = RGBtoHEX(Colr2)

dacolor3$ = RGBtoHEX(Colr3)

dacolor4$ = RGBtoHEX(Colr4)

dacolor5$ = RGBtoHEX(Colr5)

dacolor6$ = RGBtoHEX(Colr6)

dacolor7$ = RGBtoHEX(Colr7)

dacolor8$ = RGBtoHEX(Colr8)

dacolor9$ = RGBtoHEX(Colr9)

dacolor10$ = RGBtoHEX(Colr10)



rednum1% = Val("&H" + Right(dacolor1$, 2))

greennum1% = Val("&H" + Mid(dacolor1$, 3, 2))

bluenum1% = Val("&H" + Left(dacolor1$, 2))

rednum2% = Val("&H" + Right(dacolor2$, 2))

greennum2% = Val("&H" + Mid(dacolor2$, 3, 2))

bluenum2% = Val("&H" + Left(dacolor2$, 2))

rednum3% = Val("&H" + Right(dacolor3$, 2))

greennum3% = Val("&H" + Mid(dacolor3$, 3, 2))

bluenum3% = Val("&H" + Left(dacolor3$, 2))

rednum4% = Val("&H" + Right(dacolor4$, 2))

greennum4% = Val("&H" + Mid(dacolor4$, 3, 2))

bluenum4% = Val("&H" + Left(dacolor4$, 2))

rednum5% = Val("&H" + Right(dacolor5$, 2))

greennum5% = Val("&H" + Mid(dacolor5$, 3, 2))

bluenum5% = Val("&H" + Left(dacolor5$, 2))

rednum6% = Val("&H" + Right(dacolor6$, 2))

greennum6% = Val("&H" + Mid(dacolor6$, 3, 2))

bluenum6% = Val("&H" + Left(dacolor6$, 2))

rednum7% = Val("&H" + Right(dacolor7$, 2))

greennum7% = Val("&H" + Mid(dacolor7$, 3, 2))

bluenum7% = Val("&H" + Left(dacolor7$, 2))

rednum8% = Val("&H" + Right(dacolor8$, 2))

greennum8% = Val("&H" + Mid(dacolor8$, 3, 2))

bluenum8% = Val("&H" + Left(dacolor8$, 2))

rednum9% = Val("&H" + Right(dacolor9$, 2))

greennum9% = Val("&H" + Mid(dacolor9$, 3, 2))

bluenum9% = Val("&H" + Left(dacolor9$, 2))

rednum10% = Val("&H" + Right(dacolor10$, 2))

greennum10% = Val("&H" + Mid(dacolor10$, 3, 2))

bluenum10% = Val("&H" + Left(dacolor10$, 2))





FadeByColor10 = FadeTenColor(rednum1%, greennum1%, bluenum1%, rednum2%, greennum2%, bluenum2%, rednum3%, greennum3%, bluenum3%, rednum4%, greennum4%, bluenum4%, rednum5%, greennum5%, bluenum5%, rednum6%, greennum6%, bluenum6%, rednum7%, greennum7%, bluenum7%, rednum8%, greennum8%, bluenum8%, rednum9%, greennum9%, bluenum9%, rednum10%, greennum10%, bluenum10%, thetext, Wavy)



End Function



Sub FadeFormGreen(vForm As Form)

On Error Resume Next

Dim intLoop As Integer

vForm.DrawStyle = vbInsideSolid

vForm.DrawMode = vbCopyPen

vForm.ScaleMode = vbPixels

vForm.DrawWidth = 2

vForm.ScaleHeight = 256

For intLoop = 0 To 255

vForm.Line (0, intLoop)-(Screen.Width, intLoop - 1), RGB(0, 255 - intLoop, 0), B

Next intLoop

End Sub



Function FadeByColor2(Colr1, Colr2, thetext$, Wavy As Boolean)

'by monk-e-god

dacolor1$ = RGBtoHEX(Colr1)

dacolor2$ = RGBtoHEX(Colr2)



rednum1% = Val("&H" + Right(dacolor1$, 2))

greennum1% = Val("&H" + Mid(dacolor1$, 3, 2))

bluenum1% = Val("&H" + Left(dacolor1$, 2))

rednum2% = Val("&H" + Right(dacolor2$, 2))

greennum2% = Val("&H" + Mid(dacolor2$, 3, 2))

bluenum2% = Val("&H" + Left(dacolor2$, 2))



FadeByColor2 = FadeTwoColor(rednum1%, greennum1%, bluenum1%, rednum2%, greennum2%, bluenum2%, thetext, Wavy)



End Function

Function GreenBlackGreen(Text1)

a = Len(Text1)

For B = 1 To a

c = Left(Text1, B)

D = Right(c, 1)

E = 510 / a

F = E * B

If F > 255 Then F = (255 - (F - 255))

G = RGB(0, 255 - F, 0)

H = RGBtoHEX(G)

Msg = Msg & "" & D

Next B

GreenBlackGreen = Msg

End Function



Public Sub ChatSend(Chat As String)

Dim room As Long, AORich As Long, AORich2 As Long

room& = FindRoom&

AORich& = FindWindowEx(room, 0&, "RICHCNTL", vbNullString)

AORich2& = FindWindowEx(room, AORich, "RICHCNTL", vbNullString)

Call SendMessageByString(AORich2, WM_SETTEXT, 0&, Chat$)

Call SendMessageLong(AORich2, WM_CHAR, ENTER_KEY, 0&)

End Sub

Public Sub MoveForm(frm As Form)

ReleaseCapture

Dim x

x = SendMessage(frm.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)

'Put in a Label or Picbox in MouseDown:

'MoveForm me



End Sub

Sub FadeFormBlue(vForm As Form)

On Error Resume Next

Dim intLoop As Integer

vForm.DrawStyle = vbInsideSolid

vForm.DrawMode = vbCopyPen

vForm.ScaleMode = vbPixels

vForm.DrawWidth = 2

vForm.ScaleHeight = 256

For intLoop = 0 To 255

vForm.Line (0, intLoop)-(Screen.Width, intLoop - 1), RGB(0, 0, 255 - intLoop), B

Next intLoop

End Sub

Function FadeByColor4(Colr1, Colr2, Colr3, Colr4, thetext$, Wavy As Boolean)

'by monk-e-god

dacolor1$ = RGBtoHEX(Colr1)

dacolor2$ = RGBtoHEX(Colr2)

dacolor3$ = RGBtoHEX(Colr3)

dacolor4$ = RGBtoHEX(Colr4)



rednum1% = Val("&H" + Right(dacolor1$, 2))

greennum1% = Val("&H" + Mid(dacolor1$, 3, 2))

bluenum1% = Val("&H" + Left(dacolor1$, 2))

rednum2% = Val("&H" + Right(dacolor2$, 2))

greennum2% = Val("&H" + Mid(dacolor2$, 3, 2))

bluenum2% = Val("&H" + Left(dacolor2$, 2))

rednum3% = Val("&H" + Right(dacolor3$, 2))

greennum3% = Val("&H" + Mid(dacolor3$, 3, 2))

bluenum3% = Val("&H" + Left(dacolor3$, 2))

rednum4% = Val("&H" + Right(dacolor4$, 2))

greennum4% = Val("&H" + Mid(dacolor4$, 3, 2))

bluenum4% = Val("&H" + Left(dacolor4$, 2))



FadeByColor4 = FadeFourColor(rednum1%, greennum1%, bluenum1%, rednum2%, greennum2%, bluenum2%, rednum3%, greennum3%, bluenum3%, rednum4%, greennum4%, bluenum4%, thetext, Wavy)



End Function



Function FadeByColor5(Colr1, Colr2, Colr3, Colr4, Colr5, thetext$, Wavy As Boolean)

'by monk-e-god

dacolor1$ = RGBtoHEX(Colr1)

dacolor2$ = RGBtoHEX(Colr2)

dacolor3$ = RGBtoHEX(Colr3)

dacolor4$ = RGBtoHEX(Colr4)

dacolor5$ = RGBtoHEX(Colr5)



rednum1% = Val("&H" + Right(dacolor1$, 2))

greennum1% = Val("&H" + Mid(dacolor1$, 3, 2))

bluenum1% = Val("&H" + Left(dacolor1$, 2))

rednum2% = Val("&H" + Right(dacolor2$, 2))

greennum2% = Val("&H" + Mid(dacolor2$, 3, 2))

bluenum2% = Val("&H" + Left(dacolor2$, 2))

rednum3% = Val("&H" + Right(dacolor3$, 2))

greennum3% = Val("&H" + Mid(dacolor3$, 3, 2))

bluenum3% = Val("&H" + Left(dacolor3$, 2))

rednum4% = Val("&H" + Right(dacolor4$, 2))

greennum4% = Val("&H" + Mid(dacolor4$, 3, 2))

bluenum4% = Val("&H" + Left(dacolor4$, 2))

rednum5% = Val("&H" + Right(dacolor5$, 2))

greennum5% = Val("&H" + Mid(dacolor5$, 3, 2))

bluenum5% = Val("&H" + Left(dacolor5$, 2))



FadeByColor5 = FadeFiveColor(rednum1%, greennum1%, bluenum1%, rednum2%, greennum2%, bluenum2%, rednum3%, greennum3%, bluenum3%, rednum4%, greennum4%, bluenum4%, rednum5%, greennum5%, bluenum5%, thetext, Wavy)



End Function



Function FadeFiveColor(R1%, G1%, B1%, R2%, G2%, B2%, R3%, G3%, B3%, R4%, G4%, B4%, R5%, G5%, B5%, thetext$, Wavy As Boolean)

'by monk-e-god

Dim WaveState%

Dim WaveHTML$

WaveState = 0



textlen% = Len(thetext)



Do: DoEvents

fstlen% = fstlen% + 1: textlen% = textlen% - 1

If textlen% < 1 Then Exit Do

seclen% = seclen% + 1: textlen% = textlen% - 1

If textlen% < 1 Then Exit Do

thrdlen% = thrdlen% + 1: textlen% = textlen% - 1

If textlen% < 1 Then Exit Do

frthlen% = frthlen% + 1: textlen% = textlen% - 1

If textlen% < 1 Then Exit Do

Loop Until textlen% < 1



part1$ = Left(thetext, fstlen%)

part2$ = Mid(thetext, fstlen% + 1, seclen%)

part3$ = Mid(thetext, fstlen% + seclen% + 1, thrdlen%)

part4$ = Right(thetext, frthlen%)



'part1

textlen% = Len(part1$)

For i = 1 To textlen%

TextDone$ = Left(part1$, i)

LastChr$ = Right(TextDone$, 1)

ColorX = RGB(((B2 - B1) / textlen% * i) + B1, ((G2 - G1) / textlen% * i) + G1, ((R2 - R1) / textlen% * i) + R1)

colorx2 = RGBtoHEX(ColorX)



If Wavy = True Then

WaveState = WaveState + 1

If WaveState > 4 Then WaveState = 1

If WaveState = 1 Then WaveHTML = "^{"

If WaveState = 2 Then WaveHTML = "}"

If WaveState = 3 Then WaveHTML = "_{"

If WaveState = 4 Then WaveHTML = "}"

Else

WaveHTML = ""

End If



Faded1$ = Faded1$ + "" + WaveHTML + LastChr$

Next i

'part2

textlen% = Len(part2$)

For i = 1 To textlen%

TextDone$ = Left(part2$, i)

LastChr$ = Right(TextDone$, 1)

ColorX = RGB(((B3 - B2) / textlen% * i) + B2, ((G3 - G2) / textlen% * i) + G2, ((R3 - R2) / textlen% * i) + R2)

colorx2 = RGBtoHEX(ColorX)



If Wavy = True Then

WaveState = WaveState + 1

If WaveState > 4 Then WaveState = 1

If WaveState = 1 Then WaveHTML = "^{"

If WaveState = 2 Then WaveHTML = "}"

If WaveState = 3 Then WaveHTML = "_{"

If WaveState = 4 Then WaveHTML = "}"

Else

WaveHTML = ""

End If



Faded2$ = Faded2$ + "" + WaveHTML + LastChr$

Next i



'part3

textlen% = Len(part3$)

For i = 1 To textlen%

TextDone$ = Left(part3$, i)

LastChr$ = Right(TextDone$, 1)

ColorX = RGB(((B4 - B3) / textlen% * i) + B3, ((G4 - G3) / textlen% * i) + G3, ((R4 - R3) / textlen% * i) + R3)

colorx2 = RGBtoHEX(ColorX)



If Wavy = True Then

WaveState = WaveState + 1

If WaveState > 4 Then WaveState = 1

If WaveState = 1 Then WaveHTML = "^{"

If WaveState = 2 Then WaveHTML = "}"

If WaveState = 3 Then WaveHTML = "_{"

If WaveState = 4 Then WaveHTML = "}"

Else

WaveHTML = ""

End If



Faded3$ = Faded3$ + "" + WaveHTML + LastChr$

Next i



'part4

textlen% = Len(part4$)

For i = 1 To textlen%

TextDone$ = Left(part4$, i)

LastChr$ = Right(TextDone$, 1)

ColorX = RGB(((B5 - B4) / textlen% * i) + B4, ((G5 - G4) / textlen% * i) + G4, ((R5 - R4) / textlen% * i) + R4)

colorx2 = RGBtoHEX(ColorX)



If Wavy = True Then

WaveState = WaveState + 1

If WaveState > 4 Then WaveState = 1

If WaveState = 1 Then WaveHTML = "^{"

If WaveState = 2 Then WaveHTML = "}"

If WaveState = 3 Then WaveHTML = "_{"

If WaveState = 4 Then WaveHTML = "}"

Else

WaveHTML = ""

End If



Faded4$ = Faded4$ + "" + WaveHTML + LastChr$

Next i



FadeFiveColor = Faded1$ + Faded2$ + Faded3$ + Faded4$

End Function

Function FadeTenColor(R1%, G1%, B1%, R2%, G2%, B2%, R3%, G3%, B3%, R4%, G4%, B4%, R5%, G5%, B5%, R6%, G6%, B6%, R7%, G7%, B7%, R8%, G8%, B8%, R9%, G9%, B9%, R10%, G10%, B10%, thetext$, Wavy As Boolean)

'by monk-e-god

Dim WaveState%

Dim WaveHTML$

WaveState = 0



textlen% = Len(thetext)



Do: DoEvents

fstlen% = fstlen% + 1: textlen% = textlen% - 1

If textlen% < 1 Then Exit Do

seclen% = seclen% + 1: textlen% = textlen% - 1

If textlen% < 1 Then Exit Do

thrdlen% = thrdlen% + 1: textlen% = textlen% - 1

If textlen% < 1 Then Exit Do

frthlen% = frthlen% + 1: textlen% = textlen% - 1

If textlen% < 1 Then Exit Do

fithlen% = fithlen% + 1: textlen% = textlen% - 1

If textlen% < 1 Then Exit Do

sixlen% = sixlen% + 1: textlen% = textlen% - 1

If textlen% < 1 Then Exit Do

seclen% = seclen% + 1: textlen% = textlen% - 1

If textlen% < 1 Then Exit Do

eightlen% = eightlen% + 1: textlen% = textlen% - 1

If textlen% < 1 Then Exit Do

ninelen% = ninelen% + 1: textlen% = textlen% - 1

If textlen% < 1 Then Exit Do

Loop Until textlen% < 1



part1$ = Left(thetext, fstlen%)

part2$ = Mid(thetext, fstlen% + 1, seclen%)

part3$ = Mid(thetext, fstlen% + seclen% + 1, thrdlen%)

part4$ = Mid(thetext, fstlen% + seclen% + thrdlen% + 1, frthlen%)

part5$ = Mid(thetext, fstlen% + seclen% + thrdlen% + frthlen% + 1, fithlen%)

part6$ = Mid(thetext, fstlen% + seclen% + thrdlen% + frthlen% + fithlen% + 1, sixlen%)

part7$ = Mid(thetext, fstlen% + seclen% + thrdlen% + frthlen% + fithlen% + sixlen% + 1, sevlen%)

part8$ = Mid(thetext, fstlen% + seclen% + thrdlen% + frthlen% + fithlen% + sixlen% + sevlen% + 1, eightlen%)

part9$ = Right(thetext, ninelen%)



'part1

textlen% = Len(part1$)

For i = 1 To textlen%

TextDone$ = Left(part1$, i)

LastChr$ = Right(TextDone$, 1)

ColorX = RGB(((B2 - B1) / textlen% * i) + B1, ((G2 - G1) / textlen% * i) + G1, ((R2 - R1) / textlen% * i) + R1)

colorx2 = RGBtoHEX(ColorX)



If Wavy = True Then

WaveState = WaveState + 1

If WaveState > 4 Then WaveState = 1

If WaveState = 1 Then WaveHTML = "^{"

If WaveState = 2 Then WaveHTML = "}"

If WaveState = 3 Then WaveHTML = "_{"

If WaveState = 4 Then WaveHTML = "}"

Else

WaveHTML = ""

End If



Faded1$ = Faded1$ + "" + TheHTML + LastChr$

Next i

'part2

textlen% = Len(part2$)

For i = 1 To textlen%

TextDone$ = Left(part2$, i)

LastChr$ = Right(TextDone$, 1)

ColorX = RGB(((B3 - B2) / textlen% * i) + B2, ((G3 - G2) / textlen% * i) + G2, ((R3 - R2) / textlen% * i) + R2)

colorx2 = RGBtoHEX(ColorX)



If Wavy = True Then

WaveState = WaveState + 1

If WaveState > 4 Then WaveState = 1

If WaveState = 1 Then WaveHTML = "^{"

If WaveState = 2 Then WaveHTML = "}"

If WaveState = 3 Then WaveHTML = "_{"

If WaveState = 4 Then WaveHTML = "}"

Else

WaveHTML = ""

End If



Faded2$ = Faded2$ + "" + TheHTML + LastChr$

Next i



'part3

textlen% = Len(part3$)

For i = 1 To textlen%

TextDone$ = Left(part3$, i)

LastChr$ = Right(TextDone$, 1)

ColorX = RGB(((B4 - B3) / textlen% * i) + B3, ((G4 - G3) / textlen% * i) + G3, ((R4 - R3) / textlen% * i) + R3)

colorx2 = RGBtoHEX(ColorX)



If Wavy = True Then

WaveState = WaveState + 1

If WaveState > 4 Then WaveState = 1

If WaveState = 1 Then WaveHTML = "^{"

If WaveState = 2 Then WaveHTML = "}"

If WaveState = 3 Then WaveHTML = "_{"

If WaveState = 4 Then WaveHTML = "}"

Else

WaveHTML = ""

End If



Faded3$ = Faded3$ + "" + TheHTML + LastChr$

Next i



'part4

textlen% = Len(part4$)

For i = 1 To textlen%

TextDone$ = Left(part4$, i)

LastChr$ = Right(TextDone$, 1)

ColorX = RGB(((B5 - B4) / textlen% * i) + B4, ((G5 - G4) / textlen% * i) + G4, ((R5 - R4) / textlen% * i) + R4)

colorx2 = RGBtoHEX(ColorX)



If Wavy = True Then

WaveState = WaveState + 1

If WaveState > 4 Then WaveState = 1

If WaveState = 1 Then WaveHTML = "^{"

If WaveState = 2 Then WaveHTML = "}"

If WaveState = 3 Then WaveHTML = "_{"

If WaveState = 4 Then WaveHTML = "}"

Else

WaveHTML = ""

End If



Faded4$ = Faded4$ + "" + TheHTML + LastChr$

Next i



'part5

textlen% = Len(part5$)

For i = 1 To textlen%

TextDone$ = Left(part5$, i)

LastChr$ = Right(TextDone$, 1)

ColorX = RGB(((B6 - B5) / textlen% * i) + B5, ((G6 - G5) / textlen% * i) + G5, ((R6 - R5) / textlen% * i) + R5)

colorx2 = RGBtoHEX(ColorX)



If Wavy = True Then

WaveState = WaveState + 1

If WaveState > 4 Then WaveState = 1

If WaveState = 1 Then WaveHTML = "^{"

If WaveState = 2 Then WaveHTML = "}"

If WaveState = 3 Then WaveHTML = "_{"

If WaveState = 4 Then WaveHTML = "}"

Else

WaveHTML = ""

End If



Faded5$ = Faded5$ + "" + TheHTML + LastChr$

Next i



'part6

textlen% = Len(part6$)

For i = 1 To textlen%

TextDone$ = Left(part6$, i)

LastChr$ = Right(TextDone$, 1)

ColorX = RGB(((B7 - B6) / textlen% * i) + B6, ((G7 - G6) / textlen% * i) + G6, ((R7 - R6) / textlen% * i) + R6)

colorx2 = RGBtoHEX(ColorX)



If Wavy = True Then

WaveState = WaveState + 1

If WaveState > 4 Then WaveState = 1

If WaveState = 1 Then WaveHTML = "^{"

If WaveState = 2 Then WaveHTML = "}"

If WaveState = 3 Then WaveHTML = "_{"

If WaveState = 4 Then WaveHTML = "}"

Else

WaveHTML = ""

End If



Faded6$ = Faded6$ + "" + TheHTML + LastChr$

Next i



'part7

textlen% = Len(part7$)

For i = 1 To textlen%

TextDone$ = Left(part7$, i)

LastChr$ = Right(TextDone$, 1)

ColorX = RGB(((B8 - B7) / textlen% * i) + B7, ((G8 - G7) / textlen% * i) + G7, ((R8 - R7) / textlen% * i) + R7)

colorx2 = RGBtoHEX(ColorX)



If Wavy = True Then

WaveState = WaveState + 1

If WaveState > 4 Then WaveState = 1

If WaveState = 1 Then WaveHTML = "^{"

If WaveState = 2 Then WaveHTML = "}"

If WaveState = 3 Then WaveHTML = "_{"

If WaveState = 4 Then WaveHTML = "}"

Else

WaveHTML = ""

End If



Faded7$ = Faded7$ + "" + TheHTML + LastChr$

Next i



'part8

textlen% = Len(part8$)

For i = 1 To textlen%

TextDone$ = Left(part8$, i)

LastChr$ = Right(TextDone$, 1)

ColorX = RGB(((B9 - B8) / textlen% * i) + B8, ((G9 - G8) / textlen% * i) + G8, ((R9 - R8) / textlen% * i) + R8)

colorx2 = RGBtoHEX(ColorX)



If Wavy = True Then

WaveState = WaveState + 1

If WaveState > 4 Then WaveState = 1

If WaveState = 1 Then WaveHTML = "^{"

If WaveState = 2 Then WaveHTML = "}"

If WaveState = 3 Then WaveHTML = "_{"

If WaveState = 4 Then WaveHTML = "}"

Else

WaveHTML = ""

End If



Faded8$ = Faded8$ + "" + TheHTML + LastChr$

Next i



'part9

textlen% = Len(part9$)

For i = 1 To textlen%

TextDone$ = Left(part9$, i)

LastChr$ = Right(TextDone$, 1)

ColorX = RGB(((B10 - B9) / textlen% * i) + B9, ((G10 - G9) / textlen% * i) + G9, ((R10 - R9) / textlen% * i) + R9)

colorx2 = RGBtoHEX(ColorX)



If Wavy = True Then

WaveState = WaveState + 1

If WaveState > 4 Then WaveState = 1

If WaveState = 1 Then WaveHTML = "^{"

If WaveState = 2 Then WaveHTML = "}"

If WaveState = 3 Then WaveHTML = "_{"

If WaveState = 4 Then WaveHTML = "}"

Else

WaveHTML = ""

End If



Faded9$ = Faded9$ + "" + TheHTML + LastChr$

Next i



FadeTenColor = Faded1$ + Faded2$ + Faded3$ + Faded4$ + Faded5$ + Faded6$ + Faded7$ + Faded8$ + Faded9$

End Function





Function InverseColor(OldColor)

'by monk-e-god

dacolor$ = RGBtoHEX(OldColor)

RedX% = Val("&H" + Right(dacolor$, 2))

GreenX% = Val("&H" + Mid(dacolor$, 3, 2))

BlueX% = Val("&H" + Left(dacolor$, 2))

newred% = 255 - RedX%

newgreen% = 255 - GreenX%

newblue% = 255 - BlueX%

InverseColor = RGB(newred%, newgreen%, newblue%)



End Function





Function Replacer(TheStr As String, This As String, WithThis As String)

'by monk-e-god

Dim STRwo13s As String

STRwo13s = TheStr

Do While InStr(1, STRwo13s, This)

DoEvents

thepos% = InStr(1, STRwo13s, This)

STRwo13s = Left(STRwo13s, (thepos% - 1)) + WithThis + Right(STRwo13s, Len(STRwo13s) - (thepos% + Len(This) - 1))

Loop



Replacer = STRwo13s

End Function

Function RGBtoHEX(RGB)

'heh, I didnt make this one...

a$ = Hex(RGB)

B% = Len(a$)

If B% = 5 Then a$ = "0" & a$

If B% = 4 Then a$ = "00" & a$

If B% = 3 Then a$ = "000" & a$

If B% = 2 Then a$ = "0000" & a$

If B% = 1 Then a$ = "00000" & a$

RGBtoHEX = a$

End Function



Function Rich2HTML(RichTXT As Control, StartPos%, EndPos%)

'by monk-e-god

Dim Bolded As Boolean

Dim Undered As Boolean

Dim Striked As Boolean

Dim Italiced As Boolean

Dim LastCRL As Long

Dim LastFont As String

Dim HTMLString As String



For posi% = StartPos To EndPos

RichTXT.SelStart = posi%

RichTXT.SelLength = 1



If Bolded <> RichTXT.SelBold Or posi% = StartPos Then

If RichTXT.SelBold = True Then

HTMLString = HTMLString + ""

Bolded = True

Else

HTMLString = HTMLString + ""

Bolded = False

End If

End If



If Undered <> RichTXT.SelUnderline Or posi% = StartPos Then

If RichTXT.SelUnderline = True Then

HTMLString = HTMLString + ""

Undered = True

Else

HTMLString = HTMLString + ""

Undered = False

End If

End If



If Striked <> RichTXT.SelStrikeThru Or posi% = StartPos Then

If RichTXT.SelStrikeThru = True Then

HTMLString = HTMLString + ""

Striked = True

Else

HTMLString = HTMLString + ""

Striked = False

End If

End If



If Italiced <> RichTXT.SelItalic Or posi% = StartPos Then

If RichTXT.SelItalic = True Then

HTMLString = HTMLString + ""

Italiced = True

Else

HTMLString = HTMLString + ""

Italiced = False

End If

End If



If LastCRL <> RichTXT.SelColor Or posi% = StartPos Then

ColorX = RGB(GetRGB(RichTXT.SelColor).Blue, GetRGB(RichTXT.SelColor).Green, GetRGB(RichTXT.SelColor).Red)

colorhex = RGBtoHEX(ColorX)

HTMLString = HTMLString + ""

LastCRL = RichTXT.SelColor

End If



If LastFont <> RichTXT.SelFontName Then

HTMLString = HTMLString + ""

LastFont = RichTXT.SelFontName

End If



HTMLString = HTMLString + RichTXT.SelText

Next posi%



Rich2HTML = HTMLString



End Function



Function HTMLtoRGB(TheHTML$)

'by monk-e-god

'converts HTML such as 0000FF to an

'RGB value like &HFF0000 so you can

'use it in the FadeByColor functions

If Left(TheHTML$, 1) = "#" Then TheHTML$ = Right(TheHTML$, 6)



RedX$ = Left(TheHTML$, 2)

GreenX$ = Mid(TheHTML$, 3, 2)

BlueX$ = Right(TheHTML$, 2)

rgbhex$ = "&H00" + BlueX$ + GreenX$ + RedX$ + "&"

HTMLtoRGB = Val(rgbhex$)

End Function

Function FadeFourColor(R1%, G1%, B1%, R2%, G2%, B2%, R3%, G3%, B3%, R4%, G4%, B4%, thetext$, Wavy As Boolean)

'by monk-e-god

Dim WaveState%

Dim WaveHTML$

WaveState = 0



textlen% = Len(thetext)



Do: DoEvents

fstlen% = fstlen% + 1: textlen% = textlen% - 1

If textlen% < 1 Then Exit Do

seclen% = seclen% + 1: textlen% = textlen% - 1

If textlen% < 1 Then Exit Do

thrdlen% = thrdlen% + 1: textlen% = textlen% - 1

If textlen% < 1 Then Exit Do

Loop Until textlen% < 1



part1$ = Left(thetext, fstlen%)

part2$ = Mid(thetext, fstlen% + 1, seclen%)

part3$ = Right(thetext, thrdlen%)



'part1

textlen% = Len(part1$)

For i = 1 To textlen%

TextDone$ = Left(part1$, i)

LastChr$ = Right(TextDone$, 1)

ColorX = RGB(((B2 - B1) / textlen% * i) + B1, ((G2 - G1) / textlen% * i) + G1, ((R2 - R1) / textlen% * i) + R1)

colorx2 = RGBtoHEX(ColorX)



If Wavy = True Then

WaveState = WaveState + 1

If WaveState > 4 Then WaveState = 1

If WaveState = 1 Then WaveHTML = "^{"

If WaveState = 2 Then WaveHTML = "}"

If WaveState = 3 Then WaveHTML = "_{"

If WaveState = 4 Then WaveHTML = "}"

Else

WaveHTML = ""

End If



Faded1$ = Faded1$ + "" + WaveHTML + LastChr$

Next i

'part2

textlen% = Len(part2$)

For i = 1 To textlen%

TextDone$ = Left(part2$, i)

LastChr$ = Right(TextDone$, 1)

ColorX = RGB(((B3 - B2) / textlen% * i) + B2, ((G3 - G2) / textlen% * i) + G2, ((R3 - R2) / textlen% * i) + R2)

colorx2 = RGBtoHEX(ColorX)



If Wavy = True Then

WaveState = WaveState + 1

If WaveState > 4 Then WaveState = 1

If WaveState = 1 Then WaveHTML = "^{"

If WaveState = 2 Then WaveHTML = "}"

If WaveState = 3 Then WaveHTML = "_{"

If WaveState = 4 Then WaveHTML = "}"

Else

WaveHTML = ""

End If



Faded2$ = Faded2$ + "" + WaveHTML + LastChr$

Next i



'part3

textlen% = Len(part3$)

For i = 1 To textlen%

TextDone$ = Left(part3$, i)

LastChr$ = Right(TextDone$, 1)

ColorX = RGB(((B4 - B3) / textlen% * i) + B3, ((G4 - G3) / textlen% * i) + G3, ((R4 - R3) / textlen% * i) + R3)

colorx2 = RGBtoHEX(ColorX)



If Wavy = True Then

WaveState = WaveState + 1

If WaveState > 4 Then WaveState = 1

If WaveState = 1 Then WaveHTML = "^{"

If WaveState = 2 Then WaveHTML = "}"

If WaveState = 3 Then WaveHTML = "_{"

If WaveState = 4 Then WaveHTML = "}"

Else

WaveHTML = ""

End If



Faded3$ = Faded3$ + "" + WaveHTML + LastChr$

Next i



FadeFourColor = Faded1$ + Faded2$ + Faded3$

End Function



Function FadeThreeColor(thetext$, R1%, G1%, B1%, R2%, G2%, B2%, R3%, G3%, B3%, Wavy As Boolean)

'by monk-e-god

Dim WaveState%

Dim WaveHTML$

WaveState = 0



textlen% = Len(thetext)

fstlen% = (Int(textlen%) / 2)

part1$ = Left(thetext, fstlen%)

part2$ = Right(thetext, textlen% - fstlen%)

'part1

textlen% = Len(part1$)

For i = 1 To textlen%

TextDone$ = Left(part1$, i)

LastChr$ = Right(TextDone$, 1)

ColorX = RGB(((B2 - B1) / textlen% * i) + B1, ((G2 - G1) / textlen% * i) + G1, ((R2 - R1) / textlen% * i) + R1)

colorx2 = RGBtoHEX(ColorX)



If Wavy = True Then

WaveState = WaveState + 1

If WaveState > 4 Then WaveState = 1

If WaveState = 1 Then WaveHTML = "^{"

If WaveState = 2 Then WaveHTML = "}"

If WaveState = 3 Then WaveHTML = "_{"

If WaveState = 4 Then WaveHTML = "}"

Else

WaveHTML = ""

End If



Faded1$ = Faded1$ + "" + WaveHTML + LastChr$

Next i

'part2

textlen% = Len(part2$)

For i = 1 To textlen%

TextDone$ = Left(part2$, i)

LastChr$ = Right(TextDone$, 1)

ColorX = RGB(((B3 - B2) / textlen% * i) + B2, ((G3 - G2) / textlen% * i) + G2, ((R3 - R2) / textlen% * i) + R2)

colorx2 = RGBtoHEX(ColorX)



If Wavy = True Then

WaveState = WaveState + 1

If WaveState > 4 Then WaveState = 1

If WaveState = 1 Then WaveHTML = "^{"

If WaveState = 2 Then WaveHTML = "}"

If WaveState = 3 Then WaveHTML = "_{"

If WaveState = 4 Then WaveHTML = "}"

Else

WaveHTML = ""

End If



Faded2$ = Faded2$ + "" + WaveHTML + LastChr$

Next i





FadeThreeColor = Faded1$ + Faded2$

End Function



Function FadeTwoColor(R1%, G1%, B1%, R2%, G2%, B2%, thetext$, Wavy As Boolean)

'by monk-e-god

Dim WaveState%

Dim WaveHTML$

WaveState = 0



textlen$ = Len(thetext)

For i = 1 To textlen$

TextDone$ = Left(thetext, i)

LastChr$ = Right(TextDone$, 1)

ColorX = RGB(((B2 - B1) / textlen$ * i) + B1, ((G2 - G1) / textlen$ * i) + G1, ((R2 - R1) / textlen$ * i) + R1)

colorx2 = RGBtoHEX(ColorX)



If Wavy = True Then

WaveState = WaveState + 1

If WaveState > 4 Then WaveState = 1

If WaveState = 1 Then WaveHTML = "^{"

If WaveState = 2 Then WaveHTML = "}"

If WaveState = 3 Then WaveHTML = "_{"

If WaveState = 4 Then WaveHTML = "}"

Else

WaveHTML = ""

End If



Faded$ = Faded$ + "" + WaveHTML + LastChr$

Next i

FadeTwoColor = Faded$

End Function

And then this goes in a timer so that the fader fades automatically

Private Sub Timer1_Timer()

If Option1.Value = False Then

Text2 = "" & FadeByColor2(Label1.BackColor, Label2.BackColor, Text1, False)

Call FadePreview2(RichTextBox1, Text2)

Else

Text2 = "" & FadeByColor2(Label1.BackColor, Label2.BackColor, Text1, True)

Call FadePreview2(RichTextBox1, Text2)

End If

End Sub

and to choose the color the code is this

Private Sub Command1_Click()

On Error GoTo Error_Event:

CommonDialog1.ShowColor

Label1.BackColor = CommonDialog1.Color

Error_Event:

Exit Sub

End Sub



Private Sub Command2_Click()

On Error GoTo Error_Event:

CommonDialog2.ShowColor

Label2.BackColor = CommonDialog2.Color

Error_Event:

Exit Sub

End Sub

Everything works fine its sends the fade to the room, but if the text is more then 5 letters it gives the eror of its too long or character not supported, lol wtf is that 🙄

January 11, 2007 at 2:14 pm #190122

s k 8 e r

Member

maybe you didnt code it for the colors to extend throughout the sentance, just the first 5 letters… i looked at it and i dont see anything wrong either, but then again i havnt coded in about 7 months…

January 11, 2007 at 2:53 pm #190121

Ponies

Member

Then again, this is 3 year’s old.

Author

Posts

Viewing 3 posts - 1 through 3 (of 3 total)

You must be logged in to reply to this topic.

Why this fader VB code dont work on paltalk

Related