Создание объектов через API

[Oxygen]

Никто не подкинет пример создания визуальных объектов (включая формы) и полноценной работы с ними только средствами API? Помнится такой уже где-то был, но не могу найти.

[tyomitch]

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

'This project needs one form
' Also set StartupObject to 'Sub Main'
' (-> Project Properties -> General Tab -> Startup Object)
'---- Declarations
Declare Function RegisterClass Lib "user32" Alias "RegisterClassA" (Class As WNDCLASS) As Long
Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Long) As Long
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 DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode 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 Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Any) As Long
Declare Function DefMDIChildProc Lib "user32" Alias "DefMDIChildProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
' Define information of the window (pointed to by hWnd)
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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

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
' Window styles
Public Const WS_OVERLAPPED = &H0&
Public Const WS_POPUP = &H80000000
Public Const WS_CHILD = &H40000000
Public Const WS_MINIMIZE = &H20000000
Public Const WS_VISIBLE = &H10000000
Public Const WS_DISABLED = &H8000000
Public Const WS_CLIPSIBLINGS = &H4000000
Public Const WS_CLIPCHILDREN = &H2000000
Public Const WS_MAXIMIZE = &H1000000
Public Const WS_CAPTION = &HC00000                  ' WS_BORDER Or WS_DLGFRAME
Public Const WS_BORDER = &H800000
Public Const WS_DLGFRAME = &H400000
Public Const WS_VSCROLL = &H200000
Public Const WS_HSCROLL = &H100000
Public Const WS_SYSMENU = &H80000
Public Const WS_THICKFRAME = &H40000
Public Const WS_GROUP = &H20000
Public Const WS_TABSTOP = &H10000
Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_TILED = WS_OVERLAPPED
Public Const WS_ICONIC = WS_MINIMIZE
Public Const WS_SIZEBOX = WS_THICKFRAME
Public Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
Public Const WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW
Public Const WS_POPUPWINDOW = (WS_POPUP Or WS_BORDER Or WS_SYSMENU)
Public Const WS_CHILDWINDOW = (WS_CHILD)
' ExWindowStyles
Public Const WS_EX_DLGMODALFRAME = &H1&
Public Const WS_EX_NOPARENTNOTIFY = &H4&
Public Const WS_EX_TOPMOST = &H8&
Public Const WS_EX_ACCEPTFILES = &H10&
Public Const WS_EX_TRANSPARENT = &H20&
' 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 messages
Public Const WM_NULL = &H0
Public Const WM_CREATE = &H1
Public Const WM_DESTROY = &H2
Public Const WM_MOVE = &H3
Public Const WM_SIZE = &H5
' 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
' 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&
Public Const GWL_WNDPROC = -4

Dim hwnd2 As Long, hwnd3 As Long, old_proc As Long, new_proc As Long
Public Sub Main()
    'KPD-Team 1999
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Dim lngTemp As Long
    ' Register class
    If MyRegisterClass Then
        ' Window created?
        If MyCreateWindow Then
        ' Change the button's procedures
        ' Point to new address
            new_proc = GetMyWndProc(AddressOf ButtonProc)
            old_proc = SetWindowLong(hwnd2, GWL_WNDPROC, new_proc)
            ' Message loop
            MyMessageLoop
        End If
        ' Unregister Class
        MyUnregisterClass
    End If
End Sub
Private Function MyRegisterClass() As Boolean
    ' WNDCLASS-structure
    Dim wndcls As WNDCLASS
    wndcls.style = CS_HREDRAW + CS_VREDRAW
    wndcls.lpfnwndproc = GetMyWndProc(AddressOf MyWndProc)
    wndcls.cbClsextra = 0
    wndcls.cbWndExtra2 = 0
    wndcls.hInstance = App.hInstance
    wndcls.hIcon = 0
    wndcls.hCursor = LoadCursor(0, IDC_ARROW)
    wndcls.hbrBackground = COLOR_WINDOW
    wndcls.lpszMenuName = 0
    wndcls.lpszClassName = "myWindowClass"
    ' Register class
    MyRegisterClass = (RegisterClass(wndcls) <> 0)
End Function
Private Sub MyUnregisterClass()
    UnregisterClass "myWindowClass", App.hInstance
