Проблема с закрытием окна созд через WinAPI

[netdemon]

При закрытии окна вылетает IDE VB

Код: Выделить всё


Option Explicit

Public Declare Function RegisterClass Lib "user32" Alias "RegisterClassA" (Class As WNDCLASS) As Long
Public Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Long) As Long
Public Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Any) As Long
Public Declare Function LoadIcon Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As String) As Long
Public Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
'íåò îïèñàíèÿ
Public Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Public Declare Function TranslateMessage Lib "user32" (lpMsg As Msg) As Long
Public Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As Msg) As Long
Public Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)
Public Declare Function DestroyWindow Lib "user32.dll" (ByVal hwnd As Long) As Long


Public Type WNDCLASS
    style As Long
    lpfnwndproc As Long
    cbClsextra As Long
    cbWndExtra2 As Long
    hInstance As Long
    hIcon As Long
    hCursor As Long
    hbrBackground As Long
    lpszMenuName As String
    lpszClassName As String
End Type


Public Type POINTAPI
    x As Long
    y As Long
End Type


Public Type Msg
    hwnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type

Public Const CS_VREDRAW = &H1
Public Const CS_HREDRAW = &H2

Public Const CW_USEDEFAULT = &H80000000

Public Const ES_MULTILINE = &H4&

Public Const WS_EX_TRANSPARENT = &H20&
Public Const WS_EX_STATICEDGE = &H20000
Public Const WS_BORDER = &H800000
Public Const WS_CHILD = &H40000000
Public Const WS_OVERLAPPED = &H0&
Public Const WS_CAPTION = &HC00000 ' WS_BORDER Or WS_DLGFRAME
Public Const WS_SYSMENU = &H80000
Public Const WS_THICKFRAME = &H40000
Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
Public Const WS_DLGFRAME As Long = &H400000
Public Const WS_POPUP As Long = &H80000000

Public Const WS_EX_CLIENTEDGE = &H200&

Public Const COLOR_WINDOW = 5

Public Const WM_DESTROY = &H2
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202

Public Const IDC_ARROW = 32512&

Public Const IDI_APPLICATION = 32512&

Public Const GWL_WNDPROC = (-4)

Public Const SW_SHOWNORMAL = 1

Public Const MB_OK = &H0&
Public Const MB_ICONEXCLAMATION = &H30&


Public Const gClassName = "PopupWindow"
Public Const gAppName = "baloon"

Public gHwnd As Long

Public Sub Main()

   Dim wMsg As Msg


   If RegisterWindowClass = False Then Exit Sub
   
     
      If CreateWindows Then
         ''Loop will exit when WM_QUIT is sent to the window.
         Do While GetMessage(wMsg, 0&, 0&, 0&)
            ''TranslateMessage takes keyboard messages and converts
            ''them to WM_CHAR for easier processing.
            Call TranslateMessage(wMsg)
            ''Dispatchmessage calls the default window procedure
            ''to process the window message. (WndProc)
            Call DispatchMessage(wMsg)
         Loop
      End If

    Call UnregisterClass(gClassName$, App.hInstance)


End Sub

Public Function RegisterWindowClass() As Boolean

    Dim wc As WNDCLASS
   
   
    wc.style = CS_HREDRAW Or CS_VREDRAW
    wc.lpfnwndproc = GetAddress(AddressOf WndProc) 'Address in memory of default window procedure.
    wc.hInstance = App.hInstance
    wc.hIcon = LoadIcon(0&, IDI_APPLICATION) ' çíà÷îê ïî óìîë÷àíèþ
    wc.hCursor = LoadCursor(0&, IDC_ARROW) 'ñòàíäàðòíûé êóðñîð
    wc.hbrBackground = COLOR_WINDOW ' ñòàíäàðòíûé öâåò îêíà
    wc.lpszClassName = gClassName$

    RegisterWindowClass = RegisterClass(wc) <> 0
   
End Function

Public Function CreateWindows() As Boolean
 

    gHwnd& = CreateWindowEx(0&, gClassName$, gAppName$, WS_POPUP, CW_USEDEFAULT, CW_USEDEFAULT, 500, 190, 0&, 0&, App.hInstance, ByVal 0&)
    Call ShowWindow(gHwnd&, SW_SHOWNORMAL)
     CreateWindows = (gHwnd& <> 0)
   
