[Feature] Stat Progress bars and Transparent RTF Box

[Solodev]

Ok, so this is a 2 in one, as they are both very simple and easy to do. For MS4, although it could apply to any MS Code.
All of this is Client side.

Copy-Paste all of this in to a new module

Code:

Const GWL_EXSTYLE = (-20)
Const WS_EX_TRANSPARENT = &H20&
Const WS_EX_LAYERED = &H80000
Const LWA_ALPHA = &H2&

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function AlphaBlend Lib "msimg32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long, ByVal blendFunct As Long) As Boolean

Private Type BLENDFUNCTION
    BlendOp As Byte
    BlendFlags As Byte
    SourceConstantAlpha As Byte
    AlphaFormat As Byte
    End Type
Declare Sub ReleaseCapture Lib "user32" ()

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'    Const WM_SYSCOMMAND = &H112
'   Const SC_MOVE = &HF012
    Private Const WM_NCLBUTTONDOWN = &HA1
    Private Const HTCAPTION = 2

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Sub AlphaBlendControl(hwnd As Long)
Dim result As Long
'//set Richtext Box Backgroundstyle to t
'     ransparent
result = SetWindowLong(hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT)
End Sub

Public Sub Drag(hwnd As Long)

    ReleaseCapture
    Call SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End Sub
Public Sub ProgressBar(picBox As PictureBox, Percent As Integer, Optional FColor As Long = vbHighlight, Optional BColor As Long = vbWindowBackground)

    Dim u_Per As String
    Dim u_Left, u_Top, u_Right, u_Bottom, u_LineWidth
    picBox.AutoRedraw = True
    u_LineWidth = Screen.TwipsPerPixelX: u_Left = Screen.TwipsPerPixelX: u_Top = Screen.TwipsPerPixelY
    u_Right = picBox.ScaleWidth - (u_Left * 2): u_Bottom = picBox.ScaleHeight - (u_Top * 2)
    picBox.BackColor = BColor
    picBox.ForeColor = FColor
    If Percent > 100 Then Percent = 100: If Percent < 0 Then Percent = 0
    u_Per = CStr(Percent) & "%"
    picBox.DrawMode = vbCopyPen
    picBox.CurrentX = (u_Right - picBox.TextWidth(u_Per)) / 2
    picBox.CurrentY = (u_Bottom - picBox.TextHeight(u_Per)) / 2
    picBox.Print u_Per
    picBox.DrawMode = vbXorPen
    picBox.Line (u_Left, u_Top)-((u_Right / 100) * Percent, u_Bottom), FColor, BF
    picBox.Line (u_Left, u_Top)-((u_Right / 100) * Percent, u_Bottom), BColor, BF
End Sub

Ok, so now for the Transparent RTF Box
go to frmMirage, and find the Form_Load, and put this at the bottom...

Code:

AlphaBlendControl txtChat.hwnd

ok, so your done with that now

For custom progress bars, make 3 picureboxes, named pbHp, pbMp, and pbSp respectively.
go to modHandelData, and find and replace these three subs with these three (they are in a row, so when you find one, you have the other two)
here is the new code...

Code:

' ::::::::::::::::::::::
' :: Player hp packet ::
' ::::::::::::::::::::::
Private Sub HandlePlayerHp(ByRef Parse() As String)
     Dim Index As Long
     Index = CLng(Parse(1))
     Player(Index).MaxHp = CLng(Parse(2))
     Call SetPlayerVital(Index, Vitals.HP, CLng(Parse(3)))
     If Index = MyIndex Then
        If GetPlayerMaxVital(Index, Vitals.HP) > 0 Then
            'frmMirage.lblHP.Caption = Int(GetPlayerVital(Index, Vitals.HP) / GetPlayerMaxVital(Index, Vitals.HP) * 100) & "%"
            ProgressBar frmMirage.pbHp, Int(GetPlayerVital(Index, Vitals.HP) / GetPlayerMaxVital(Index, Vitals.HP) * 100), &HC0&, vbWhite
        End If
     End If
End Sub

' ::::::::::::::::::::::
' :: Player mp packet ::
' ::::::::::::::::::::::
Private Sub HandlePlayerMp(ByRef Parse() As String)
     Dim Index As Long
     Index = CLng(Parse(1))
     Player(Index).MaxMP = CLng(Parse(2))
     Call SetPlayerVital(Index, Vitals.MP, CLng(Parse(3)))
     If Index = MyIndex Then
        If GetPlayerMaxVital(Index, Vitals.MP) > 0 Then
            'frmMirage.lblMP.Caption = Int(GetPlayerVital(Index, Vitals.MP) / GetPlayerMaxVital(Index, Vitals.MP) * 100) & "%"
            ProgressBar frmMirage.pbMp, Int(GetPlayerVital(Index, Vitals.MP) / GetPlayerMaxVital(Index, Vitals.MP) * 100), &H800000, vbWhite
        End If
     End If
End Sub

' ::::::::::::::::::::::
' :: Player sp packet ::
' ::::::::::::::::::::::
Private Sub HandlePlayerSp(ByRef Parse() As String)
     Dim Index As Long
     Index = CLng(Parse(1))
     Player(Index).MaxSP = CLng(Parse(2))
     Call SetPlayerVital(Index, Vitals.SP, CLng(Parse(3)))
     If Index = MyIndex Then
        If GetPlayerMaxVital(Index, Vitals.SP) > 0 Then
            'frmMirage.lblSP.Caption = Int(GetPlayerVital(Index, Vitals.SP) / GetPlayerMaxVital(Index, Vitals.SP) * 100) & "%"
            ProgressBar frmMirage.pbSp, Int(GetPlayerVital(Index, Vitals.SP) / GetPlayerMaxVital(Index, Vitals.SP) * 100), &HC0C0&, vbWhite
        End If
     End If
End Sub

I have set the code colors in the progress bars to be that of the colors of the labels to represent the stats.

the final products should look like this.


Oh, and for any one that wants code on how to drag something (window, picture box...) use the code Drag.

[Solodev]

hope this helps. i know that Doomy wanted the transparent rtf box. comments and criticisms welcomed.

[brute]

Hi, does this feature require any components to run? Getting a Run-Time Error 91 after logging into the game.

Thanks.

[ShadowMaster]

Are you talking about transparent chat box? All you need is RichTxt32.ocx, which comes with Full VB6(not Portable).