COM 64

[JRS]

I have been using VB6 on Win7 to generate the SB IDE and COM examples. I used VS2008 to compile the C++ portions. It would be great if you could provide feedback on VS6 running on Win10.

[JRS]

I noticed an interesting project by Marc Pons that creates a OCX in FreeBasic. It also has a lite ATL container. I wonder if this could be ported to O2?

PlanetSquires Forum Link

Code: FreeBasic

1.  '      outgoing_test4.bas
2.  
3.  /'
4.  command line to compile exe test                       change according to your own paths
5.  "C:\Freebasic\fbc.exe" -x "C:\evolution_Outgoing5\Outgoing_test5.exe" -s console -v Outgoing_test5.bas > Outgoing_test5.log 2>&1
6.  
7.         that exe test can work with registered or not registered ocx ,
8.         because of the : Outgoing_test5.exe.Manifest
9.  
10.         wich do 2 actions , gives the xp behaviour for controls and makes the side by side "pseudo-registration" of ocx
11.  
12.         we could optionnaly put its content into rc
13.  
14.  
15.         note : the IOleWindow is not implemented here, because I do not yet know, how to use it to be able to getwindow  of container
16.  
17.  '/
18.  
19. '  CSED_FB specific : Name for RC module
20. #Define COMPIL_RC    Outgoing_test5.rc  ' with ou without double quotes !
21.  
22.  
23.  
24. #INCLUDE ONCE "windows.bi"
25.  
26. #Define Ax_NoAtl  'to use Ax_Lite5.bi without atl.dll functions , or when no visual control ( reduce size of exe)
27.                                                 ' here we decide to not use atl even visual control but using specific intern "container" usage
28.  
29. #INCLUDE ONCE "Ax_Lite5.bi"
30.  
31. #DEFINE RVB(a, b, c) bgr(a, b, c)
32.  
33. DIM SHARED g_hinstance as HINSTANCE
34. DIM SHARED Form1 AS HWND
35. DIM SHARED AS HWND         OcxHwnd      ' Ocx form handle
36. DIM SHARED AS HWND         OcxHwnd2     ' Ocx form handle
37.  
38.  
39. DECLARE SUB changeRVB(byval as integer)
40. Declare SUB Call_Sett()
41. DECLARE FUNCTION Form1_Proc(byval hWnd as HWND, byval Msg as UINT, byval wParam as WPARAM, byval lParam as LPARAM) as LRESULT
42. DECLARE SUB FormDefine()
43. Declare FUNCTION WINMAIN(BYVAL hInstance AS HINSTANCE, BYVAL hPrevInstance AS HINSTANCE, _
44.                                                                 BYVAL lpszCmdLine AS ZString PTR, BYVAL nCmdShow AS LONG) AS LONG
45.  
46.  
47.  
48. #INCLUDE ONCE "Comctrl5.bi"
49.  
50. AxInit(True) 'not really needed here
51.  
52. '**************************************************************
53. ' Other variables & constants used by the program go here
54. '**************************************************************
55. Dim Shared As IComCtrl Ptr              pVTI                    ,pVTI2
56. Dim Shared As Dword             obj_Event   , obj_Event2 ' cookie for object events
57.  
58.  
59.  
60. Sub Call_Init()                 ' be called from initialization of the control form
61.         OcxHwnd         = AxWinNoAtl(Form1, 50,50,200,150)      'create child window for "container"
62.         OcxHwnd2        = AxWinNoAtl(Form1,300,50,200,150)
63.         'print " OcxHwnd= " & str(OcxHwnd) & "       OcxHwnd2= " & str(OcxHwnd2)
64.  
65.         'pVTI   = AxCreate_Object ("ComCtrl.CD")                        'works but replaced by the : Ax_create_olecon doing more "natural" job
66.         'pVTI2  = AxCreate_Object ("ComCtrl.CD")
67.  
68.         pVTI    = Ax_create_olecon("ComCtrl.CD", OcxHwnd) 'using IOleWindow getwindow method throught pseudo-container
69.         pVTI2 = Ax_create_olecon("ComCtrl.CD", OcxHwnd2)
70.  
71.  
72.         'print  "pVTI  = " ;str(pVTI)
73.         'print  "pVTI2 = " ;str(pVTI2)
74.  
75.         if pVTI = NULL or pVTI2 = NULL THEN
76.                 MessageBox getactiveWindow(), "problem creating object, leaving...", "Error", 0
77.                 sendmessage(form1, WM_CLOSE, NULL, NULL)
78.                 exit sub
79.    END IF
80.  
81.         IOutGoing_Events_Connect (pVTI, Obj_Event  )
82.         IOutGoing_Events_Connect (pVTI2, Obj_Event2  ) ' do not understand why the second value is sometimes ok and sometimes 0
83.         Call_Sett() 'initial settings if you want some
84. End Sub
85.  
86.  
87. Sub Call_OnClose()                                                      ' normaly be called from close form command
88.         IOutGoing_Events_Disconnect (pVTI2, Obj_Event2)
89.         IOutGoing_Events_Disconnect (pVTI, Obj_Event)
90.         AxRelease_Object(pVTI2)
91.         AxRelease_Object(pVTI)                          'release object
92.  
93.         AxStop()  'not really needed it
94. End Sub
95.  
96.  
97. Sub Call_Sett()   'initial settings here
98.  
99. '       'ax_vt0 (pVTI, Initialize)                                                                                      'not needed because automatic initialisation
100. '       'ax_vt0 (pVTI2, Initialize)
101. '       'ax_vt (pVTI,CreateControl,cast(integer,OcxHwnd) )                      'not needed because automatic createcontrol
102. '       'ax_vt (pVTI2,CreateControl,cast(integer,OcxHwnd2) )
103.  
104.         ax_vt(pVTI, SetColor, RVB(0, 250, 250))
105.         ax_vt(pVTI2, SetColor, RVB(250, 250, 0))
106.  
107.         AxWinHide(OcxHwnd, form1)                                                                                       'to test only
108.         AxWinshow(OcxHwnd, form1)                                                                                       'to test only
109.  
110.         'print "   Obj_Event = " & str(Obj_Event) & "   Obj_Event2 = " & str(Obj_Event2)
111. End Sub
112.  
113.  
114.  
115. ' ========================================================================================
116. ' Main
117. ' ========================================================================================
118. End WinMain(GetModuleHandle(NULL), NULL, Command, SW_SHOW)
119.  
120. FUNCTION WINMAIN(BYVAL hInstance AS HINSTANCE, BYVAL hPrevInstance AS HINSTANCE, _
121.                                         BYVAL lpszCmdLine AS ZString PTR, BYVAL nCmdShow AS LONG) AS LONG
122.    DIM hwndMain AS HWND
123.    Dim hCtl AS HWND
124.    Dim hFont AS HFONT
125.    Dim wcex AS WNDCLASSEX
126.    Dim szClassName AS ZString * 80
127.  
128.    hFont = GetStockObject(ANSI_VAR_FONT)
129.  
130.    ' Register the window class
131.    szClassName = "Form1"
132.    g_hinstance = hInstance
133.    wcex.cbSize = SIZEOF(WNDCLASSEX)
134.    wcex.style = CS_HREDRAW OR CS_VREDRAW
135.    wcex.lpfnWndProc = @Form1_Proc
136.    wcex.cbClsExtra = 0
137.    wcex.cbWndExtra = 0
138.    wcex.hInstance = hInstance
139.    wcex.hCursor = LoadCursor(NULL, BYVAL IDC_ARROW)
140.    wcex.hbrBackground = cast(HBRUSH, COLOR_3DFACE + 1)
141.    wcex.lpszMenuName = NULL
142.    wcex.lpszClassName = STRPTR(szClassName)
143.    ' Sample, if resource icon: LoadIcon(hInst, "APPICON")
144.    wcex.hIcon = LoadIcon(NULL, BYVAL IDI_APPLICATION)
145.    ' Remember to set small icon too..
146.    wcex.hIconSm = LoadIcon(NULL, BYVAL IDI_APPLICATION)
147.    RegisterClassEx @wcex
148.  
149.    FormDefine()
150.  
151.    ' Message handler loop
152.    Dim uMsg AS MSG
153.    While GetMessage(@uMsg, NULL, 0, 0)
154.       'IF IsDialogMessage(hwndMain, @uMsg) = 0 THEN
155.          TranslateMessage @uMsg
156.          DispatchMessage @uMsg
157.       'END IF
158.    WEND
159.  
160.    FUNCTION = uMsg.wParam
161. END FUNCTION
162.  
163. '***************************************************************
164. ' Now let's create and load the form and all of its controls
165. '***************************************************************
166. SUB FormDefine()
167.    Form1 = CreateWindowEx(0, "Form1", "Test_5    for outgoing.ocx : registered or not !", _
168.          WS_MINIMIZEBOX or WS_SIZEBOX or WS_CAPTION or WS_MAXIMIZEBOX or WS_POPUP or WS_SYSMENU, _
169.          115, 180, 560, 300, HWND_DESKTOP, NULL, GetmoduleHandle(0), NULL)
170.         Call_Init()
171.    ShowWindow(Form1, SW_SHOW)
172. END SUB
173.  
174. '***************************************************************
175. ' Now that the form and its controls are loaded and on the
176. ' screen, we go into the event loop and wait for the user
177. ' to do something!
178. '***************************************************************
179.  
180. FUNCTION Form1_Proc(ByVal hWnd as HWND, byval Msg as UINT, byval wParam as WPARAM, byval lParam as LPARAM) as LRESULT
181.    SELECT Case Msg
182.                 CASE WM_CLOSE
183.                         Call_OnClose()
184.                         DestroyWindow(hWnd)
185.          EXIT FUNCTION
186.       CASE WM_DESTROY
187.          PostQuitMessage(0)
188.          EXIT FUNCTION
189.    END SELECT
190.    Return DefWindowProc(hWnd, Msg, wParam, lParam)
191. END FUNCTION
192.  

 

