[Aporte] Sistema e Cursores Gráficos

por Shermie80 Vie Ago 23, 2013 11:11 am

Cliente

Agregamos un módulo clase con el nombre de clsCursor y adentro colocan:

Código:: Option Explicit Public Enum CursorType E_NORMAL = 0 E_ATTACK E_ARROW E_CAST E_WAIT E_SHOOT E_SHIP End Enum Private Const NUM_CURSORS = 6 Private hndlList(0 To NUM_CURSORS) As IPictureDisp Public Sub Parse_Form(ByRef aFrm As Form, Optional ByVal cType As CursorType = E_NORMAL) On Error Resume Next Dim aControl As Control Dim lngHandle As Long Select Case cType Case E_NORMAL lngHandle = vbDefault Case E_ATTACK lngHandle = vbCrosshair Case E_ARROW lngHandle = vbCrosshair Case E_CAST lngHandle = vbCrosshair Case E_WAIT lngHandle = vbHourglass Case E_SHOOT lngHandle = vbCrosshair Case E_SHIP lngHandle = vbCrosshair End Select For Each aControl In aFrm.Controls aControl.MouseIcon = hndlList(cType) aControl.MousePointer = vbCustom Next aFrm.MouseIcon = hndlList(cType) aFrm.MousePointer = vbCustom End Sub Public Function GetDefaultCursor(ByRef aFrm As Form) As CursorType Dim lngHandle As Long Select Case aFrm.MouseIcon.handle Case hndlList(E_NORMAL).handle GetDefaultCursor = E_NORMAL Case hndlList(E_ATTACK).handle GetDefaultCursor = E_ATTACK Case hndlList(E_ARROW).handle GetDefaultCursor = E_ARROW Case hndlList(E_CAST).handle GetDefaultCursor = E_CAST Case hndlList(E_WAIT).handle GetDefaultCursor = E_WAIT Case hndlList(E_SHOOT).handle GetDefaultCursor = E_SHOOT Case hndlList(E_SHIP).handle GetDefaultCursor = E_SHIP End Select End Function Public Sub Init() Set hndlList(E_NORMAL) = LoadResPicture("104", vbResCursor) Set hndlList(E_ATTACK) = LoadResPicture("102", vbResCursor) Set hndlList(E_ARROW) = LoadResPicture("101", vbResCursor) Set hndlList(E_CAST) = LoadResPicture("103", vbResCursor) Set hndlList(E_WAIT) = LoadResPicture("107", vbResCursor) Set hndlList(E_SHOOT) = LoadResPicture("106", vbResCursor) Set hndlList(E_SHIP) = LoadResPicture("105", vbResCursor) End Sub

En el modDeclaraciones declaramos:

Código:: Public FormParser As clsCursor

En el sub Main() abajo de:

Código:: LoadClientSetup

Colocan:

Código:: 'Cursores****** Set FormParser = New clsCursor Call FormParser.Init 'Cursores******

En el sub CloseClient ponen:

Código:: Set FormParser = Nothing

En el form_load del frmPres agregan:

Código:: Call FormParser.Parse_Form(Me, E_WAIT)

En el frmCrearPersonaje buscan:

Código:: If Not frmMain.Socket1.Connected Then

Y abajo ponen:

Código:: Call FormParser.Parse_Form(Me, E_WAIT)

Buscan:

Código:: Case eMessages.WorkRequestTarget

Y reemplazan el Select Case UsingSkill por este:

Código:: Select Case UsingSkill Case Magia Call FormParser.Parse_Form(frmMain, E_CAST) Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_TRABAJO_MAGIA, 100, 100, 120, 0, 0) Case Pesca Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_TRABAJO_PESCA, 100, 100, 120, 0, 0) Case Robar Call FormParser.Parse_Form(frmMain, E_SHOOT) Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_TRABAJO_ROBAR, 100, 100, 120, 0, 0) Case Talar Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_TRABAJO_TALAR, 100, 100, 120, 0, 0) Case Mineria Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_TRABAJO_MINERIA, 100, 100, 120, 0, 0) Case FundirMetal Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_TRABAJO_FUNDIRMETAL, 100, 100, 120, 0, 0) Case Proyectiles Call FormParser.Parse_Form(frmMain, E_ARROW) Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_TRABAJO_PROYECTILES, 100, 100, 120, 0, 0) End Select

En el sub HandleWorkRequestTarget reemplazan también el Select Case UsingSkill por este:

Código:: Select Case UsingSkill Case Magia Call FormParser.Parse_Form(frmMain, E_CAST) Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_TRABAJO_MAGIA, 100, 100, 120, 0, 0) Case Pesca Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_TRABAJO_PESCA, 100, 100, 120, 0, 0) Case Robar Call FormParser.Parse_Form(frmMain, E_SHOOT) Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_TRABAJO_ROBAR, 100, 100, 120, 0, 0) Case Talar Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_TRABAJO_TALAR, 100, 100, 120, 0, 0) Case Mineria Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_TRABAJO_MINERIA, 100, 100, 120, 0, 0) Case FundirMetal Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_TRABAJO_FUNDIRMETAL, 100, 100, 120, 0, 0) Case Proyectiles Call FormParser.Parse_Form(frmMain, E_ARROW) Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_TRABAJO_PROYECTILES, 100, 100, 120, 0, 0) End Select