End Sub
Private Function MyCreateWindow() As Boolean
    Dim hWnd As Long
    ' Create the window
    hWnd = CreateWindowEx(0, "myWindowClass", "My Window", WS_OVERLAPPEDWINDOW, 0, 0, 400, 300, 0, 0, App.hInstance, ByVal 0&)
    ' The Button and Textbox are child windows
    hwnd2 = CreateWindowEx(0, "Button", "My button", WS_CHILD, 50, 55, 100, 25, hWnd, 0, App.hInstance, ByVal 0&)
    hwnd3 = CreateWindowEx(0, "edit", "My textbox", WS_CHILD, 50, 25, 100, 25, hWnd, 0, App.hInstance, ByVal 0&)
    If hWnd <> 0 Then ShowWindow hWnd, SW_SHOWNORMAL
    ' Show them
    ShowWindow hwnd2, SW_SHOWNORMAL
    ShowWindow hwnd3, SW_SHOWNORMAL
    ' Go back
    MyCreateWindow = (hWnd <> 0)
End Function
Private Function MyWndProc(ByVal hWnd As Long, ByVal message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case message
        Case WM_DESTROY
            ' Destroy window
            PostQuitMessage (0)
    End Select
    ' calls the default window procedure
    MyWndProc = DefWindowProc(hWnd, message, wParam, lParam)
End Function
Function GetMyWndProc(ByVal lWndProc As Long) As Long
    GetMyWndProc = lWndProc
End Function
Private Sub MyMessageLoop()
    Dim aMsg As Msg
    Do While GetMessage(aMsg, 0, 0, 0)
        DispatchMessage aMsg
    Loop
End Sub
Private Function ButtonProc(ByVal hWnd As Long, ByVal message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim x As Integer
    If (message = 533) Then
        x = MsgBox("You clicked on the button", vbOKOnly)
    End If
    ' calls the window procedure
    ButtonProc = CallWindowProc(old_proc, hWnd, message, wParam, lParam)
End Function


[Oxygen]

Большое спасибо. Но может у кого-нибудь есть примеры, как работать с другими элемантами управления? И еще, что может прглотить Execute Line (кажется так она записывается)?

[GSerg]

В принципе, всё достаточно просто...

Форма:

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

Option Explicit

Private Declare Function RegisterClass Lib "user32.dll" Alias "RegisterClassA" (Class As WNDCLASS) As Long
Private Declare Function CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As Any, 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
Private Declare Function LoadCursor Lib "user32.dll" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Any) As Long

Private 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

Private Const COLOR_BACKGROUND As Long = 1
Private Const COLOR_DESKTOP As Long = COLOR_BACKGROUND
Private Const IDC_ARROW As Long = 32512&
Private Const WS_VISIBLE As Long = &H10000000
Private Const WS_CHILD As Long = &H40000000
Private Const WS_OVERLAPPED As Long = &H0&
Private Const WS_CAPTION As Long = &HC00000
Private Const WS_SYSMENU As Long = &H80000
Private Const WS_THICKFRAME As Long = &H40000
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_MAXIMIZEBOX As Long = &H10000
Private Const WS_OVERLAPPEDWINDOW As Long = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
Private Const CBS_DROPDOWNLIST As Long = &H3&


Private Sub Command1_Click()
  Dim wnd As WNDCLASS, h As Long
 
  'При установке цвета фона можной пойти двумя путями:
  'либо создать brush и указать её handle, либо взять константу COLOR_
  'и прибавить к ней единицу.
  wnd.hbrBackground = COLOR_DESKTOP + 1
  wnd.hCursor = LoadCursor(0, IDC_ARROW)
  wnd.hInstance = App.hInstance
  wnd.lpfnwndproc = ReturnMe(AddressOf MainWndProc)
  wnd.lpszClassName = "MyWindowClass"
 
  RegisterClass wnd
 
  'Указываем ParentWindow лишь для того, чтобы созданное окно самоуничтожалось
  'при закрытии формы.
  h = CreateWindowEx(0, "MyWindowClass", "Меня можно таскать за любое место!", WS_VISIBLE Or WS_OVERLAPPEDWINDOW, 10, 10, 400, 400, Me.hwnd, 0, App.hInstance, ByVal 0&)
 
  CreateWindowEx 0, "BUTTON", "Кнопка1", WS_CHILD Or WS_VISIBLE, 10, 10, 70, 30, h, ID_MyButton1, App.hInstance, ByVal 0&
  CreateWindowEx 0, "BUTTON", "Кнопка2", WS_CHILD Or WS_VISIBLE, 100, 100, 70, 30, h, ID_MyButton2, App.hInstance, ByVal 0&
  CreateWindowEx 0, "COMBOBOX", "Списочек", WS_CHILD Or WS_VISIBLE Or CBS_DROPDOWNLIST, 100, 10, 150, 300, h, ID_ComboBox, App.hInstance, ByVal 0&
 
  Command1.Visible = False
End Sub

Модуль:

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

Option Explicit

Private Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32.dll" () As Long
Private Declare Function SendDlgItemMessage Lib "user32.dll" Alias "SendDlgItemMessageA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const WM_LBUTTONDOWN As Long = &H201
Private Const WM_NCHITTEST As Long = &H84
Private Const HTCAPTION As Long = 2
Private Const WM_NCLBUTTONDOWN As Long = &HA1
Private Const WM_COMMAND As Long = &H111
Private Const BN_CLICKED As Long = 0
Private Const CB_ADDSTRING As Long = &H143

'Создадим тут списочек ID элементов управления.
'При создании окна его ID назначается через параметр hMenu.
Public Const ID_MyButton1 = 1
Public Const ID_MyButton2 = 2
Public Const ID_ComboBox = 3

Public Function ReturnMe(ByVal r As Long) As Long
  ReturnMe = r
End Function

Public Function MainWndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  Dim nCode As Long, iID As Long
 
  Select Case uMsg
  Case WM_LBUTTONDOWN
    ReleaseCapture
    SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&
    MainWndProc = 0
  Case WM_COMMAND
    nCode = wParam / &H1000&
    iID = wParam And &HFFFF&
    Select Case iID
    Case ID_MyButton1
      If nCode = BN_CLICKED Then SendDlgItemMessage hwnd, ID_ComboBox, CB_ADDSTRING, 0, StrPtr(StrConv("Кликнули кнопку 1!", vbFromUnicode))
    Case ID_MyButton2
      If nCode = BN_CLICKED Then SendDlgItemMessage hwnd, ID_ComboBox, CB_ADDSTRING, 0, StrPtr(StrConv("Кликнули кнопку 2!", vbFromUnicode))
    End Select
    MainWndProc = 0
  Case Else
    MainWndProc = DefWindowProc(hwnd, uMsg, wParam, lParam)
  End Select
End Function

[Oxygen]

Спасибо, с этим я уже разобралась. Но набор создаваемых объектов, судя по тому, что мне выдал MSDN ограничен текстбоксом, кнопочками, комбобоксами, листбоксами, скроллбарами, и статическими элементами, в числе которых метки, фреймы и имейджи (но у них у всех сильно ограничено количество свойствт по сравнению с нормальными). Теперь вопрос, каким образом можно вывести нормальный Image, Checkbox, Option,всевозможные DriveListBox'ы, DirListBox'ы WebBrowser и MediaPlater и другие зарегестрированные компоненты. Это вообще реально?

[GSerg]

Это вообще реально, но это злостное прямое юзание activex... Даже не знаю, не пробовал.
Может, createobject? Но тогда как-то родителя надо указать... Ну ужас... Кстати, где его взять, родителя-то...

[Oxygen]

Не знаю где его взять, он типа как тоже должен создаваться.....

[tyomitch]

Спасибо, с этим я уже разобралась. Но набор создаваемых объектов, судя по тому, что мне выдал MSDN ограничен текстбоксом, кнопочками, комбобоксами, листбоксами, скроллбарами, и статическими элементами, в числе которых метки, фреймы и имейджи (но у них у всех сильно ограничено количество свойствт по сравнению с нормальными). Теперь вопрос, каким образом можно вывести нормальный Image, Checkbox, Option,всевозможные DriveListBox'ы, DirListBox'ы WebBrowser и MediaPlater и другие зарегестрированные компоненты. Это вообще реально?

CheckBox и OptionButton - это подвиды BUTTON, управляются флагами стилей при его создании.
Image и Label - это не контролы, а "указание" VB рисовать графику/текст в нужном месте. Как объекты, они не существуют.
DriveListBox и DirListBox - это жутко сложные контролы, которые VB реализует внутри себя. Аналог придётся писать самому.
WebBrowser и MediaPlayer - это ActiveX-контролы, они создаются с какими-то жуткими заморочками. Я пытался их создавать руками, но мне не удавалось. Может, с ними тебе GSerg поможет

[tyomitch]

Это вообще реально, но это злостное прямое юзание activex... Даже не знаю, не пробовал.
Может, createobject? Но тогда как-то родителя надо указать... Ну ужас... Кстати, где его взять, родителя-то...

DriveListBox и DirListBox - не эктивиксы, их так просто не создашь, придётся писать самому...
CreateObject здесь тоже не поможет, там до кучи совершенно особых действий происходит при создании.

[Oxygen]

Image и Label - это не контролы, а "указание" VB рисовать графику/текст в нужном месте. Как объекты, они не существуют.

А как же их события Click, MouseMove и пр. Их тоже ручками воссоздавать?

WebBrowser и MediaPlayer - это ActiveX-контролы, они создаются с какими-то жуткими заморочками. Я пытался их создавать руками, но мне не удавалось. Может, с ними тебе GSerg поможет

Будем надеяться, т.к. сама я с этим врят ли разберусь.....

[tyomitch]

Image и Label - это не контролы, а "указание" VB рисовать графику/текст в нужном месте. Как объекты, они не существуют.

А как же их события Click, MouseMove и пр. Их тоже ручками воссоздавать?

Ну да, ловить WM_MOUSEMOVE и WM_LBUTTONUP на контейнере и проверять, попадает в зону лейбла или нет.
А зачем тебе всё это, если не секрет? Я вот как-то свой слайдер писал, но у меня причина была - он должен был лежать на панели Word97. А у тебя что?

[GSerg]

Вот, опять попал...
Теперь мне придётся несколько дней читать msdn...
Сидел бы дома, отрезав телефонный кабель, так ведь нет...

[Oxygen]

А зачем тебе всё это, если не секрет? Я вот как-то свой слайдер писал, но у меня причина была - он должен был лежать на панели Word97. А у тебя что?

Что-то типа своей среды разработки. Сложно и долго объяснять. Но если бы я смогла добиться нормальной работы с объектами через API, то решились бы кое-какие проблемы, которые возникают так. Т.е. идея такая, засунуть все это в классы, и работать с этим через классы. Был вариарт создавать так контролы через Set и пр., но возникают проблемы при создании новых форм, да и так корявенько это все получается.

[GSerg]

Слушай, избавь меня от этого чтения
Поподробнее разъясни суть проблем и как бы ты хотела их решить, можешь личкой, если там что...

[Oxygen]

OK. Только, давай чуть попозже. Мне это не к спеху. Все равно я в пятницу уезжаю на юг. А когда приеду через день переезжаю в Москву. Посему, скорее всего заниматься этим проектом я начну не раньше, чем 1-ого сентября. Хорошо?

[tyomitch]

Я смог поместить MSComCtl2.DTPicker на окно, созданное через CreateWindowEx!
Ничего он там не делал - просто болтался - но и этого уже немало!

Кому-нибудь это всё интересно, кроме меня?

[GSerg]

Тём(и?ы?)ч! Вопросов глупых не задавай, а делись мудростью Тут или отдельным топиком с громким названием... эээ... ну, сам придумаешь

[tyomitch]

Мудрость вкратце:

1. Создание контрола (в WndProc):

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

        Case WM_CREATE:
           
            Dim Control As IOleControl, IID_IOleControl As UUID
            Dim ClsID_Control As UUID
            CLSIDFromProgID "MSComCtl2.DTPicker", ClsID_Control
            CLSIDFromString "{B196B288-BAB4-101A-B69C-00AA00341D07}", IID_IOleControl
            CoCreateInstance ClsID_Control, Nothing, CLSCTX_INPROC_SERVER, IID_IOleControl, Control
           
            Dim Site As clsSite
            Set ControlObject = Control
            Set Site = New clsSite
            Site.hWnd = hWnd
            ControlObject.SetClientSite Site
           
            Dim Persist As IPersistStreamInit
            Set Persist = Control
            Persist.InitNew
           
            With rc
                .Left = 50
                .Top = 85
                .Right = 150
                .Bottom = 110
            End With
            ControlObject.DoVerb OLEIVERB_INPLACEACTIVATE, ByVal 0&, Site, 0, hWndMain, rc

2. Класс clsSite:

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

Implements IOleClientSite
Implements IOleInPlaceSite
Implements IOleInPlaceFrame

Public hWnd As Long


Вместо всех заимплеменченных методов - пустышки, кроме:

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

Private Function IOleInPlaceSite_GetWindow() As Long
IOleInPlaceSite_GetWindow = hWnd
End Function

Private Sub IOleInPlaceSite_GetWindowContext(ppFrame As olelib.IOleInPlaceFrame, ppDoc As olelib.IOleInPlaceUIWindow, lprcPosRect As olelib.RECT, lprcClipRect As olelib.RECT, lpFrameInfo As olelib.OLEINPLACEFRAMEINFO)
Set ppFrame = Me
Set ppDoc = Nothing
lprcPosRect = Module1.rc
lprcClipRect = Module1.rc
With lpFrameInfo
    .cb = LenB(lpFrameInfo)
    .fMDIApp = False
    .hwndFrame = hWnd
    .haccel = 0
    .cAccelEntries = 0
End With
End Sub


Используется TLB собственного производства.
Готовый пример запощу, когда будет более-менее готово.

[tyomitch]

Так... Сегодня смог прицепиться к оповестителю изменения свойств.

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

            Dim Container As IConnectionPointContainer
            Set Container = Control
            Dim IID_IPropertyNotifySink As UUID
            CLSIDFromString "{9BFBBC02-EFF1-101A-84ED-00AA00341D07}", IID_IPropertyNotifySink
            Set PropertyNotifyPoint = Container.FindConnectionPoint(IID_IPropertyNotifySink)
            PropertyNotifyConnection = PropertyNotifyPoint.Advise(Site)

Завтра, если удастся, научусь ловить события, и запощу готовый пример.

[BP]

Вообще то это не очень хорошая идея - работать с COM объектами на API, если VB их и так поддерживает.
Просто добавь ActiveX конрол в ссылки проекта и все его свойства тебе будут доступны, т.к, VB за тебя делает опрос на его методы и свойства и генерирует для тебя события. Это уже зашито в виртуальную машину. C++ (не Visual), на котором написана Window работает исключительно с API функциями вот для него и существуют OLE API, а VB в есть переходничок, позволяющий работать с COM-объектами средствами VB.

Кстати CreateWindowEx создаёт не только стандартные или кустарные окна, но и окна Common Controls от IE(такие как ListView, TreeView, ImageList, Toolbar и т.д.)

[BP]

А стандартные VB-шные контролы скорее всего наследуют(один из принципов ООП) классы стандартных контролов Windows, но раширены для более удобной работы с ними VB-программистов.
Ведь все специаллизированные сообщения (LB_..., CB_..., WM_COMMAND) для них срабатывают.
Поэтому нет никакой разницы создашь ты стандартный контрол на API или на VB.

[tyomitch]

У меня ActiveX-контрол лежит не на форме, а на окне, созданном CreateWindowEx. "Стандартными средствами VB" я положить туда контрол из референсов, естественно, не смогу.

И вообще, ты мне весь кайф ломаешь!

PS. VB-программы именно компилируются, а не выполняются под виртуальной машиной.
Под ней они выполняются только в IDE.

[tyomitch]

Скинул проект в http://bbs.vbstreets.ru/viewtopic.php?t=9370

[GSerg]

Бедная Ксюша...


Ну ладно. Скажи мне, Тёмыч: tlb ведь нужно только на стадии проектирования, да? И в него можно загнаться описания любых интерфейсов, в том числе и не idispatch? Если да, то нафига мне CallFunction? Ссылку на мануальчик по созданию tlb не дашь?

[tyomitch]

Бедная Ксюша...

Это кто хоть?

Ну ладно. Скажи мне, Тёмыч: tlb ведь нужно только на стадии проектирования, да? И в него можно загнаться описания любых интерфейсов, в том числе и не idispatch? Если да, то нафига мне CallFunction? Ссылку на мануальчик по созданию tlb не дашь?

1. Да
2. Почти любых - должны использоваться только VB-совместимые типы.
unsigned long, например, использовать нельзя.
3. Правильно!
4. http://mastershome.net.ru/vbfaq/g02.htm
+ могу отвечать на возникающе вопросы

[GSerg]

Возник вопрос: фиговый мануал! Хочу хороший мануал по языку описания библиотек типов. Искать не буду, потому что не знаю, какой из найденных хороший...

[tyomitch]

Возник вопрос: фиговый мануал! Хочу хороший мануал по языку описания библиотек типов. Искать не буду, потому что не знаю, какой из найденных хороший...

Что именно надо-то? В смысле, какой считается "хорошим"?
Вот, на всякий случай, пара ссылок.
Туториал: http://www.devx.com/vb2themax/Article/19830/0/page/1
Референс: http://msdn.microsoft.com/library/en-us ... erence.asp

[GSerg]

Хороший - это полный и без ошибок
Туториал, наверное, не понадобится, а вот msdn рулит как всегда Интересно, есть это в моей локальной версии?..

ЗЫ: Ксюша - это Oxygen. Мы в её топике, не забыл ещё?

[Approximator]

Бедная Ксюша...

Это кто хоть?

ЗЫ: Ксюша - это Oxygen. Мы в её топике, не забыл ещё?

Ну, ты, Тёмыч, увлёкся!