[Charles Pegge]

Aurel created an ATL-based browser example:

projectsB\Scintilla\WebBrowserATL.o2bas

It's in the wrong place, but it also uses awinh.inc

Code: [Select]

'gui-skeleton app
$ Filename "ABrowser.exe"
'Include "RTL32.inc"
Include "awinh.inc"

#lookahead
INT win,win2
INT x,y,w,h,x2,y2,w2,h2
x=0:y=10:w=800:h=600
x2=410:y2=10:w2=400:h2=300
INT winstyle,wstyle2,wbstyle
winstyle = WS_MINMAXSIZE or WS_CLIPCHILDREN
wbstyle = WS_CHILD OR WS_VISIBLE OR WS_BORDER
INT btt0,btt1,btt2
INT b0ID = 100, b1ID=101, b2ID=102
INT bmpB0,bmpB1,bmpB2,bmpB3,bmpB4,bmpB5
bmpB0 = LoadImage(0,"btBack.bmp",0,28,28,16)
bmpB1 = LoadImage(0,"data/btOpen.bmp",0,30,30,16)
bmpB2 = LoadImage(0,"data/btSave.bmp",0,30,30,16)
'##### GLOBALS  ###############################################
% WM_FORWARDMSG = &H37F ' (895)

% IDB_BACK = 1001
% IDB_FWRD = 1002
% IDB_NAVG = 1003
% IDC_URL  = 1004
% IDC_WB   = 1005

