Attribute VB_Name = "modMain"
Option Explicit
Private Declare Function LoadIcon Lib "user32.dll" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As String) As Long
Private Declare Function LoadCursor Lib "user32.dll" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As String) As Long
Private Declare Function RegisterClass Lib "user32.dll" Alias "RegisterClassA" (ByRef Class As WNDCLASS) As Long
Private Declare Function CreateWindowEx Lib "user32.dll" 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, ByRef lpParam As Any) As Long
Private Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Private Declare Function DispatchMessage Lib "user32" Alias "ispatchMessageA" (lpMsg As Msg) As Long
Private Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Long) As Long
Private Declare Sub PostQuitMessage Lib "user32.dll" (ByVal nExitCode As Long)
Private Declare Function DefWindowProc Lib "user32.dll" Alias "efWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function CreateMenu Lib "user32.dll" () As Long
Private Declare Function AppendMenu Lib "user32.dll" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function CreateFont Lib "gdi32.dll" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal i As Long, ByVal u As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject 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
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
' Class styles
Public Const CS_VREDRAW = &H1
Public Const CS_HREDRAW = &H2
Public Const CS_KEYCVTWINDOW = &H4
Public Const CS_DBLCLKS = &H8
Public Const CS_OWNDC = &H20
Public Const CS_CLASSDC = &H40
Public Const CS_PARENTDC = &H80
Public Const CS_NOKEYCVT = &H100
Public Const CS_NOCLOSE = &H200
Public Const CS_SAVEBITS = &H800
Public Const CS_BYTEALIGNCLIENT = &H1000
Public Const CS_BYTEALIGNWINDOW = &H2000
Public Const CS_PUBLICCLASS = &H4000
' Standard ID's of icons
Public Const IDI_APPLICATION As Long = 32512&
Public Const IDI_ASTERISK As Long = 32516&
Public Const IDI_CLASSICON_OVERLAYFIRST As Long = 500
Public Const IDI_CLASSICON_OVERLAYLAST As Long = 502
Public Const IDI_CONFLICT As Long = 161
Public Const IDI_DISABLED_OVL As Long = 501
Public Const IDI_HAND As Long = 32513&
Public Const IDI_ERROR As Long = IDI_HAND
Public Const IDI_EXCLAMATION As Long = 32515&
Public Const IDI_FORCED_OVL As Long = 502
Public Const IDI_INFORMATION As Long = IDI_ASTERISK
Public Const IDI_PROBLEM_OVL As Long = 500
Public Const IDI_QUESTION As Long = 32514&
Public Const IDI_RESOURCE As Long = 159
Public Const IDI_RESOURCEFIRST As Long = 159
Public Const IDI_RESOURCELAST As Long = 161
Public Const IDI_RESOURCEOVERLAYFIRST As Long = 161
Public Const IDI_RESOURCEOVERLAYLAST As Long = 161
Public Const IDI_WARNING As Long = IDI_EXCLAMATION
Public Const IDI_WINLOGO As Long = 32517
' Standard ID's of cursors
Public Const IDC_ARROW = 32512&
Public Const IDC_IBEAM = 32513&
Public Const IDC_WAIT = 32514&
Public Const IDC_CROSS = 32515&
Public Const IDC_UPARROW = 32516&
Public Const IDC_SIZE = 32640&
Public Const IDC_ICON = 32641&
Public Const IDC_SIZENWSE = 32642&
Public Const IDC_SIZENESW = 32643&
Public Const IDC_SIZEWE = 32644&
Public Const IDC_SIZENS = 32645&
Public Const IDC_SIZEALL = 32646&
Public Const IDC_NO = 32648&
Public Const IDC_APPSTARTING = 32650&
' Color constants
Public Const COLOR_SCROLLBAR = 0
Public Const COLOR_BACKGROUND = 1
Public Const COLOR_ACTIVECAPTION = 2
Public Const COLOR_INACTIVECAPTION = 3
Public Const COLOR_MENU = 4
Public Const COLOR_WINDOW = 5
Public Const COLOR_WINDOWFRAME = 6
Public Const COLOR_MENUTEXT = 7
Public Const COLOR_WINDOWTEXT = 8
Public Const COLOR_CAPTIONTEXT = 9
Public Const COLOR_ACTIVEBORDER = 10
Public Const COLOR_INACTIVEBORDER = 11
Public Const COLOR_APPWORKSPACE = 12
Public Const COLOR_HIGHLIGHT = 13
Public Const COLOR_HIGHLIGHTTEXT = 14
Public Const COLOR_BTNFACE = 15
Public Const COLOR_BTNSHADOW = 16
Public Const COLOR_GRAYTEXT = 17
Public Const COLOR_BTNTEXT = 18
Public Const COLOR_INACTIVECAPTIONTEXT = 19
Public Const COLOR_BTNHIGHLIGHT = 20
' Window styles
Private Const WS_OVERLAPPED = &H0&
Private Const WS_POPUP = &H80000000
Private Const WS_CHILD = &H40000000
Private Const WS_MINIMIZE = &H20000000
Private Const WS_VISIBLE = &H10000000
Private Const WS_DISABLED = &H8000000
Private Const WS_CLIPSIBLINGS = &H4000000
Private Const WS_CLIPCHILDREN = &H2000000
Private Const WS_MAXIMIZE = &H1000000
Private Const WS_CAPTION = &HC00000 'WS_BORDER Or WS_DLGFRAME
Private Const WS_BORDER = &H800000
Private Const WS_DLGFRAME = &H400000
Private Const WS_VSCROLL = &H200000
Private Const WS_HSCROLL = &H100000
Private Const WS_SYSMENU = &H80000
Private Const WS_THICKFRAME = &H40000
Private Const WS_GROUP = &H20000
Private Const WS_TABSTOP = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_TILED = WS_OVERLAPPED
Private Const WS_ICONIC = WS_MINIMIZE
Private Const WS_SIZEBOX = WS_THICKFRAME
Private Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
Private Const WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW
Private Const WS_POPUPWINDOW = (WS_POPUP Or WS_BORDER Or WS_SYSMENU)
Private Const WS_CHILDWINDOW = (WS_CHILD)
Private Const ES_LEFT As Long = &H0&
Private Const ES_CENTER As Long = &H1&
Private Const ES_RIGHT As Long = &H2&
Private Const WS_EX_CLIENTEDGE As Long = &H200&
Private Const WS_EX_STATICEDGE As Long = &H20000
Private Const WS_EX_DLGMODALFRAME As Long = &H1&
Private Const WS_EX_TRANSPARENT As Long = &H20&
Private Const WS_EX_ACCEPTFILES As Long = &H10&
' ShowWindow commands
Public Const SW_HIDE = 0
Public Const SW_SHOWNORMAL = 1
Public Const SW_NORMAL = 1
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_MAXIMIZE = 3
Public Const SW_SHOWNOACTIVATE = 4
Public Const SW_SHOW = 5
Public Const SW_MINIMIZE = 6
Public Const SW_SHOWMINNOACTIVE = 7
Public Const SW_SHOWNA = 8
Public Const SW_RESTORE = 9
Public Const SW_SHOWDEFAULT = 10
Public Const SW_MAX = 10
' Window messages
Private Const WM_NULL = &H0
Private Const WM_CREATE = &H1
Private Const WM_DESTROY = &H2
Private Const WM_MOVE = &H3
Private Const WM_SIZE = &H5
Private Const WM_SETCURSOR As Long = &H20
Private Const WM_SETFONT As Long = &H30
Private Const WM_COMMAND As Long = &H111
Private Const WM_CTLCOLORBTN As Long = &H135
Private Const WM_MOUSEACTIVATE As Long = &H21
Private Const WM_PARENTNOTIFY As Long = &H210
Private Const WM_CONTEXTMENU As Long = &H7B
' Menu
Public Const MF_BITMAP As Long = &H4&
Public Const MF_CHECKED As Long = &H8&
Public Const MF_DISABLED As Long = &H2&
Public Const MF_ENABLED As Long = &H0&
Public Const MF_GRAYED As Long = &H1&
Public Const MF_MENUBREAK As Long = &H40&
Public Const MF_OWNERDRAW As Long = &H100&
Public Const MF_POPUP As Long = &H10&
Public Const MF_SEPARATOR As Long = &H800&
Public Const MF_STRING As Long = &H0&
Public Const MF_UNCHECKED As Long = &H0&
'Шрифт
Private Const FW_DONTCARE As Long = 0
Private Const FW_THIN As Long = 100
Private Const FW_EXTRALIGHT As Long = 200
Private Const FW_ULTRALIGHT As Long = FW_EXTRALIGHT
Private Const FW_LIGHT As Long = 300
Private Const FW_NORMAL As Long = 400
Private Const FW_REGULAR As Long = FW_NORMAL
Private Const FW_MEDIUM As Long = 500
Private Const FW_SEMIBOLD As Long = 600
Private Const FW_DEMIBOLD As Long = FW_SEMIBOLD
Private Const FW_BOLD As Long = 700
Private Const FW_EXTRABOLD As Long = 800
Private Const FW_ULTRABOLD As Long = FW_EXTRABOLD
Private Const FW_HEAVY As Long = 900
Private Const FW_BLACK As Long = FW_HEAVY

