热血江湖 窗口化VB代码

热血江湖 窗口化VB代码


GetINI = Left(RetStr, GetPrivateProfileString(AppName, ByVal KeyName, "", RetStr, Len(RetStr), INIfilename))   
End Function  
Private Function ncnr(lpADDress As Long) As Integer  
Dim hwnd As Long
Dim pid As Long ' 储存进程标识符( Process Id )   
Dim pHandle As Long ' 储存进程句柄   
hwnd = FindWindow(vbNullString, "YB_OnlineClient")   
' 取得进程标识符   
GetWindowThreadProcessId hwnd, pid   
' 使用进程标识符取得进程句柄   
pHandle = OpenProcess(PROCESS_ALL_ACCESS, False, pid)   
' 在内存地址中读取数据   
ReadProcessMemory pHandle, lpADDress, ByVal VarPtr(ncnr), 4, 0&   
' 关闭进程句柄   
CloseHandle hProcess   
End Function  
   
  
Private Sub Form_Load()   
   Text1.Text = GetINI("目录", "地址", App.Path & "\system.ini")

  
    nOrgWidth = GetDisplayWidth   
    nOrgHeight = GetDisplayHeight   
End Sub  
  
Private Sub Timer1_Timer()   
Dim P As POINTAPI   
Dim R As RECT   
Dim P1 As POINTAPI1   
Dim style As Long, newstyle As Long  
Dim exstyle As Long, newexstyle As Long  
Dim mWnd As Long  
Dim nWidth As Integer, nHeight As Integer, nColor As Integer  
Dim hwnd As Long  
Timer1.Enabled = False  
hwnd = FindWindow(vbNullString, "YB_OnlineClient") 'YB_OnlineClient   
'hwnd = GetForegroundWindow()   
If hwnd <> 0 Then  
'nColor = 0 表示不改变颜色   
            nWidth = 1024: nHeight = 768: nColor = 16   
           
    Call SetDisplayMode(nWidth, nHeight, nColor)   
GetWindowOrgEx hwnd, P '获取指定设备场景的逻辑窗口的起点   
GetWindowRect hwnd, R '获得整个窗口的范围矩形   
      
   
'————————————————————————————————————————   
style = GetWindowLong(hwnd, GWL_STYLE)                                                                             '|                                                                                                                               '|   

       style = style Or WS_CAPTION                                             '|
  newstyle = SetWindowLong(hwnd, GWL_STYLE, style)                             '|   
                                                                               '|口   
  exstyle = GetWindowLong(hwnd, GWL_EXSTYLE)                                   '|   
       exstyle = exstyle Or WS_EX_APPWINDOW Or WS_EX_WINDOWEDGE                '|   
   newexstyle = SetWindowLong(hwnd, GWL_EXSTYLE, exstyle)                      '|   
                                                                               '|   
mWnd = SetWindowPos(hwnd, HWND_TOPMOST, R.Left, R.Top, 800, 600, SWP_SHOWWINDOW Or SWP_DRAWFRAME)  '|   
'————————————————————————————————————————   
SetWindowOrgEx mWnd, R.Left, R.Top, P  
  
GetCursorPos P1  
SetCursorPos (P1.x1 - R.Left), (P1.y1 - R.Top)   
  
ShowWindow mWnd, SW_SHOWNORMAL   
UpdateWindow mWnd   
Else  
Timer1.Enabled = True  
End If  
End Sub     
Private Function SetDisplayMode(Width As Integer, Height As Integer, Color As Integer) As Long ', Freq As Long) As Long   
      
    Const DM_PELSWIDTH = &H80000   
    Const DM_PELSHEIGHT = &H100000   
    Const DM_BITSPERPEL = &H40000   
    Const DM_DISPLAYFLAGS = &H200000   
    Const DM_DISPLAYFREQUENCY = &H400000   
    With pNewMode   
        .dmSize = Len(pNewMode)   
        If Color = 0 Then 'Color = 0 时不更改屏幕颜色   
            .dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT   
        Else  
            .dmFields = DM_BITSPERPEL Or DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_DISPLAYFREQUENCY         
End If  
        .dmPelsWidth = Width   
        .dmPelsHeight = Height   
           
        If Color <> 0 Then  
        .dmBitsPerPel = Color   
        End If  
    End With  
    pOldMode = lstrcpy(pNewMode, pNewMode)   
    SetDisplayMode = ChangeDisplaySettings(pOldMode, 1)   
    Exit Function  
End Function  
Private Function GetDisplayWidth() As Integer  
    GetDisplayWidth = Screen.Width \ Screen.TwipsPerPixelX   

End Function  
Private Function GetDisplayHeight() As Integer  
    GetDisplayHeight = Screen.Height \ Screen.TwipsPerPixelY   
End Function  
Private Sub RestoreDisplayMode()   
    Call SetDisplayMode(nOrgWidth, nOrgHeight, 0)   
End Sub  
Private Sub Form_Unload(Cancel As Integer)   
    RestoreDisplayMode   
      
    DestroyWindow mWnd   
End Sub  
Private Sub Command2_Click()   
End  
End Sub

============================== 商业版发布站程序下载：发布站程序下载：

Tags：

作者：佚名