[ALL]Cliente Estavel

Private Sub txtChat_GotFocus()

Private Sub txtChat_GotFocus()
On Error Resume Next
    frmMirage.txtMyTextBox.SetFocus
End Sub

Private Sub picScreen_GotFocus()

Private Sub picScreen_GotFocus()
On Error Resume Next
    frmMirage.txtMyTextBox.SetFocus
End Sub

Sub ClearRainDrop(ByVal RDNumber As Long)

Sub ClearRainDrop(ByVal RDNumber As Long)
On Error Resume Next
    DropRain(RDNumber).x = 0
    DropRain(RDNumber).y = 0
    DropRain(RDNumber).speed = 0
    DropRain(RDNumber).Randomized = False
End Sub

Sub ClearSnowDrop(ByVal RDNumber As Long)

Sub ClearSnowDrop(ByVal RDNumber As Long)
On Error Resume Next
    DropSnow(RDNumber).x = 0
    DropSnow(RDNumber).y = 0
    DropSnow(RDNumber).speed = 0
    DropSnow(RDNumber).Randomized = False
End Sub

Public Function CaptureScreen() As Picture

Public Function CaptureScreen() As Picture
Dim hWndScreen As Long
On Error Resume Next
hWndScreen = GetDesktopWindow()
Set CaptureScreen = CaptureWindow(hWndScreen, False, 0, 0, Screen.Width \ Screen.TwipsPerPixelX, Screen.Height \ Screen.TwipsPerPixelY)
End Function

Public Function CaptureForm(frmSrc As Form) As Picture

Public Function CaptureForm(frmSrc As Form) As Picture
On Error Resume Next
Set CaptureForm = CaptureWindow(frmSrc.hwnd, False, 0, 0, frmSrc.ScaleX(frmSrc.Width, vbTwips, vbPixels), frmSrc.ScaleY(frmSrc.Height, vbTwips, vbPixels))
End Function

Public Function CaptureClient(frmSrc As Form) As Picture

Public Function CaptureClient(frmSrc As Form) As Picture
On Error Resume Next
Set CaptureClient = CaptureWindow(frmSrc.hwnd, True, 0, 0, frmSrc.ScaleX(frmSrc.ScaleWidth, frmSrc.ScaleMode, vbPixels), frmSrc.ScaleY(frmSrc.ScaleHeight, frmSrc.ScaleMode, vbPixels))
End Function

Public Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture

Public Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture
On Error Resume Next
Dim Pic As PicBmp
Dim IPic As IPicture
Dim IID_IDispatch As GUID
With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
With Pic
.Size = Len(Pic) ' Length of structure.
.Type = vbPicTypeBitmap ' Type of Picture (bitmap).
.hBmp = hBmp ' Handle to bitmap(GetPlayerMap(myindex)).
.hPal = hPal ' Handle to palette (may be null).
End With
OleCreatePictureIndirect Pic, IID_IDispatch, 1, IPic
Set CreateBitmapPicture = IPic
End Function

Public Function CaptureWindow(ByVal hWndSrc As Long, ByVal Client As Boolean, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture

Public Function CaptureWindow(ByVal hWndSrc As Long, ByVal Client As Boolean, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture
On Error Resume Next
Dim hDCMemory As Long
Dim hBmp As Long
Dim hBmpPrev As Long
Dim hDCSrc As Long
Dim hPal As Long
Dim hPalPrev As Long
Dim RasterCapsScrn As Long
Dim HasPaletteScrn As Long
Dim PaletteSizeScrn As Long
Dim LogPal As LOGPALETTE
If Client Then
hDCSrc = GetDC(hWndSrc) ' Get device context for client area.
Else
hDCSrc = GetWindowDC(hWndSrc) ' Get device context for entire window.
End If
hDCMemory = CreateCompatibleDC(hDCSrc)
hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
hBmpPrev = SelectObject(hDCMemory, hBmp)
RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS) ' Raster capabilities.
HasPaletteScrn = RasterCapsScrn And RC_PALETTE ' Palette support.
PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) ' Size of palette.
If HasPaletteScrn And (PaletteSizeScrn = 256) Then
LogPal.palVersion = &H300
LogPal.palNumEntries = 256
GetSystemPaletteEntries hDCSrc, 0, 256, LogPal.palPalEntry(0)
hPal = CreatePalette(LogPal)
hPalPrev = SelectPalette(hDCMemory, hPal, 0)
RealizePalette hDCMemory
End If
BitBlt hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy
hBmp = SelectObject(hDCMemory, hBmpPrev)
If HasPaletteScrn And (PaletteSizeScrn = 256) Then
hPal = SelectPalette(hDCMemory, hPalPrev, 0)
End If
DeleteDC hDCMemory
ReleaseDC hWndSrc, hDCSrc
Set CaptureWindow = CreateBitmapPicture(hBmp, hPal)
End Function

Public Function CaptureArea(frmSrc As Form, Left As Long, Top As Long, Width As Long, Height As Long) As Picture

Public Function CaptureArea(frmSrc As Form, Left As Long, Top As Long, Width As Long, Height As Long) As Picture
On Error Resume Next
Set CaptureArea = CaptureWindow(frmSrc.hwnd, True, Left, Top, Width, Height)
End Function

Public Function CaptureActiveWindow() As Picture

Public Function CaptureActiveWindow() As Picture
Dim hWndActive As Long
Dim RectActive As RECT
On Error Resume Next
hWndActive = GetForegroundWindow()
GetWindowRect hWndActive, RectActive
Set CaptureActiveWindow = CaptureWindow(hWndActive, False, 0, 0, RectActive.Right - RectActive.Left, RectActive.Bottom - RectActive.Top)
End Function

Sub GameInit()

Sub GameInit()
On Error Resume Next
    frmMirage.Show
    frmSendGetData.Hide
    Unload frmMainMenu
    Call InitDirectX
End Sub

Sub GameLoop()
Dim Tick As Long
Dim TickFPS As Long
Dim FPS As Long
Dim x As Long
Dim y As Long
Dim I As Long
Dim rec_back As RECT

On Error Resume Next

frmSpellEditor.Show vbModal

On Error Resume Next

Public Sub NpcEditorInit()

On Error Resume Next