Private Const ANSI_CHARSET As Long = 0
Private Const DEFAULT_CHARSET As Long = 1
Private Const OEM_CHARSET As Long = 255

Private Const OUT_DEFAULT_PRECIS As Long = 0
Private Const CLIP_DEFAULT_PRECIS As Long = 0
Private Const PROOF_QUALITY As Long = 2
Private Const DEFAULT_PITCH As Long = 0

Dim hText1 As Long, hText2 As Long, hButton() As Long
Dim m As Integer, n As Integer, k As Integer
Public Sub Main()
    Dim wc As WNDCLASS
    Dim hwnd As Long
    Dim aMsg As Msg
    Dim hMenu As Long
    Dim hMenuP1 As Long
    Dim hMenuP2 As Long
    Dim hFont1 As Long
    Dim i As Integer, j As Integer
    wc.style = CS_HREDRAW Or CS_VREDRAW
    wc.lpfnwndproc = GetWndProc(AddressOf WndProc)
    wc.cbClsextra = 0
    wc.cbWndExtra2 = 0
    wc.hInstance = App.hInstance
    wc.hIcon = LoadIcon(0, IDI_APPLICATION)
    wc.hCursor = LoadCursor(0, IDC_ARROW)
    wc.hbrBackground = COLOR_WINDOW
    wc.lpszMenuName = 0
    wc.lpszClassName = "WindowClass"
    If RegisterClass(wc) <> 0 Then
        m = 8
        n = 8
        k = 10
        hMenuP1 = CreateMenu()
        hMenuP2 = CreateMenu()
        hMenu = CreateMenu()
        AppendMenu hMenuP1, MF_STRING, 6001, "New"
        AppendMenu hMenuP1, MF_STRING, 6002, "Exit"
        AppendMenu hMenu, MF_POPUP, hMenuP1, "Game"
        AppendMenu hMenuP2, MF_STRING, 6003, "About..."
        AppendMenu hMenu, MF_POPUP, hMenuP2, "Help"
        hwnd = CreateWindowEx(0, "WindowClass", "Win32API", (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_MINIMIZEBOX), 350, 200, 145, 202, 0, hMenu, App.hInstance, ByVal 0&
        hText1 = CreateWindowEx(WS_EX_CLIENTEDGE, "edit", CStr(k), WS_CHILD Or ES_CENTER Or WS_DISABLED, 0, 0, 58, 17, hwnd, 0, App.hInstance, ByVal 0&
        hText2 = CreateWindowEx(WS_EX_CLIENTEDGE, "edit", "00:00", WS_CHILD Or ES_CENTER Or WS_DISABLED, 79, 0, 58, 17, hwnd, 0, App.hInstance, ByVal 0&
        hFont1 = CreateFont(15, 0, 0, 0, FW_NORMAL, False, False, False, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, DEFAULT_PITCH, "MS Sans Serif"
        SendMessage hText1, WM_SETFONT, hFont1, 0
        SendMessage hText2, WM_SETFONT, hFont1, 0
        ReDim hButton(0 To m * n)
        hButton(0) = CreateWindowEx(0, "Button", "", WS_CHILD, 60, 0, 17, 17, hwnd, 7000 + 0, App.hInstance, ByVal 0&
        For j = 1 To n
            For i = 1 To m
                hButton(i + (j - 1) * m) = CreateWindowEx(0, "Button", "", WS_CHILD, 17 * j - 16, 17 * i + 2, 17, 17, hwnd, 7000 + i + (j - 1) * m, App.hInstance, ByVal 0&
            Next i
        Next j
        If hwnd <> 0 Then
            ShowWindow hwnd, SW_SHOWNORMAL
            ShowWindow hText1, SW_SHOWNORMAL
            ShowWindow hText2, SW_SHOWNORMAL
            For i = 0 To m * n
                ShowWindow hButton(i), SW_SHOWNORMAL
            Next i
            Do While GetMessage(aMsg, 0, 0, 0)
                ispatchMessage aMsg
            Loop
        End If
        eleteObject hFont1
        UnregisterClass "WindowClass", App.hInstance
    End If
End Sub
Private Function WndProc(ByVal hwnd As Long, ByVal message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case message
        Case WM_DESTROY
            PostQuitMessage (0)
        'Case WM_COMMAND
        '    ebug.Print message
    End Select
    WndProc = DefWindowProc(hwnd, message, wParam, lParam)
End Function
Function GetWndProc(ByVal lWndProc As Long) As Long
    GetWndProc = lWndProc
End Function

Форум - .NET

Форум - .NET

а на счет каркаса... куда столько констант ?

'--
wc.lpfnwndproc = GetWndProc(AddressOf WndProc)
'--

    Private Function WndProc(ByVal hwnd As Integer, ByVal message As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
        Select Case message
            Case WM_DESTROY
                PostQuitMessage(0)
                'Case WM_COMMAND
                '    ebug.Print message
        End Select
        WndProc = DefWindowProc(hwnd, message, wParam, lParam)
    End Function

    Function GetWndProc(ByVal lWndProc As Integer) As Integer
        GetWndProc = lWndProc
    End Function

GetMessage(aMsg, 0, 0, 0)

Module mdlWindowApi
    Private Declare Function RegisterClass Lib "user32.dll" Alias "RegisterClassA" (ByRef _Class As WNDCLASS) As Integer
    Private Declare Function CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" (ByVal dwExStyle As Integer, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hWndParent As Integer, ByVal hMenu As Integer, ByVal hInstance As Integer, ByRef lpParam As Integer) As Integer
    Private Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Integer, ByVal nCmdShow As Integer) As Integer
    Private Declare Function GetMessage Lib "user32" Alias "GetMessageA" (ByRef lpMsg As Msg, ByVal hwnd As Integer, ByVal wMsgFilterMin As Integer, ByVal wMsgFilterMax As Integer) As Integer
    Private Declare Function DispatchMessage Lib "user32" Alias "ispatchMessageA" (ByRef lpMsg As Msg) As Integer
    Private Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Integer) As Integer
    Private Declare Sub PostQuitMessage Lib "user32.dll" (ByVal nExitCode As Integer)
    Private Declare Function DefWindowProc Lib "user32.dll" Alias "efWindowProcA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer

    <Runtime.interopservices.structlayout(Runtime.InteropServices.LayoutKind.Sequential, pack:=1)> _
    Public Structure WNDCLASS
        Dim style As Integer
        Dim lpfnwndproc As ConnectedRapiDelegate
        Dim cbClsextra As Integer
        Dim cbWndExtra2 As Integer
        Dim hInstance As Integer
        Dim hIcon As Integer
        Dim hCursor As Integer
        Dim hbrBackground As Integer
        Dim lpszMenuName As String
        Dim lpszClassName As String
    End Structure

    Structure POINTAPI
        Dim x As Integer
        Dim y As Integer
    End Structure

    Structure Msg
        Dim hwnd As Integer
        Dim message As Integer
        Dim wParam As Integer
        Dim lParam As Integer
        Dim time As Integer
        Dim pt As POINTAPI
    End Structure

    Public Const COLOR_WINDOW = 5

    Private Const WS_OVERLAPPED = &H0&
    Private Const WS_CAPTION = &HC00000 'WS_BORDER Or WS_DLGFRAME

    Private Const WS_SYSMENU = &H80000
    Public Const SW_SHOWNORMAL = 1
    Private Const WM_DESTROY = &H2

    Const MyClassName As String = "My Class Mich 1.x"

    Public Sub Main()
        Dim wc As WNDCLASS
        Dim hwnd As Integer
        Dim aMsg As Msg
        wc.lpfnwndproc = AddressOf WndProc
        wc.cbClsextra = 0
        wc.cbWndExtra2 = 0
        wc.hbrBackground = COLOR_WINDOW
        wc.lpszMenuName = 0
        wc.lpszClassName = MyClassName
        If RegisterClass(wc) <> 0 Then
            hwnd = CreateWindowEx(0, MyClassName, "Win32API", (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU), 350, 200, 245, 202, 0, 0, 0, 0)
            If hwnd <> 0 Then
                ShowWindow(hwnd, SW_SHOWNORMAL)
                While GetMessage(aMsg, 0, 0, 0) <> 0
                    ispatchMessage(aMsg)
                End While
            End If
            UnregisterClass(MyClassName, 0)
        End If
    End Sub
    Delegate Function ConnectedRapiDelegate(ByVal hwnd As Integer, ByVal message As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    Private Function WndProc(ByVal hwnd As Integer, ByVal message As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
        Select Case message
            Case WM_DESTROY
                PostQuitMessage(0)
                'Case WM_COMMAND
                '    ebug.Print message
        End Select
        WndProc = DefWindowProc(hwnd, message, wParam, lParam)
    End Function
End Module