DECLARE FUNCTION AtlAxWinInit LIB "ATL.DLL" ALIAS "AtlAxWinInit" () AS LONG
DECLARE FUNCTION AtlAxGetControl LIB "ATL.DLL" ALIAS "AtlAxGetControl" ( BYVAL hWnd AS sys,BYREF pp AS sys ) as INT
INT hWb
'##############################################################
'create window **************************************************
win = SetWindow("ATL:Browser",x,y,w,h,0,winstyle)
'****************************************************************
'create buttons
btt0 = SetButton(win,4,4,30,30,"<<",0x50000080,0x200,b0ID)
SendMessage btt0 , BM_SETIMAGE, 0, bmpB0
btt1 = SetButton(win,38,4,30,30,"<<",0x50000080,0x200,b1ID)
SendMessage btt1 , BM_SETIMAGE, 0, bmpB1
btt2 = SetButton(win,74,4,30,30,"<<",0x50000080,0x200,b2ID)
SendMessage btt2 , BM_SETIMAGE, 0, bmpB2


'Initializes ATL
AtlAxWinInit   
'create browser window
hWb = CreateWindowEx(0, "AtlAxWin", "www.google.com",wbstyle , 4, 40, w-16,(h-56)-64, win, IDC_WB, 0, 0)
'****************************************************************