En el form_load del frmCargando agregan:

Código:: Call FormParser.Parse_Form(Me, E_WAIT)

En el frmConnect buscan:

Código:: Private Sub imgAccion_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single

Y más abajo va a decir Case 0, bueno abajo del Case 0 agregan:

Código:: Call FormParser.Parse_Form(Me, E_WAIT)

En el form_load del frmConnect agregan:

Código:: Call FormParser.Parse_Form(frmConnect)

Reemplazan el Private Form_Load del frmMain por este:

Código:: Private Sub Form_Click() If Cartel Then Cartel = False #If SeguridadAlkon Then If LOGGING Then Call CheatingDeath.StoreKey(MouseBoton, True) #End If If Not Comerciando Then Call ConvertCPtoTP(MouseX, MouseY, tX, tY) If MouseShift = 0 Then If MouseBoton <> vbRightButton Then '[ybarra] If UsaMacro Then CnTd = CnTd + 1 If CnTd = 3 Then Call WriteUseSpellMacro CnTd = 0 End If UsaMacro = False End If '[/ybarra] If UsingSkill = 0 Then Call WriteLeftClick(tX, tY) Else If TrainingMacro.Enabled Then Call DesactivarMacroHechizos If macrotrabajo.Enabled Then Call DesactivarMacroTrabajo If Not MainTimer.Check(TimersIndex.Arrows, False) Then 'Check if arrows interval has finished. Call FormParser.Parse_Form(frmMain) UsingSkill = 0 With FontTypes(FontTypeNames.FONTTYPE_TALK) Call AddtoRichTextBox(frmMain.RecTxt, "No puedes lanzar proyectiles tan rápido.", .red, .green, .blue, .bold, .italic) End With Exit Sub End If 'Splitted because VB isn't lazy! If UsingSkill = Proyectiles Then If Not MainTimer.Check(TimersIndex.Arrows) Then Call FormParser.Parse_Form(frmMain) UsingSkill = 0 With FontTypes(FontTypeNames.FONTTYPE_TALK) Call AddtoRichTextBox(frmMain.RecTxt, "No puedes lanzar proyectiles tan rápido.", .red, .green, .blue, .bold, .italic) End With Exit Sub End If End If 'Splitted because VB isn't lazy! If UsingSkill = Magia Then If Not MainTimer.Check(TimersIndex.Attack, False) Then 'Check if attack interval has finished. If Not MainTimer.Check(TimersIndex.CastAttack) Then 'Corto intervalo de Golpe-Magia Call FormParser.Parse_Form(frmMain) UsingSkill = 0 With FontTypes(FontTypeNames.FONTTYPE_TALK) Call AddtoRichTextBox(frmMain.RecTxt, "No puedes lanzar hechizos tan rápido.", .red, .green, .blue, .bold, .italic) End With Exit Sub End If Else If Not MainTimer.Check(TimersIndex.CastSpell) Then 'Check if spells interval has finished. Call FormParser.Parse_Form(frmMain) UsingSkill = 0 With FontTypes(FontTypeNames.FONTTYPE_TALK) Call AddtoRichTextBox(frmMain.RecTxt, "No puedes lanzar hechizos tan rapido.", .red, .green, .blue, .bold, .italic) End With Exit Sub End If End If End If 'Splitted because VB isn't lazy! If (UsingSkill = Pesca Or UsingSkill = Robar Or UsingSkill = Talar Or UsingSkill = Mineria Or UsingSkill = FundirMetal) Then If Not MainTimer.Check(TimersIndex.Work) Then Call FormParser.Parse_Form(frmMain) UsingSkill = 0 Exit Sub End If End If Call FormParser.Parse_Form(frmMain) Call WriteWorkLeftClick(tX, tY, UsingSkill) UsingSkill = 0 End If Else Call AbrirMenuViewPort End If ElseIf (MouseShift And 1) = 1 Then If Not CustomKeys.KeyAssigned(KeyCodeConstants.vbKeyShift) Then If MouseBoton = vbLeftButton Then Call WriteWarpChar("YO", UserMap, tX, tY) End If End If End If End If End Sub

En el Private Sub Socket1_Disconnect() agregan:

Código:: Call FormParser.Parse_Form(frmConnect)

Reemplazan Private Sub Socket1_LastError el por este:

Código:: Private Sub Socket1_LastError(ErrorCode As Integer, ErrorString As String, Response As Integer) '********************************************* 'Handle socket errors '********************************************* If ErrorCode = 24036 Then Call MsgBox("Por favor espere, intentando completar conexion.", vbApplicationModal + vbInformation + vbOKOnly + vbDefaultButton1, "Error") Exit Sub End If Call MsgBox(ErrorString, vbApplicationModal + vbInformation + vbOKOnly + vbDefaultButton1, "Error") Call FormParser.Parse_Form(frmConnect) Response = 0 Second.Enabled = False frmMain.Socket1.Disconnect If Not frmCrearPersonaje.Visible Then frmConnect.Show Else Call FormParser.Parse_Form(frmConnect) End If End Sub