Visual Basic 6.0 - Формы через WinAPI

Hello, Андрущенко!




'This project needs one form
' Also set StartupObject to 'Sub Main'

'---- 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

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&)

' Show them
ShowWindow hwnd2, SW_SHOWNORMAL
ShowWindow hwnd3, SW_SHOWNORMAL
' Go back

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


--
To prevent your mail from being filtered out, simply quote this line in your message body. A464E022
* Origin: Talk.Mail.Ru (2:5020/400)




Здравствуйте, All!

Переход с ActiveX DLL на ActiveX EXE позволил мне успешно решить две задачи
из трех поставленных.

1. В ActiveX DLL я не могу использовать немодальные формы, если
приложение, обратившееся к ней, не позволяет работать с немодальными
формы. Если же я из такого приложения обращаюсь к ActiveX EXE, то
получаю возможность использовать немодальные формы. В моем случае
такое приложение - Word 95.

2. Когда я обращался из Word'а 95 к системному диалогу GetOpenFileName,
запиханному в ActiveX DLL, то вместо русских букв в именах каталогов и
файлов получал абракадабру. При обращении к этому диалогу, запиханному
в ActiveX EXE, с русскими буквами проблем нет.

А вот с третьей задачей получился пролет.
Была проблема: если я в ActiveX создаю могучие коллекции, и перед
выходом из Word'а (любой версии), обращающегося к этой ActiveX, не
позабочусь сам об удалении коллекций, то Word автоматически начнет
избавляться от всех коллекций, повисая на время их удаления (со
стороны это выглядит именно как зависание). С ActiveX DLL, наверное,
эту проблему не решить, поскольку она работает в адресном пространстве
вызвавшего приложения. Я надеялся, что при переходе на ActiveX EXE всё
автоматом получится: Word нормально закроется, а ActiveX EXE
продолжить жить своей жизнью, избавляясь от коллекции в фоновом
режиме. Hе прошло...
Решается ли эта задача?

--
С уважением Hиколай Андрущенко


* Origin: Internet-Arkhangelsk Company (2:5020/400)




Happy New Year!



пиксел


столбце, а именно самый нижний ряд/правый столбец. Я думал

работает только на NT...

В MSDN написано, что эта функция действует начиная с Windows 95, но для 9x
недействительны операции вращения и обрезания. Отражение вроде бы должно
работать...

В конце концов можно построить эллипс по точкам через CreatePolygonRgn.

Кстати, описываемая проблема упомянута в статье KB83807.


--
Сергей Мерзликин
http://www.smsoft.ru/ru/


* Origin: Sovintel (2:5020/400)




Hello, Андрущенко!



Я полагаю (не проверял), что если в событии Class_Terminate положить в локальную переменную класса ссылку на Me, то объект не
уничтожится, пока ты её обратно не очистишь. Т.е. план такой: в Class_Terminate кладёшь такую ссылку и запускаешь таймер; в событии
таймера отключаешь его и очищаешь ссылку. Hадо ещё какой-то внутренний флаг завести, чтобы после очистки ссылки из события таймера
она не устанавливалась вновь из Class_Terminate. Тогда, я полагаю, закрытие Ворда и твоего сервера пойдут параллельно.

А вообще, я писал как-то примочку для Ворда и тоже в итоге вынужден был перейти от ActiveX DLL к ActiveX EXE, а потом к их
комбинации, когда пришлось сабклассить окно Ворда. Так что ты на верном пути :-)

ЗЫ А разве Ворд 95 поддерживает ActiveX?


--
To prevent your mail from being filtered out, simply quote this line in your message body. A464E022
* Origin: Talk.Mail.Ru (2:5020/400)




Ура! Всё работает.

--
С уважением Hиколай Андрущенко


* Origin: Internet-Arkhangelsk Company (2:5020/400)





news:000f01c3d075$d7454ce0$4598e2c2 [@] ASkrobov...


таймер; в событии


Имеется в виду: таймер, который контрол?



Hе-а...

Hо Ворд 95 поддерживает обычные DLL. Отсюда выход: делаем промежуточную
интерфейсную DLL на Си, содержащую описанную ниже функцию:

Declare Function ServerStart Lib "Word95VB.dll"(ServerName As String,
ServerObject As String, ServerFunc As String) As Long

И решаем этим наши проблемы.

--
С уважением Hиколай Андрущенко


* Origin: Internet-Arkhangelsk Company (2:5020/400)




Hello, Sergey!

14:30:00 +0000 (UTC):










Только не обрезания, а перекоса. Операцию обрезания делают в синагоге :-)


Hе-а. Специально поставил себе 2000, чтобы проверить. Там отражение работает, а в 9х - нет.
Если у тебя есть возможность проверить на обеих системах, могу мылом выслать пример. А можешь сам его за 5 минут написать.


Именно этого хотелось бы избежать.


Там призывают смириться с чёрти-чем, рисуемым CreateEllipticRgn. А я не хочу.

--
To prevent your mail from being filtered out, simply quote this line in your message body. A464E022
* Origin: Talk.Mail.Ru (2:5020/400)




Hello, Андрущенко!

16:40:06 +0000 (UTC):




Ага. Или тот code-only timer, который идёт с VB в числе самплесов.


--
To prevent your mail from being filtered out, simply quote this line in your message body. A464E022
* Origin: Talk.Mail.Ru (2:5020/400)







локальную переменную класса ссылку на Me, то объект не

Hет, в Class_Terminate слишком поздно это делать. Можно сделать так: в
обычном модуле завести глобальные ссылки на эти коллекции (или создать
специальный класс, который держит дополнительные ссылки на коллекции, а на
сам имеется глобальная ссылка в модуле). А в Class_Terminate установить
таймер на очистку глобальных ссылок.


--
Сергей Мерзликин
http://www.smsoft.ru/ru/


Class_Terminate кладёшь такую ссылку и запускаешь таймер; в событии

флаг завести, чтобы после очистки ссылки из события таймера

закрытие Ворда и твоего сервера пойдут параллельно.


* Origin: Sovintel (2:5020/400)







Вот что значит писать о том, чего не делал :-) А словарь дал значение,
близкое к тому, что делают в синагоге :-()




работает, а в 9х - нет.

выслать пример. А можешь сам его за 5 минут написать.

Да я и так верю. Hо пример готов посмотреть.



CreatePolygonRgn.


А нужен именно регион? Может, задача решается без регионов?

--
Сергей Мерзликин
http://www.smsoft.ru/ru/


* Origin: Sovintel (2:5020/400)