'/////////
Wait()
'\\\\\\\\\

Function WndProc (sys hwnd,wmsg,wparam,lparam) as sys callback

SELECT hwnd
'----------------------------------------
CASE win
'----------------------------------------
Select wmsg

CASE WM_CLOSE
DestroyWindow win
PostQuitMessage 0

CASE WM_SIZE
GetSize(win,0,0,w,h)
MoveWindow(hWb,4,40,w-6,(h-56)-32 ,1)
',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    CASE WM_COMMAND
controlID = LoWord(wParam) 'get control ID
notifyCode = HiWord(wParam) 'get notification message

Select controlID
   CASE b0ID
If notifycode=0         
          print "< GO BACK >"
End If
     
       CASE b1ID
         If notifycode=0         
         print "< GO FOR >"
         End If

       CASE b2ID
         If notifycode=0         
         print "TESTING....1...2....3"
         End If

    End Select
End select


END SELECT

RETURN Default

END FUNCTION


[JRS]

That's a great start for container support in O2, The work you did with DLLC and COM should also come in handy.

[jack]

It would be great if you could provide feedback on VS6 running on Win10.

hello John
I just ran a project that I had made for a friend, in the project I use the SendKeys function to send a tab key when enter is pressed, when run from the IDE, as long as I don't press enter, all is well, but as soon as I press enter I get a Runtime error 70, permission denied.
if I make the exe and run that exe from outside the IDE all is well.
so using VB6 in windows 10 is hindered by the fact that you can't test your program in progress unless you make the executable and run that from outside the IDE.

example sub using the SendKeys function

Code: [Select]

Private Sub Text14_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then                ' Enter = Tab
        SendKeys "{tab}"
        KeyAscii = 0
    End If
End Sub
[edit] I run the IDE as administrator.

[jack]

I found out that I am not the only one with the problem, here's a replacement SendKeys that works OK in Windows 10 http://www.vbforums.com/showthread.php?613838-sendkeys-error-permission-denied-70-in-vb&s=3cd7c5011274d5abb3fb124da67b7041&p=4531911&viewfull=1#post4531911

Code: [Select]

Public Sub Sendkeys(text$, Optional wait As Boolean = False)
   Dim WshShell As Object
   Set WshShell = CreateObject("wscript.shell")
   WshShell.Sendkeys text, wait
   Set WshShell = Nothing
End Sub


[jack]

with the VB6 IDE closed, if I double-click on a project then the VB6 IDE launches and opens the project as expected, but there's no "Error accessing the OLE registry"

[JRS]

Can you turn off UAC and see if your permission problem goes away?

[jack]

@John
turning off UAC does allow launching the VB6 IDE without problems, however the SendKeys problem remains unless I use the SendKeys substitute.
but I am not comfortable with having UAC off, if only one could selectively mark an application as safe without turning UAC off and without having to run as administrator.

[JRS]

It's amazing that Microsoft sees their own software as a security risk.

[José Roca]

You should already have learned that Microsoft doesn't give a shit about VB6.

[jack]

in my case, I needed a way to make a GUI application that would run on Windows 98 and VB6 fit the need very well, it was easy to learn by doing with the occasional web search for a particular solution to a problem.

[JRS]

You should already have learned that Microsoft doesn't give a shit about VB6.

VB classic was one of Microsoft's most successful product offerings. It is still a critical tool for SMBs.

Microsoft is supporting VB6 runtime until 2025. By that time everyone will be running Linux.

[José Roca]

"Was" is the key word.

[JRS]

If Microsoft open sources VB6, it's a new ball game.