End Function

Public Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

  Dim strTemp As String

    Select Case uMsg&
       Case WM_LBUTTONDOWN:
             
            Call PostQuitMessage(0&)
            DestroyWindow hwnd
            End
    End Select
   

 
  WndProc = DefWindowProc(hwnd&, uMsg&, wParam&, lParam&)

End Function
Public Function GetAddress(ByVal lngAddr As Long) As Long
    ''Used with AddressOf to return the address in memory of a procedure.

    GetAddress = lngAddr&
   
End Function




[jangle]

Все правильно, так и должно быть. Компилируй в EXE и потом запускай его для тестирования

[Хакер]

Убери Call PostQuitMessage(0&).

[netdemon]

Убери Call PostQuitMessage(0&).

Спс. Правда я уже сам допёр.

[Хакер]

Ок, если ты действительно сам допёр, скажи мне, netdemon, почему выполнение этой строчки приводило к вылету VB IDE ?

[netdemon]

Ок, если ты действительно сам допёр, скажи мне, netdemon, почему выполнение этой строчки приводило к вылету VB IDE ?

Точно сказать не могу, но догадываюсь что это окно запужено в другом потоке. И это действие вызывает закрытие окна в обход VB/ Вот он и залупается.

Просто сразу понятно, что если вылетает при закрытии, то ошибка в процедуре закрытия окна. Просто поменял на DestroyWindow А потом End

[Хакер]

Точно сказать не могу, но догадываюсь что это окно запужено в другом потоке. И это действие вызывает закрытие окна в обход VB/ Вот он и залупается.

Какой-же бред
И ещё: последнее слово - это что?

[netdemon]

Точно сказать не могу, но догадываюсь что это окно запужено в другом потоке. И это действие вызывает закрытие окна в обход VB/ Вот он и залупается.

Какой-же бред
И ещё: последнее слово - это что?

В общем для VB IDE этот проуесс ещё RunTime Хотя на самом деле его уже не существует и происходит конфликт. т. е по закрытию формы VB IDE не передаётся управление.

[Хакер]

Нет, всё равно бред.


На самом деле, пока проект запускается в VBIDE - он является частью процесса VBIDE. Т.е. по сути код твоей программы и код VB - одно целое, один процесс. Ты этот процесс сам закрываешь.

Т.е. если ты в скомпилированном EXE-шнике вызовешь ExitProcess то ты закроешь процесс, из которого ф-ция вызвана (т.е. Project1). Когда же ты вызываешь ExitProcess не из скомпилированного проекта, ты точно также акрываешь процесс, их которого эта ф-ция вызвана (в данном случае это процесс "vb6").

По той же самое причине, например, EbExecuteLine, позволяющаяя выполнять любой код, работает в IDE (ибо функция может получить доступ к АП VBIDE т.к. вызывается в контексте процесса "vb6", а значит - к таблицам идентификаторов, дереву разбора кода и т.д.), но не работает, когда ты откомпилировал код.

[netdemon]

Нет, всё равно бред.


На самом деле, пока проект запускается в VBIDE - он является частью процесса VBIDE. Т.е. по сути код твоей программы и код VB - одно целое, один процесс. Ты этот процесс сам закрываешь.

Т.е. если ты в скомпилированном EXE-шнике вызовешь ExitProcess то ты закроешь процесс, из которого ф-ция вызвана (т.е. Project1). Когда же ты вызываешь ExitProcess не из скомпилированного проекта, ты точно также акрываешь процесс, их которого эта ф-ция вызвана (в данном случае это процесс "vb6").

По той же самое причине, например, EbExecuteLine, позволяющаяя выполнять любой код, работает в IDE (ибо функция может получить доступ к АП VBIDE т.к. вызывается в контексте процесса "vb6", а значит - к таблицам идентификаторов, дереву разбора кода и т.д.), но не работает, когда ты откомпилировал код.

VB IDE точно писали долбодятлы.

[Al Khamid]

88

[Денис]

И ещё: последнее слово - это что?

Это мат. и даже не криптованый. Указанный термин происходит от слова, обозначающего крайнюю плоть мужского полового члена.
А вот дальше мат уже криптованый: фрагмент ёб был заменен на дятл.
Хм... Систематическое нарушение правил...