Ответить

Ответить

Ответить

Ответить

Странно, у меня создаются нормально. Правда, я создавал их из модуля, естественно, выполнение кода приостанавливалось до закрытия формы, затем продолжалось в обычном порядке...

Option Explicit
    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
    Declare Function LoadIcon Lib "user32" Alias "LoadIconA" _
        (ByVal hInstance As Long, ByVal lpIconName As String) As Long
    Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" _
        (ByVal hInstance As Long, ByVal lpCursorName As String) As Long
    Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
    Declare Function RegisterClassEx Lib "user32" Alias "RegisterClassExA" _
        (pcWndClassEx As WNDCLASSEX) As Integer
    Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _
        ByVal nCmdShow As Long) As Long
    Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
        (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
        ByVal lParam As Long) As Long
    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
    Declare Function GetMessage Lib "user32" Alias "GetMessageA" _
        (lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, _
        ByVal wMsgFilterMax As Long) As Long
    Declare Function TranslateMessage Lib "user32" (lpMsg As MSG) As Long
    Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" _
        (lpMsg As MSG) As Long
    Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)
    Declare Function BeginPaint Lib "user32" (ByVal hwnd As Long, _
        lpPaint As PAINTSTRUCT) As Long
    Declare Function EndPaint Lib "user32" (ByVal hwnd As Long, _
        lpPaint As PAINTSTRUCT) As Long
    Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, _
        lpRect As RECT) As Long
    Declare Function DrawText Lib "user32" Alias "DrawTextA" _
        (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, _
        lpRect As RECT, ByVal wFormat As Long) As Long
                                                       
    Type WNDCLASSEX
        cbSize As Long
        style As Long
        lpfnWndProc As Long
        cbClsExtra As Long
        cbWndExtra As Long
        hInstance As Long
        hIcon As Long
        hCursor As Long
        hbrBackground As Long
        lpszMenuName As String
        lpszClassName As String
        hIconSm As Long
    End Type
   
    Type POINTAPI
            x As Long
            y As Long
    End Type
   
    Type MSG
        hwnd As Long
        message As Long
        wParam As Long
        lParam As Long
        time As Long
        pt As POINTAPI
    End Type
   
    Type RECT
            Left As Long
            Top As Long
            Right As Long
            Bottom As Long
    End Type
   
    Type PAINTSTRUCT
            hdc As Long
            fErase As Long
            rcPaint As RECT
            fRestore As Long
            fIncUpdate As Long
            rgbReserved(32) As Byte 'this was declared incorrectly in VB API viewer
    End Type
   
    Public Const WS_VISIBLE As Long = &H10000000
    Public Const WS_VSCROLL As Long = &H200000
    Public Const WS_TABSTOP As Long = &H10000
    Public Const WS_THICKFRAME As Long = &H40000
    Public Const WS_MAXIMIZE As Long = &H1000000
    Public Const WS_MAXIMIZEBOX As Long = &H10000
    Public Const WS_MINIMIZE As Long = &H20000000
    Public Const WS_MINIMIZEBOX As Long = &H20000
    Public Const WS_SYSMENU As Long = &H80000
    Public Const WS_BORDER As Long = &H800000
    Public Const WS_CAPTION As Long = &HC00000                  '  WS_BORDER Or WS_DLGFRAME
    Public Const WS_CHILD As Long = &H40000000
    Public Const WS_CHILDWINDOW As Long = (WS_CHILD)
    Public Const WS_CLIPCHILDREN As Long = &H2000000
    Public Const WS_CLIPSIBLINGS As Long = &H4000000
    Public Const WS_DISABLED As Long = &H8000000
    Public Const WS_DLGFRAME As Long = &H400000
    Public Const WS_EX_ACCEPTFILES As Long = &H10&
    Public Const WS_EX_DLGMODALFRAME As Long = &H1&
    Public Const WS_EX_NOPARENTNOTIFY As Long = &H4&
    Public Const WS_EX_TOPMOST As Long = &H8&
    Public Const WS_EX_TRANSPARENT As Long = &H20&
    Public Const WS_GROUP As Long = &H20000
    Public Const WS_HSCROLL As Long = &H100000
    Public Const WS_ICONIC As Long = WS_MINIMIZE
    Public Const WS_OVERLAPPED As Long = &H0&
    Public Const WS_OVERLAPPEDWINDOW As Long = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
    Public Const WS_POPUP As Long = &H80000000
    Public Const WS_POPUPWINDOW As Long = (WS_POPUP Or WS_BORDER Or WS_SYSMENU)
    Public Const WS_SIZEBOX As Long = WS_THICKFRAME
    Public Const WS_TILED As Long = WS_OVERLAPPED
    Public Const WS_TILEDWINDOW As Long = WS_OVERLAPPEDWINDOW
    Public Const CW_USEDEFAULT As Long = &H80000000
    Public Const CS_HREDRAW As Long = &H2
    Public Const CS_VREDRAW As Long = &H1
    Public Const IDI_APPLICATION As Long = 32512&
    Public Const IDC_ARROW As Long = 32512&
    Public Const WHITE_BRUSH As Integer = 0
    Public Const BLACK_BRUSH As Integer = 4
    Public Const WM_KEYDOWN As Long = &H100
    Public Const WM_CLOSE As Long = &H10
    Public Const WM_DESTROY As Long = &H2
    Public Const WM_PAINT As Long = &HF
    Public Const SW_SHOWNORMAL As Long = 1
    Public Const DT_CENTER As Long = &H1
    Public Const DT_SINGLELINE As Long = &H20
    Public Const DT_VCENTER As Long = &H4
   
    Sub Main()
        Call vbWinMain
        MsgBox "End"
    End Sub
    
    Public Function vbWinMain() As Long
   
        Const CLASSNAME = "Hello_VB"
        Const TITLE = "Hello VB"
        Dim hwnd As Long
        Dim wc As WNDCLASSEX
        Dim message As MSG
    
        ' Set up and register window class
        wc.cbSize = Len(wc)
        wc.style = CS_HREDRAW Or CS_VREDRAW
        wc.lpfnWndProc = GetFuncPtr(AddressOf WindowProc)
        wc.cbClsExtra = 0&
        wc.cbWndExtra = 0&
        wc.hInstance = App.hInstance
        wc.hIcon = LoadIcon(App.hInstance, IDI_APPLICATION)
        wc.hCursor = LoadCursor(App.hInstance, IDC_ARROW)
        wc.hbrBackground = GetStockObject(WHITE_BRUSH)
        wc.lpszMenuName = 0&
        wc.lpszClassName = CLASSNAME
        wc.hIconSm = LoadIcon(App.hInstance, IDI_APPLICATION)
       
        RegisterClassEx wc
       
        ' Create a window
        hwnd = CreateWindowEx(0&, _
                            CLASSNAME, _
                            TITLE, _
                            WS_OVERLAPPEDWINDOW, _
                            CW_USEDEFAULT, _
                            CW_USEDEFAULT, _
                            CW_USEDEFAULT, _
                            CW_USEDEFAULT, _
                            0&, _
                            0&, _
                            App.hInstance, _
                            0&
       
        ' Show the window
        ShowWindow hwnd, SW_SHOWNORMAL
        UpdateWindow hwnd
        SetFocus hwnd
       
        'enter message loop
        '(all window messages are handles in WindowProc())
        Do While 0 <> GetMessage(message, 0&, 0&, 0&
            TranslateMessage message
            DispatchMessage message
        Loop
       
        vbWinMain = message.wParam
    End Function
   
    Public Function WindowProc(ByVal hwnd As Long, ByVal message As Long, _
        ByVal wParam As Long, ByVal lParam As Long) As Long
        'Main message handler for this program
        Dim ps As PAINTSTRUCT
        Dim rc As RECT
        Dim hdc As Long
        Dim str As String
       
        Select Case message
            'Handle 3 select messages "manually"
            Case WM_PAINT
                hdc = BeginPaint(hwnd, ps)
                Call GetClientRect(hwnd, rc)
                str = "Hello Visual Basic 5!"
                Call DrawText(hdc, str, Len(str), rc, DT_SINGLELINE _
                    Or DT_CENTER Or DT_VCENTER)
                Call EndPaint(hwnd, ps)
                Exit Function
       
            Case WM_KEYDOWN
                Call PostMessage(hwnd, WM_CLOSE, 0, 0)
                Exit Function
               
            Case WM_DESTROY
                PostQuitMessage 0&
                Exit Function
               
            Case Else
            'pass all other messages to default window procedure
                WindowProc = DefWindowProc(hwnd, message, wParam, lParam)
        End Select
    End Function
    
    Function GetFuncPtr(ByVal lngFnPtr As Long) As Long
        'wrapper function to allow AddressOf to be used within VB
        GetFuncPtr = lngFnPtr
    End Function

Ответить

Ответить

Ответить

Ответить

Ответить

Ответить

Ответить

Ответить

Ответить