### Author Topic: First Lets Create A Simple Visual Basic 6 ActiveX Dll  (Read 12154 times)

0 Members and 1 Guest are viewing this topic.

#### Frederick J. Harris

• Hero Member
• Posts: 914
• User-Rate: +16/-0
• Gender:
##### First Lets Create A Simple Visual Basic 6 ActiveX Dll
« on: November 12, 2010, 03:43:06 AM »
Visual Basic 5-6 uses a class module to define a class.  The attached Visual Basic 6 project – vbVolumes, contains four files…

vbVolumes.vbw  -  Visual Basic Workspace File
vbVolumes.vbp  -  Visual Basic Project File
vbBdFtVols.cls -  Class Module Which Defines A Class To Calculate Board Foot Volumes Of Trees
vbCuFtVols.cls -  Class Module Which Defines A Class To Calculate Cubic Foot Volumes Of Trees

They are in vbVolumes.zip.  The latter two define classes named vbBdFtVols and vbCuFtVols.  Since I am a forester I decided to create classes that calculate the board foot and cubic foot volumes of trees.  I thought this might be more interesting and challenging than classes to square or cube a number, which was my first thought!

Just in the way of a quick background on this, to calculate the volume of a tree you need to measure its diameter with a special diameter tape which goes around the tree at four and one half feet above ground and reads the diameter instead of circumference.  Foresters term this Diameter At Breast Height or ‘Dbh’.  Then you need the height of the merchantable section of the tree in feet.  For sawtimber that usually goes to where the tree is 8 to 10 inches or so, and perhaps 4 inches for cubic volumes of pulpwood.

Foresters have come up with lots of various ways of determining the volumes of trees over the years – particularly board foot volumes (a board foot is twelve inches wide by twelve inches long and one inch thick), and the class vbBdFtVols has two different functions which return an answer based on somewhat different parameters and methods of calculation (both based on regression analysis of various tree data).

This is a project of type 'ActiveX Dll' project.  If you place these four files in some directory and open the vbp project file you should be able to compile the file to an ActiveX Dll by selecting the…

File  >>> Make vbVolumes.dll

Command.  When you do this Visual Basic will auto create various GUIDS (Globally Unique Identifiers) and place them in your Registry.  I might point out that every time you recompile the Dll Visual Basic erases the old Guids and recreates new ones.  This will likely faul you up later when experimenting with clients that are using no longer valid Guids from an older Type Library.

Here is the code in vbBdFtVols.cls.  I used the Enterprise Edition of Visual Basic 6 – sp5.

Code: [Select]
`‘vbBdFtVols.clsOption ExplicitPrivate m_iSpecies As IntegerPrivate m_sngDbh As SinglePrivate m_sngSawHt As SinglePrivate m_iCull As IntegerPrivate m_iFormClass As IntegerPrivate Sub Class_Initialize()  MsgBox ("Called vbBdFtVols Constructor, which in Visual Basic 6 Is The Class_Initialize() Method.")End SubPublic Property Get Species() As Integer  Species = m_iSpeciesEnd PropertyPublic Property Let Species(ByVal iSpecies As Integer)  m_iSpecies = iSpeciesEnd PropertyPublic Property Get Dbh() As Single  Dbh = m_sngDbhEnd PropertyPublic Property Let Dbh(ByVal sngDbh As Single)  m_sngDbh = sngDbhEnd PropertyPublic Property Get SawlogHeight() As Single  SawlogHeight = m_sngSawHtEnd PropertyPublic Property Let SawlogHeight(ByVal sngSawHt As Single)  m_sngSawHt = sngSawHtEnd PropertyPublic Property Get Cull() As Integer  Cull = m_iCullEnd PropertyPublic Property Let Cull(ByVal iCull As Integer)  m_iCull = iCullEnd PropertyPublic Property Get FormClass() As Integer  FormClass = m_iFormClassEnd PropertyPublic Property Let FormClass(ByVal iFormClass As Integer)  m_iFormClass = iFormClassEnd PropertyPublic Function PsuVolume() As Single  Dim sngVolume As Single    Select Case m_iSpecies    Case 1   'White pine      sngVolume = -1.5473 + 0.015473 * m_sngDbh ^ 2 * m_sngSawHt    Case 6   'Eastern Hemlock      sngVolume = -1.4596 + 0.014596 * m_sngDbh ^ 2 * m_sngSawHt    Case 9   'Pitch pine      sngVolume = -8.765 + 0.016652 * m_sngDbh ^ 2 * m_sngSawHt    Case 11  'Red pine      sngVolume = 2.1004 + 0.016583 * m_sngDbh ^ 2 * m_sngSawHt    Case 20  'Sugar maple      sngVolume = 6.2685 + 0.018561 * m_sngDbh ^ 2 * m_sngSawHt    Case 21  'Red maple      sngVolume = 3.1916 + 0.019514 * m_sngDbh ^ 2 * m_sngSawHt    Case 23      sngVolume = 0.26611 + 0.0064407 * m_sngDbh ^ 1.7856 * m_sngSawHt ^ 0.925    Case 24      sngVolume = 0.37396 + 0.005177 * m_sngDbh ^ 1.9066 * m_sngSawHt ^ 0.8959    Case 25      sngVolume = 0.26611 + 0.0064407 * m_sngDbh ^ 1.7856 * m_sngSawHt ^ 0.925    Case 26      sngVolume = 1.3054 + 0.0015993 * m_sngDbh ^ 1.6993 * m_sngSawHt ^ 1.2919    Case 27      sngVolume = 0.74824 + 0.0043476 * m_sngDbh ^ 1.6839 * m_sngSawHt ^ 1.0733    Case 28      sngVolume = 1.33203 + 0.0007995 * m_sngDbh ^ 1.9616 * m_sngSawHt ^ 1.3292    Case 30  'Red oak      sngVolume = 3.8571 + 0.019001 * m_sngDbh ^ 2 * m_sngSawHt    Case 31  'Black oak      sngVolume = 5.5413 + 0.017287 * m_sngDbh ^ 2 * m_sngSawHt    Case 32  'Scarlet oak      sngVolume = 8.9972 + 0.018597 * m_sngDbh ^ 2 * m_sngSawHt    Case 40  'White oak      sngVolume = 1.6115 + 0.018032 * m_sngDbh ^ 2 * m_sngSawHt    Case 48  'Chestnut oak      sngVolume = 5.3365 + 0.016602 * m_sngDbh ^ 2 * m_sngSawHt    Case 50  'Yellow birch      sngVolume = 5.0116 + 0.018606 * m_sngDbh ^ 2 * m_sngSawHt    Case 51  'Black birch      sngVolume = 4.9108 + 0.018451 * m_sngDbh ^ 2 * m_sngSawHt    Case 54  'American beech      sngVolume = 21.2024 + 0.017985 * m_sngDbh ^ 2 * m_sngSawHt    Case 55  'White ash      sngVolume = 9.2369 + 0.017288 * m_sngDbh ^ 2 * m_sngSawHt    Case 58  'American basswood      sngVolume = 4.5357 + 0.019424 * m_sngDbh ^ 2 * m_sngSawHt    Case 59  'Yellow poplar      sngVolume = 15.283 + 0.01634 * m_sngDbh ^ 2 * m_sngSawHt    Case 63  'Black gum      sngVolume = 0.0917 + 0.020303 * m_sngDbh ^ 2 * m_sngSawHt    Case 76  'Black cherry      sngVolume = 16.0039 + 0.016487 * m_sngDbh ^ 2 * m_sngSawHt    Case Else      sngVolume = 4.9092 + 0.016363 * m_sngDbh ^ 2 * m_sngSawHt  End Select    PsuVolume = sngVolume * (100 - m_iCull) / 100End FunctionPublic Function FormClassVolume() As Single  FormClassVolume = _  (1.52968 * (m_sngSawHt / 16) ^ 2 + 9.58615 * (m_sngSawHt / 16) - 13.35212) + _  (1.7962 - 0.27465 * (m_sngSawHt / 16) ^ 2 - 2.59995 * (m_sngSawHt / 16)) * m_sngDbh + _  (0.04482 - 0.00961 * (m_sngSawHt / 16) ^ 2 + 0.45997 * (m_sngSawHt / 16)) * m_sngDbh ^ 2 * _  ((m_iFormClass - 78) * 0.03 + 1)End FunctionPrivate Sub Class_Terminate()  MsgBox ("Called The vbBdFtVols Destructor, Which In Visual Basic 6 Is The Class_Terminate Method.")End Sub`
And here is the code in vbCuFtVols.cls

Code: [Select]
`‘vbCuFtVols.clsOption ExplicitPrivate m_iSpecies As IntegerPrivate m_sngDbh As SinglePrivate m_sngSawHt As SinglePrivate m_iCull As IntegerPrivate Sub Class_Initialize()  MsgBox ("Called The vbCuFtVols Constructor, Which In Visual Basic 6 Is The Class_Initialize Method")End SubPublic Property Get Species() As Integer  Species = m_iSpeciesEnd PropertyPublic Property Let Species(ByVal iSpecies As Integer)  m_iSpecies = iSpeciesEnd PropertyPublic Property Get Dbh() As Single  Dbh = m_sngDbhEnd PropertyPublic Property Let Dbh(ByVal sngDbh As Single)  m_sngDbh = sngDbhEnd PropertyPublic Property Get SawlogHeight() As Single  SawlogHeight = m_sngSawHtEnd PropertyPublic Property Let SawlogHeight(ByVal sngSawHt As Single)  m_sngSawHt = sngSawHtEnd PropertyPublic Property Get Cull() As Integer  Cull = m_iCullEnd PropertyPublic Property Let Cull(ByVal iCull As Integer)  m_iCull = iCullEnd PropertyPublic Function PsuVolume() As Single  Dim sngVolume As Single    Select Case m_iSpecies    Case 30      sngVolume = 0.37396 + 0.005177 * m_sngDbh ^ 1.9066 * m_sngSawHt ^ 0.8959    Case 23      sngVolume = 0.26611 + 0.0064407 * m_sngDbh ^ 1.7856 * m_sngSawHt ^ 0.925    Case 24      sngVolume = 0.37396 + 0.005177 * m_sngDbh ^ 1.9066 * m_sngSawHt ^ 0.8959    Case 25      sngVolume = 0.26611 + 0.0064407 * m_sngDbh ^ 1.7856 * m_sngSawHt ^ 0.925    Case 26      sngVolume = 1.3054 + 0.0015993 * m_sngDbh ^ 1.6993 * m_sngSawHt ^ 1.2919    Case 27      sngVolume = 0.74824 + 0.0043476 * m_sngDbh ^ 1.6839 * m_sngSawHt ^ 1.0733    Case 28      sngVolume = 1.33203 + 0.0007995 * m_sngDbh ^ 1.9616 * m_sngSawHt ^ 1.3292    Case Else      sngVolume = 0.26611 + 0.0064407 * m_sngDbh ^ 1.7856 * m_sngSawHt ^ 0.925  End Select    PsuVolume = sngVolume * (100 - m_iCull) / 100End FunctionPrivate Sub Class_Terminate()  MsgBox ("Called The vbCuFtVols Destructor, Which In Visual Basic 6 Is The Class_Terminate Method")End Sub`
« Last Edit: November 13, 2010, 05:42:40 PM by Frederick J. Harris »

#### Frederick J. Harris

• Hero Member
• Posts: 914
• User-Rate: +16/-0
• Gender:
##### Now Lets Create A Visual Basic 6 Project To Connect To The ActiveX Dll
« Reply #1 on: November 12, 2010, 03:47:25 AM »
The Visual Basic 6 project prjVolume connects to the ActiveX Dll just discussed and when you click on the Form it prints to the form both board foot volume results and the cubic foot volume of one tree.  By the way, we use species codes for the tree species and 30 is Red oak, 31 Black oak, 32 Scarlet oak, etc.  Here is the code in frmVolume.frm…

Code: [Select]
`‘frmVolume.frmOption ExplicitPrivate Sub Form_Click()  Dim objBFVol As New vbBdFtVols  Dim objCFVol As New vbCuFtVols      With objBFVol    .Species = 30    .Dbh = 16#    .SawlogHeight = 48#    .Cull = 0    .FormClass = 78  End With  Me.Print "objBFVol.PsuVolume= "; objBFVol.PsuVolume  Me.Print "objBFVol.FormClassVolume= "; objBFVol.FormClassVolume  With objCFVol    .Species = 23    .Dbh = 10#    .SawlogHeight = 48#    .Cull = 0  End With  Me.Print "objCFVol.PsuVolume= "; objCFVol.PsuVolumeEnd Sub`
The prjVolume.zip file contains the above code file plus the project (vbp) and workspace file (vbw).  Note that to get the project to connect to the ActiveX Dll you need to go to the…

Project   >>>> References….

Dialog and check the vbVolumes item from the available references in the listbox.  As I previously mentioned, if you recompile the ActiveX Dll you’ll need to repeat the References step because Visual Basic keeps changing Guids.

« Last Edit: November 13, 2010, 04:56:26 AM by Frederick J. Harris »

#### Frederick J. Harris

• Hero Member
• Posts: 914
• User-Rate: +16/-0
• Gender:
##### Time To Create A PowerBASIC Windows 9 Client To Connect To The COM Dll
« Reply #2 on: November 12, 2010, 03:51:13 AM »
vbBdFtVolClient is a PowerBASIC 9 client that connects to the ActiveX Visual Basic Dll and does about the same thing the Visual Basic client prjVolume does, i.e., it prints a few lines of output to the Form/Window.  The three files are…

vbBFVolClient.bas   --  Main source code file with windowing code, i.e., WinMain(), etc.
Main.inc            --  Main include file for vbBFVolClient.bas with a few Types, declares, etc.
vbVolumes.inc       --  Interface declarations from Type Library created in vbVolumes.dll

…and are found in vbBdFtVolClient.zip (attached).  To get this to work you will need to create your own interface definition file using either the PowerBASIC COM browser or Jose Roca’s TypeLib browser.  Here are the directions for using the PowerBASIC COM Browser.  Go to the Tools Menu and select ‘PowerBASIC COM Browser’.  Since its in alphabetical order you’ll find vbVolumes about 95% of the way to the bottom of the list so you’ll have to scroll way on down.  Note that to locate vbVolumes in the COM Browser you will have had to have compiled it first into a dll as per my earlier instructions. Once you locate it in the listview double click on it and magically a whole new window will open up and you’ll see all kinds of wonderful information from the ActiveX Dll.  You need to copy the entirety of that information in the right pane to a text file which you’ll need to name vbVolumes.inc and that will need to replace the one referred to above in the zip.  Again, the reason you need to do this and the reason you can’t use mine is that when you compile the vbVolumes.dll file on your computer you will have different Guids than mine.  If you were installing your Dll on someone else’s machine you would register your Dll on theirs with RegSvr32.exe and then they would be able to use your Dll with their computer because your Guids would be written to their registry.

If you’ve followed these steps you should be able to compile vbBdFtVolClient.bas and connect to the Visual Basic 6 ActiveX Dll.  Just click on the Form when it becomes visible.  Here are the contents of the vbBdFtVolClient project…

‘Main.inc
Code: [Select]
`Type WndEventArgs  wParam As Long  lParam As Long  hWnd   As Dword  hInst  As DwordEnd TypeDeclare Function FnPtr(wea As WndEventArgs) As LongType MessageHandler  wMessage As Long  dwFnPtr As DwordEnd TypeGlobal MsgHdlr() As MessageHandler    `

‘vbVolumes.inc    !!!IMPORTANT!!! You need to make your own vbVolumes.inc from your computer!
Code: [Select]
`              'Visual Basic will have created different Guids on compile than these below!'VB6 Interface Definitions   --  vbVolumes.inc\$IID_IBdFtVols = GUID\$("{22B0BB0B-8900-495B-99FF-8658A159A314}")\$IID_ICuFtVols = GUID\$("{BF4CF49C-FCB2-484C-ACC5-D12AC8F95087}")Interface IBdFtVols \$IID_IBdFtVols : Inherit IDispatch  Property Get Species <1745027076> () As Integer  Property Set Species <1745027076> (ByVal Rhs As Integer)  Property Get Dbh <1745027075> () As Single  Property Set Dbh <1745027075> (ByVal Rhs As Single)  Property Get SawlogHeight <1745027074> () As Single  Property Set SawlogHeight <1745027074> (ByVal Rhs As Single)  Property Get Cull <1745027073> () As Integer  Property Set Cull <1745027073> (ByVal Rhs As Integer)  Property Get FormClass <1745027072> () As Integer  Property Set FormClass <1745027072> (ByVal Rhs As Integer)  Method PsuVolume <1610809350> () As Single  Method FormClassVolume <1610809351> () As SingleEnd InterfaceInterface ICuFtVols \$IID_ICuFtVols : Inherit IDispatch  Property Get Species <1745027075> () As Integer  Property Set Species <1745027075> (ByVal Rhs As Integer)  Property Get Dbh <1745027074> () As Single  Property Set Dbh <1745027074> (ByVal Rhs As Single)  Property Get SawlogHeight <1745027073> () As Single  Property Set SawlogHeight <1745027073> (ByVal Rhs As Single)  Property Get Cull <1745027072> () As Integer  Property Set Cull <1745027072> (ByVal Rhs As Integer)  Method PsuVolume <1610809349> () As SingleEnd Interface`
‘vbBdFtVolClient.bas
Code: [Select]
`#Compile Exe "vbBFVolClient"#Include "Win32api.inc"#Include "Main.inc"#Include "vbVolumes.inc" Function fnWndProc_OnLButtonDown(Wea As WndEventArgs) As Long   ''This is vb's Form_Click()  Local szText As Asciiz*128  Local oBFVol As IBdFtVols  Local oCFVol As ICuFtVols  Local hDC As Dword  hDC=GetDC(Wea.hWnd)  Call SetBkMode(hDC,%TRANSPARENT)  oBFVol=NewCom "vbVolumes.vbBdFtVols"  If IsObject(oBFVol) Then     'Print "oBFVol Is An Object!"     oBFVol.Species      = 30     oBFVol.Dbh          = 16.0     oBFVol.SawlogHeight = 48.0     oBFVol.Cull         = 0     oBFVol.FormClass    = 78     szText="oBFVol.PsuVolume()                = " & Str\$(oBFVol.PsuVolume())     TextOut(hDC,0,0,szText,Len(szText))     szText="oBFVol.FormClassVolume()     = " & Str\$(oBFVol.FormClassVolume())     TextOut(hDC,0,18,szText,Len(szText))     Set oBFVol=Nothing  Else     MsgBox("Couldn't Connect To IBdFtVols!")  End If  oCFVol=NewCom "vbVolumes.vbCuFtVols"  If IsObject(oCFVol) Then     oCFVol.Species      = 30     oCFVol.Dbh          = 10.0     oCFVol.SawlogHeight = 48.0     oCFVol.Cull     szText="oCFVol.PsuVolume()                = " & Str\$(oCFVol.PsuVolume())     TextOut(hDC,0,36,szText,Len(szText))     Set oCFVol=Nothing  Else     MsgBox("Couldn't Connect To ICuFtVols!")  End If  Call ReleaseDC(Wea.hWnd,hDC)    fnWndProc_OnLButtonDown=0End FunctionFunction fnWndProc_OnClose(Wea As WndEventArgs) As Long  Call PostQuitMessage(0)  Call DestroyWindow(Wea.hWnd)  fnWndProc_OnClose=0End FunctionFunction fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long  Local wea As WndEventArgs  Register iReturn As Long  Register i As Long  For i=0 To 1    If wMsg=MsgHdlr(i).wMessage Then       wea.hWnd=hWnd: wea.wParam=wParam: wea.lParam=lParam       Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(wea) To iReturn       fnWndProc=iReturn       Exit Function    End If  Next i  fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)End FunctionSub AttachMessageHandlers()  ReDim MsgHdlr(1) As MessageHandler  'Associate Windows Message With Message Handlers  MsgHdlr(0).wMessage=%WM_LBUTTONDOWN   :   MsgHdlr(0).dwFnPtr=CodePtr(fnWndProc_OnLButtonDown)  MsgHdlr(1).wMessage=%WM_CLOSE         :   MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnClose)End SubFunction WinMain(ByVal hIns As Long,ByVal hPrev As Long,ByVal lpCL As Asciiz Ptr,ByVal iShow As Long) As Long  Local szAppName As Asciiz*24,szTitle As Asciiz*64  Local wc As WndClassEx  Local hWnd As Dword  Local Msg As tagMsg  Call AttachMessageHandlers()                               : szAppName="vbVolumesClient"  wc.lpszClassName=VarPtr(szAppName)                         : wc.lpfnWndProc=CodePtr(fnWndProc)  wc.cbSize=SizeOf(wc)                                       : wc.style=%CS_HREDRAW Or %CS_VREDRAW  wc.cbClsExtra=0                                            : wc.cbWndExtra=0  wc.hInstance=hIns                                          : wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)  wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)             : wc.hbrBackground=%COLOR_BTNFACE+1  wc.lpszMenuName=%NULL  Call RegisterClassEx(wc)  szTitle="Click Form To Connect To ActiveX Dll"  hWnd=CreateWindow(szAppName,szTitle,%WS_OVERLAPPEDWINDOW,200,100,325,300,0,0,hIns,ByVal 0)  Call ShowWindow(hWnd,iShow)  While GetMessage(Msg,%NULL,0,0)    TranslateMessage Msg    DispatchMessage Msg  Wend  Function=msg.wParamEnd Function`
I want to address a problem you might have.  These two lines in fnWndProc_OnLButtonDown()…

Local oBFVol As IBdFtVols
Local oCFVol As IcuFtVols

Must correspond to the interface names in your vbVolumes.inc file.  When it comes out of the COM Browser it likely won’t be as shown above.  So it might be something that looks like this…

' Interface Name  : I_vbBdFtVols
' Class Name      : vbBdFtVols
' ClassID         : \$CLSID_vbBdFtVols
Interface I_vbBdFtVols \$IID_I_vbBdFtVols
Inherit Idispatch
.
.
.

In that case, if you don’t change it, you would need this interface variable declaration…

Local oBFVol As I_vbBdFtVols

At this point you might be wondering how a person is supposed to know what can be changed and what can’t.  All I can say is it’ll come to you eventually (maybe!).  Actually, with COM the actual names of things aren’t as important as their GUIDs and memory layouts/structures.

« Last Edit: November 13, 2010, 05:00:35 AM by Frederick J. Harris »

#### Frederick J. Harris

• Hero Member
• Posts: 914
• User-Rate: +16/-0
• Gender:
##### The PowerBASIC 9 Translation Of The Visual Basic 6 ActiveX Dll
« Reply #3 on: November 12, 2010, 03:53:45 AM »
OK, now to convert the Visual Basic 6 ActiveX Dll Into a PowerBASIC 9 COM Dll.  Open up your PBEdit or whatever editor you prefer to use for PowerBASIC coding, and paste the entirety of the two *.cls files into the editor, and modify them to look like this…

Code: [Select]
`‘pbVolumes.bas will compile to pbVolumes.dll#Compile Dll "pbVolumes"#Com TLib On\$CLSID_pbVolumes = GUID\$("{40000000-0000-0000-0000-000000000000}")\$IID_pbBdFtVols  = GUID\$("{40000000-0000-0000-0000-000000000001}")\$IID_pbCuFtVols  = GUID\$("{40000000-0000-0000-0000-000000000002}")Class pbVolumes \$CLSID_pbVolumes  As Com  Instance      m_iSpecies        As Integer  Instance      m_sngDbh          As Single  Instance      m_sngSawHt        As Single  Instance      m_iCull           As Integer  Instance      m_iFormClass      As Integer  Class Method Create()    MsgBox ("Called pbVolumes Constructor, which in PowerBASIC 9 Is Class Method Create().")  End Method  Class Method Destroy()    MsgBox ("Called pbVolumes Destructor, Which In PowerBASIC 9 Is The Class Method Destroy().")  End Method  Interface pbBdFtVols \$IID_pbBdFtVols : Inherit IUnknown    Property Get Species() As Integer      Property = m_iSpecies    End Property    Property Set Species(ByVal iSpecies As Integer)      m_iSpecies = iSpecies    End Property    Property Get Dbh() As Single      Property = m_sngDbh    End Property    Property Set Dbh(ByVal sngDbh As Single)      m_sngDbh = sngDbh    End Property    Property Get SawlogHeight() As Single      Property = m_sngSawHt    End Property    Property Set SawlogHeight(ByVal sngSawHt As Single)      m_sngSawHt = sngSawHt    End Property    Property Get Cull() As Integer      Property = m_iCull    End Property    Property Set Cull(ByVal iCull As Integer)      m_iCull = iCull    End Property    Property Get FormClass() As Integer      Property = m_iFormClass    End Property    Property Set FormClass(ByVal iFormClass As Integer)      m_iFormClass = iFormClass    End Property    Method PsuVolume() As Single      Dim sngVolume As Single      Select Case m_iSpecies        Case 1          sngVolume = -1.5473 + 0.015473 * m_sngDbh ^ 2 * m_sngSawHt        Case 6          sngVolume = -1.4596 + 0.014596 * m_sngDbh ^ 2 * m_sngSawHt        Case 9          sngVolume = -8.765 + 0.016652 * m_sngDbh ^ 2 * m_sngSawHt        Case 11          sngVolume = 2.1004 + 0.016583 * m_sngDbh ^ 2 * m_sngSawHt        Case 20          sngVolume = 6.2685 + 0.018561 * m_sngDbh ^ 2 * m_sngSawHt        Case 21          sngVolume = 3.1916 + 0.019514 * m_sngDbh ^ 2 * m_sngSawHt        Case 23          sngVolume = 0.26611 + 0.0064407 * m_sngDbh ^ 1.7856 * m_sngSawHt ^ 0.925        Case 24          sngVolume = 0.37396 + 0.005177 * m_sngDbh ^ 1.9066 * m_sngSawHt ^ 0.8959        Case 25          sngVolume = 0.26611 + 0.0064407 * m_sngDbh ^ 1.7856 * m_sngSawHt ^ 0.925        Case 26          sngVolume = 1.3054 + 0.0015993 * m_sngDbh ^ 1.6993 * m_sngSawHt ^ 1.2919        Case 27          sngVolume = 0.74824 + 0.0043476 * m_sngDbh ^ 1.6839 * m_sngSawHt ^ 1.0733        Case 28          sngVolume = 1.33203 + 0.0007995 * m_sngDbh ^ 1.9616 * m_sngSawHt ^ 1.3292        Case 30          sngVolume = 3.8571 + 0.019001 * m_sngDbh ^ 2 * m_sngSawHt        Case 31          sngVolume = 5.5413 + 0.017287 * m_sngDbh ^ 2 * m_sngSawHt        Case 32          sngVolume = 8.9972 + 0.018597 * m_sngDbh ^ 2 * m_sngSawHt        Case 40          sngVolume = 1.6115 + 0.018032 * m_sngDbh ^ 2 * m_sngSawHt        Case 48          sngVolume = 5.3365 + 0.016602 * m_sngDbh ^ 2 * m_sngSawHt        Case 50          sngVolume = 5.0116 + 0.018606 * m_sngDbh ^ 2 * m_sngSawHt        Case 51          sngVolume = 4.9108 + 0.018451 * m_sngDbh ^ 2 * m_sngSawHt        Case 54          sngVolume = 21.2024 + 0.017985 * m_sngDbh ^ 2 * m_sngSawHt        Case 55          sngVolume = 9.2369 + 0.017288 * m_sngDbh ^ 2 * m_sngSawHt        Case 58          sngVolume = 4.5357 + 0.019424 * m_sngDbh ^ 2 * m_sngSawHt        Case 59          sngVolume = 15.283 + 0.01634 * m_sngDbh ^ 2 * m_sngSawHt        Case 63          sngVolume = 0.0917 + 0.020303 * m_sngDbh ^ 2 * m_sngSawHt        Case 76          sngVolume = 16.0039 + 0.016487 * m_sngDbh ^ 2 * m_sngSawHt        Case Else          sngVolume = 4.9092 + 0.016363 * m_sngDbh ^ 2 * m_sngSawHt      End Select      Method = sngVolume * (100 - m_iCull) / 100    End Method    Method FormClassVolume() As Single      Method = _      (1.52968 * (m_sngSawHt / 16) ^ 2 + 9.58615 * (m_sngSawHt / 16) - 13.35212) + _      (1.7962 - 0.27465 * (m_sngSawHt / 16) ^ 2 - 2.59995 * (m_sngSawHt / 16)) * m_sngDbh + _      (0.04482 - 0.00961 * (m_sngSawHt / 16) ^ 2 + 0.45997 * (m_sngSawHt / 16)) * m_sngDbh ^ 2 * _      ((m_iFormClass - 78) * 0.03 + 1)    End Method  End Interface  Interface pbCuFtVols \$IID_pbCuFtVols : Inherit IUnknown    Property Get Species() As Integer      Property = m_iSpecies    End Property    Property Set Species(ByVal iSpecies As Integer)      m_iSpecies = iSpecies    End Property    Property Get Dbh() As Single      Property = m_sngDbh    End Property    Property Set Dbh(ByVal sngDbh As Single)      m_sngDbh = sngDbh    End Property    Property Get SawlogHeight() As Single      Property = m_sngSawHt    End Property    Property Set SawlogHeight(ByVal sngSawHt As Single)      m_sngSawHt = sngSawHt    End Property    Property Get Cull() As Integer      Property = m_iCull    End Property    Property Set Cull(ByVal iCull As Integer)      m_iCull = iCull    End Property    Method PsuVolume() As Single      Dim sngVolume As Single      Select Case m_iSpecies        Case 30          sngVolume = 0.37396 + 0.005177 * m_sngDbh ^ 1.9066 * m_sngSawHt ^ 0.8959        Case 23          sngVolume = 0.26611 + 0.0064407 * m_sngDbh ^ 1.7856 * m_sngSawHt ^ 0.925        Case 24          sngVolume = 0.37396 + 0.005177 * m_sngDbh ^ 1.9066 * m_sngSawHt ^ 0.8959        Case 25          sngVolume = 0.26611 + 0.0064407 * m_sngDbh ^ 1.7856 * m_sngSawHt ^ 0.925        Case 26          sngVolume = 1.3054 + 0.0015993 * m_sngDbh ^ 1.6993 * m_sngSawHt ^ 1.2919        Case 27          sngVolume = 0.74824 + 0.0043476 * m_sngDbh ^ 1.6839 * m_sngSawHt ^ 1.0733        Case 28          sngVolume = 1.33203 + 0.0007995 * m_sngDbh ^ 1.9616 * m_sngSawHt ^ 1.3292        Case Else          sngVolume = 0.26611 + 0.0064407 * m_sngDbh ^ 1.7856 * m_sngSawHt ^ 0.925      End Select      Method = sngVolume * (100 - m_iCull) / 100    End Method  End InterfaceEnd Class`
Or, just use mine above (attached – pbVolumes.zip)!  Let me clue you in on some things I did somewhat different.  As far as I know (and perhaps I’m wrong), you can’t create multiple interfaces in a single Visual Basic 6 class, i.e., Class Module.  Each *.cls file represents a separate class within the server Dll created by Visual Basic 6.  However, you can do this in PowerBASIC and that’s what I did.  The single PowerBASIC class pbVolumes contains a pbBdFtVols Interface, and a pbCuFtVols Interface (see above).

Now, Visual Basic 6 will recognize additional interfaces contained within an external class which it instantiates, i.e., consumes, but on any classes it creates itself there is only one interface per class.  If I’m wrong on this hopefully someone will correct me and elaborate further on the situation and how one would go about doing this in Visual Basic.

Getting back to the code, you’ll need another file, and that is this…

Code: [Select]
`//pbVolumes.rc 1  typelib PBVOLUMES.TLB`
Put pbVolumes.rc in the same directory with pbVolumes.bas (the big file above).  Now compile pbVolumes.bas into pbVolumes.dll.  Next use PBTyp.exe (its in your PowerBASIC \bin subdirectory) to embed the type library created during the above compile into the actual dll.  When the above file – pbVolumes.bas, was compiled, due to the metastatement at top ‘#Com Tlib On’, a pbVolumes.tlb file would have been created.  If you check your directory after the compile you’ll spot a file named pbVolumes.tlb, and that is your Type Library.  It would be nice to embed it into the Dll as opposed to keeping it as a stand alone separate file.  That’s what PBTyp is for.

I do a lot of command line compiling with various tools and other languages, and to do that I usually create a little batch file for whatever directory I’m working in, and here is the one from this project named pbVolumes.bat…

Code: [Select]
`CD\cd C:\Code\PwrBasic\PBWin90\pbVolumesC:\Winnt\system32\cmd.exe`
Change the 2nd line to where you have your files stored, and change the 3rd line to a valid path to your Win32 command line processor.  My machine is a Windows 2000, as you can tell by the C:\Winnt thingie. Yours will likely be C:\Windows\…

Anyway, put a shortcut to that on your desktop, start the command processor, and run this…

Code: [Select]
`PBTyp.exe pbVolumes.dll pbVolumes.rc`

Your Type Library should now be in pbVolumes.dll.  If it didn't work for you perhaps you don't have PowerBASIC 9's \bin subdirectory in your PATH.  Try adding a PATH to the batch file above.  Once you have it working you should be able to use OleView.exe, the PB Com Browser, or Jose's TypeLib Browser  to open the Dll and view your Type Library.

Don’t close your Command Prompt window yet though!  The next step is register the COM Dll with Windows, i.e., put it in the Registry.  Its easy.  Just type this in your command prompt window…

Code: [Select]
`RegSvr32 pbVolumes.dll`
A message box should pop up telling you registration was successful.  Our next step is to create a PowerBASIC client to test it all out.
« Last Edit: November 12, 2010, 05:31:42 PM by Frederick J. Harris »

#### Frederick J. Harris

• Hero Member
• Posts: 914
• User-Rate: +16/-0
• Gender:
##### A PowerBASIC 9 Windows Client To Connect To PowerBASIC COM Dll.
« Reply #4 on: November 12, 2010, 05:30:19 PM »
Finally, here is pbVolumesClient or pbBdFtVolClient (in pbBdFtVolClient.zip) to connect to the pbVolumes.dll and do about the same thing the Visual Basic clients and the other PowerBASIC client did, i.e., TextOut() some data to the Form upon a Form_Click(), which is really an event handler which handles the WM_LBUTTONDOWN Windows message…

Code: [Select]
`‘Main.incType WndEventArgs  wParam As Long  lParam As Long  hWnd   As Dword  hInst  As DwordEnd TypeDeclare Function FnPtr(wea As WndEventArgs) As LongType MessageHandler  wMessage As Long  dwFnPtr As DwordEnd TypeGlobal MsgHdlr() As MessageHandler`
Code: [Select]
`‘pbVolumes.inc'pbVolumes.inc\$IID_IBdFtVols = GUID\$("{40000000-0000-0000-0000-000000000001}")\$IID_ICuFtVols = GUID\$("{40000000-0000-0000-0000-000000000002}")Interface pbBdFtVols \$IID_IBdFtVols : Inherit IUnknown  Property Get Species() As Integer  Property Set Species(ByVal iSpecies As Integer)  Property Get Dbh() As Single  Property Set Dbh(ByVal sngDbh As Single)  Property Get SawlogHeight() As Single  Property Set SawlogHeight(ByVal sngSawHt As Single)  Property Get Cull() As Integer  Property Set Cull(ByVal iCull As Integer)  Property Get FormClass() As Integer  Property Set FormClass(ByVal iFormClass As Integer)  Method PsuVolume() As Single  Method FormClassVolume() As SingleEnd InterfaceInterface pbCuFtVols \$IID_ICuFtVols : Inherit IUnknown  Property Get Species() As Integer  Property Set Species(ByVal iSpecies As Integer)  Property Get Dbh() As Single  Property Set Dbh(ByVal sngDbh As Single)  Property Get SawlogHeight() As Single  Property Set SawlogHeight(ByVal sngSawHt As Single)  Property Get Cull() As Integer  Property Set Cull(ByVal iCull As Integer)  Method PsuVolume() As SingleEnd Interface`
Code: [Select]
`‘pbBdFtVolClient.bas#Compile Exe "pbBFVolClient"#Include "Win32api.inc"#Include "Main.inc"#Include "pbVolumes.inc"Function fnWndProc_OnLButtonDown(Wea As WndEventArgs) As Long  Local szText As Asciiz*128  Local oBFVol As pbBdFtVols  Local oCFVol As pbCuFtVols  Local hDC As Dword  hDC=GetDC(Wea.hWnd)  Call SetBkMode(hDC,%TRANSPARENT)  oBFVol=NewCom "pbVolumes"  If IsObject(oBFVol) Then     oBFVol.Species      = 30     oBFVol.Dbh          = 16.0     oBFVol.SawlogHeight = 48.0     oBFVol.Cull         = 0     oBFVol.FormClass    = 78     szText="oBFVol.PsuVolume()                = " & Str\$(oBFVol.PsuVolume())     TextOut(hDC,0,0,szText,Len(szText))     szText="oBFVol.FormClassVolume()     = " & Str\$(oBFVol.FormClassVolume())     TextOut(hDC,0,18,szText,Len(szText))     Let oCFVol=oBFVol             'this does a QueryInterface() on class and obtains another interface pointer     If IsObject(oCFVol) Then        oCFVol.Species      = 30        oCFVol.Dbh          = 10.0        oCFVol.SawlogHeight = 48.0        oCFVol.Cull         = 0        szText="oCFVol.PsuVolume()                 = " & Str\$(oCFVol.PsuVolume())        TextOut(hDC,0,36,szText,Len(szText))        Set oCFVol=Nothing     End If     Set oBFVol=Nothing  Else     MsgBox("Couldn't Connect To pbBdFtVols!")  End If  Call ReleaseDC(Wea.hWnd,hDC)  fnWndProc_OnLButtonDown=0End FunctionFunction fnWndProc_OnClose(Wea As WndEventArgs) As Long  Call PostQuitMessage(0)  Call DestroyWindow(Wea.hWnd)  fnWndProc_OnClose=0End FunctionFunction fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long  Local wea As WndEventArgs  Register iReturn As Long  Register i As Long  For i=0 To 1    If wMsg=MsgHdlr(i).wMessage Then       wea.hWnd=hWnd: wea.wParam=wParam: wea.lParam=lParam       Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(wea) To iReturn       fnWndProc=iReturn       Exit Function    End If  Next i  fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)End FunctionSub AttachMessageHandlers()  ReDim MsgHdlr(1) As MessageHandler  'Associate Windows Message With Message Handlers  MsgHdlr(0).wMessage=%WM_LBUTTONDOWN   :   MsgHdlr(0).dwFnPtr=CodePtr(fnWndProc_OnLButtonDown)  MsgHdlr(1).wMessage=%WM_CLOSE         :   MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnClose)End SubFunction WinMain(ByVal hIns As Long,ByVal hPrev As Long,ByVal lpCL As Asciiz Ptr,ByVal iShow As Long) As Long  Local szAppName As Asciiz*24,szTitle As Asciiz*64  Local wc As WndClassEx  Local hWnd As Dword  Local Msg As tagMsg  Call AttachMessageHandlers()                               : szAppName="pbBdFtVolClient"  wc.lpszClassName=VarPtr(szAppName)                         : wc.lpfnWndProc=CodePtr(fnWndProc)  wc.cbSize=SizeOf(wc)                                       : wc.style=%CS_HREDRAW Or %CS_VREDRAW  wc.cbClsExtra=0                                            : wc.cbWndExtra=0  wc.hInstance=hIns                                          : wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)  wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)             : wc.hbrBackground=%COLOR_BTNFACE+1  wc.lpszMenuName=%NULL  Call RegisterClassEx(wc)  szTitle="Click Form To Connect To PowerBASIC COM Dll"  hWnd=CreateWindow(szAppName,szTitle,%WS_OVERLAPPEDWINDOW,200,100,375,300,0,0,hIns,ByVal 0)  Call ShowWindow(hWnd,iShow)  While GetMessage(Msg,%NULL,0,0)    TranslateMessage Msg    DispatchMessage Msg  Wend  Function=msg.wParamEnd Function`
You should be able to use pbVolumes.inc directly, because I have the bad habit of making up my own Guids, and when you code PowerBASIC COM objects you can use your own instead of having Visual Basic make them up automatically for you.  Before you RegSvr32 the Dll you might want to check that…

GUID\$("{40000000-0000-0000-0000-000000000000}")
GUID\$("{40000000-0000-0000-0000-000000000001}")
GUID\$("{40000000-0000-0000-0000-000000000002}")

…isn’t being used for anything.  Open up RegEdit.exe and under HKEY_CLASSES_ROOT find the CLSID key; open that and check these aren’t being used.  They likely aren’t, unless you’ve already registered the component.  I can break the rules only because everybody else follows them!
« Last Edit: November 12, 2010, 06:55:12 PM by Frederick J. Harris »

#### Frederick J. Harris

• Hero Member
• Posts: 914
• User-Rate: +16/-0
• Gender:
##### Re: First Lets Create A Simple Visual Basic 6 ActiveX Dll
« Reply #5 on: November 12, 2010, 07:07:06 PM »
I just downloaded Jose's latest Type Lib Browser, and generated a file with the Guids and interfaces with it.  It can be done this way with the PowerBASIC COM Browser too, but the way I had it configured with Jose's browser we'll be using get_ / put_ in front of the method names, and also assigning the values a bit differently.  Here is that version of a pbVolumes client...

Code: [Select]
`'Main.inc  -- Main Program IncludeType WndEventArgs  wParam As Long  lParam As Long  hWnd   As Dword  hInst  As DwordEnd TypeDeclare Function FnPtr(wea As WndEventArgs) As LongType MessageHandler  wMessage As Long  dwFnPtr As DwordEnd TypeGlobal MsgHdlr() As MessageHandler`
Code: [Select]
`'pbVolumesAlt1.inc' ########################################################################################' Library name: pbVolumes.dll' Version: 1.0, Locale ID = 0' Documentation string: COM Library' Path: C:\Code\PwrBasic\PBWin90\pbVolumes\PBVOLUMES.DLL' Library GUID: {7B740FBC-C9EE-476A-8707-85FA28201AFA}' Code generated by the TypeLib Browser 4.0.14 (c) 2010 by José Roca' Date: 12 Nov 2010   Time: 12:34:13' ########################################################################################' ========================================================================================' ProgIDs (Program identifiers)' ========================================================================================' CLSID = {40000000-0000-0000-0000-000000000000}\$PROGID_PBVOLUMESPBVOLUMES = "PBVOLUMES"' ========================================================================================' ClsIDs (Class identifiers)' ========================================================================================\$CLSID_PBVOLUMESPBVOLUMES = GUID\$("{40000000-0000-0000-0000-000000000000}")' ========================================================================================' IIDs (Interface identifiers)' ========================================================================================\$IID_PBVOLUMESPBBDFTVOLS = GUID\$("{40000000-0000-0000-0000-000000000001}")\$IID_PBVOLUMESPBCUFTVOLS = GUID\$("{40000000-0000-0000-0000-000000000002}")' ########################################################################################' Library name: pbVolumes.dll' Version: 1.0, Locale ID = 0' Documentation string: COM Library' Path: C:\Code\PwrBasic\PBWin90\pbVolumes\PBVOLUMES.DLL' Library GUID: {7B740FBC-C9EE-476A-8707-85FA28201AFA}' Code generated by the TypeLib Browser 4.0.14 (c) 2010 by José Roca' Date: 12 Nov 2010   Time: 12:22:47' ########################################################################################' ########################################################################################' Interface name = PBBDFTVOLS' IID = {40000000-0000-0000-0000-000000000001}' PBBDFTVOLS is a custom interface for Direct VTable access.' Attributes = 128 [&H80] [Nonextensible]' Inherited interface = IUnknown' #########################################################################################IF NOT %DEF(%PBVOLUMESPBBDFTVOLS_INTERFACE_DEFINED)    %PBVOLUMESPBBDFTVOLS_INTERFACE_DEFINED = 1INTERFACE PBVOLUMESPBBDFTVOLS \$IID_PBVOLUMESPBBDFTVOLS   INHERIT IUnknown   ' =====================================================================================   METHOD get_SPECIES ( _                               ' VTable offset = 12   ) AS INTEGER                                         ' VT_I2 <Integer>   ' =====================================================================================   METHOD put_SPECIES ( _                               ' VTable offset = 16     BYVAL prm1 AS INTEGER _                            ' [in] VT_I2 <Integer>   )                                                    ' VT_VOID   ' =====================================================================================   METHOD get_DBH ( _                                   ' VTable offset = 20   ) AS SINGLE                                          ' VT_R4 <Single>   ' =====================================================================================   METHOD put_DBH ( _                                   ' VTable offset = 24     BYVAL prm1 AS SINGLE _                             ' [in] VT_R4 <Single>   )                                                    ' VT_VOID   ' =====================================================================================   METHOD get_SAWLOGHEIGHT ( _                          ' VTable offset = 28   ) AS SINGLE                                          ' VT_R4 <Single>   ' =====================================================================================   METHOD put_SAWLOGHEIGHT ( _                          ' VTable offset = 32     BYVAL prm1 AS SINGLE _                             ' [in] VT_R4 <Single>   )                                                    ' VT_VOID   ' =====================================================================================   METHOD get_CULL ( _                                  ' VTable offset = 36   ) AS INTEGER                                         ' VT_I2 <Integer>   ' =====================================================================================   METHOD put_CULL ( _                                  ' VTable offset = 40     BYVAL prm1 AS INTEGER _                            ' [in] VT_I2 <Integer>   )                                                    ' VT_VOID   ' =====================================================================================   METHOD get_FORMCLASS ( _                             ' VTable offset = 44   ) AS INTEGER                                         ' VT_I2 <Integer>   ' =====================================================================================   METHOD put_FORMCLASS ( _                             ' VTable offset = 48     BYVAL prm1 AS INTEGER _                            ' [in] VT_I2 <Integer>   )                                                    ' VT_VOID   ' =====================================================================================   METHOD PSUVOLUME ( _                                 ' VTable offset = 52   ) AS SINGLE                                          ' VT_R4 <Single>   ' =====================================================================================   METHOD FORMCLASSVOLUME ( _                           ' VTable offset = 56   ) AS SINGLE                                          ' VT_R4 <Single>   ' =====================================================================================END INTERFACE#ENDIF   ' /* __PBVOLUMESPBBDFTVOLS_INTERFACE_DEFINED__ */' ########################################################################################' Interface name = PBCUFTVOLS' IID = {40000000-0000-0000-0000-000000000002}' PBCUFTVOLS is a custom interface for Direct VTable access.' Attributes = 128 [&H80] [Nonextensible]' Inherited interface = IUnknown' #########################################################################################IF NOT %DEF(%PBVOLUMESPBCUFTVOLS_INTERFACE_DEFINED)    %PBVOLUMESPBCUFTVOLS_INTERFACE_DEFINED = 1INTERFACE PBVOLUMESPBCUFTVOLS \$IID_PBVOLUMESPBCUFTVOLS   INHERIT IUnknown   ' =====================================================================================   METHOD get_SPECIES ( _                               ' VTable offset = 12   ) AS INTEGER                                         ' VT_I2 <Integer>   ' =====================================================================================   METHOD put_SPECIES ( _                               ' VTable offset = 16     BYVAL prm1 AS INTEGER _                            ' [in] VT_I2 <Integer>   )                                                    ' VT_VOID   ' =====================================================================================   METHOD get_DBH ( _                                   ' VTable offset = 20   ) AS SINGLE                                          ' VT_R4 <Single>   ' =====================================================================================   METHOD put_DBH ( _                                   ' VTable offset = 24     BYVAL prm1 AS SINGLE _                             ' [in] VT_R4 <Single>   )                                                    ' VT_VOID   ' =====================================================================================   METHOD get_SAWLOGHEIGHT ( _                          ' VTable offset = 28   ) AS SINGLE                                          ' VT_R4 <Single>   ' =====================================================================================   METHOD put_SAWLOGHEIGHT ( _                          ' VTable offset = 32     BYVAL prm1 AS SINGLE _                             ' [in] VT_R4 <Single>   )                                                    ' VT_VOID   ' =====================================================================================   METHOD get_CULL ( _                                  ' VTable offset = 36   ) AS INTEGER                                         ' VT_I2 <Integer>   ' =====================================================================================   METHOD put_CULL ( _                                  ' VTable offset = 40     BYVAL prm1 AS INTEGER _                            ' [in] VT_I2 <Integer>   )                                                    ' VT_VOID   ' =====================================================================================   METHOD PSUVOLUME ( _                                 ' VTable offset = 44   ) AS SINGLE                                          ' VT_R4 <Single>   ' =====================================================================================END INTERFACE#ENDIF   ' /* __PBVOLUMESPBCUFTVOLS_INTERFACE_DEFINED__ */`
Code: [Select]
`'Client1.bas#Compile Exe "Client1"#Include "Win32api.inc"#Include "Main.inc"#Include "pbVolumesAlt1.inc"Function fnWndProc_OnLButtonDown(Wea As WndEventArgs) As Long  Local oBFVol As PBVOLUMESPBBDFTVOLS  Local oCFVol As PBVOLUMESPBCUFTVOLS  Local szText As Asciiz*128  Local hDC As Dword  hDC=GetDC(Wea.hWnd)  Call SetBkMode(hDC,%TRANSPARENT)  oBFVol=NewCom "pbVolumes"  If IsObject(oBFVol) Then     oBFVol.put_Species(30)     oBFVol.put_Dbh(16.0)     oBFVol.put_SawlogHeight(48.0)     oBFVol.put_Cull(0)     oBFVol.put_FormClass(78)     szText="oBFVol.PsuVolume()                = " & Str\$(oBFVol.PsuVolume())     TextOut(hDC,0,0,szText,Len(szText))     szText="oBFVol.FormClassVolume()     = " & Str\$(oBFVol.FormClassVolume())     TextOut(hDC,0,18,szText,Len(szText))     Let oCFVol=oBFVol             'this does a QueryInterface() on class and obtains another interface pointer     If IsObject(oCFVol) Then        oCFVol.put_Species(30)        oCFVol.put_Dbh(10.0)        oCFVol.put_SawlogHeight(48.0)        oCFVol.put_Cull(0)        szText="oCFVol.PsuVolume()                 = " & Str\$(oCFVol.PsuVolume())        TextOut(hDC,0,36,szText,Len(szText))        Set oCFVol=Nothing     End If     Set oBFVol=Nothing  Else     MsgBox("Couldn't Connect To pbBdFtVols!")  End If  Call ReleaseDC(Wea.hWnd,hDC)  fnWndProc_OnLButtonDown=0End FunctionFunction fnWndProc_OnClose(Wea As WndEventArgs) As Long  Call PostQuitMessage(0)  Call DestroyWindow(Wea.hWnd)  fnWndProc_OnClose=0End FunctionFunction fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long  Local wea As WndEventArgs  Register iReturn As Long  Register i As Long  For i=0 To 1    If wMsg=MsgHdlr(i).wMessage Then       wea.hWnd=hWnd: wea.wParam=wParam: wea.lParam=lParam       Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(wea) To iReturn       fnWndProc=iReturn       Exit Function    End If  Next i  fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)End FunctionSub AttachMessageHandlers()  ReDim MsgHdlr(1) As MessageHandler  'Associate Windows Message With Message Handlers  MsgHdlr(0).wMessage=%WM_LBUTTONDOWN   :   MsgHdlr(0).dwFnPtr=CodePtr(fnWndProc_OnLButtonDown)  MsgHdlr(1).wMessage=%WM_CLOSE         :   MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnClose)End SubFunction WinMain(ByVal hIns As Long,ByVal hPrev As Long,ByVal lpCL As Asciiz Ptr,ByVal iShow As Long) As Long  Local szAppName As Asciiz*24,szTitle As Asciiz*64  Local wc As WndClassEx  Local hWnd As Dword  Local Msg As tagMsg  Call AttachMessageHandlers()                               : szAppName="pbBdFtVolClient"  wc.lpszClassName=VarPtr(szAppName)                         : wc.lpfnWndProc=CodePtr(fnWndProc)  wc.cbSize=SizeOf(wc)                                       : wc.style=%CS_HREDRAW Or %CS_VREDRAW  wc.cbClsExtra=0                                            : wc.cbWndExtra=0  wc.hInstance=hIns                                          : wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)  wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)             : wc.hbrBackground=%COLOR_BTNFACE+1  wc.lpszMenuName=%NULL  Call RegisterClassEx(wc)  szTitle="Click Form To Connect To PowerBASIC COM Dll"  hWnd=CreateWindow(szAppName,szTitle,%WS_OVERLAPPEDWINDOW,200,100,375,300,0,0,hIns,ByVal 0)  Call ShowWindow(hWnd,iShow)  While GetMessage(Msg,%NULL,0,0)    TranslateMessage Msg    DispatchMessage Msg  Wend  Function=msg.wParamEnd Function`

#### Frederick J. Harris

• Hero Member
• Posts: 914
• User-Rate: +16/-0
• Gender:
##### Re: First Lets Create A Simple Visual Basic 6 ActiveX Dll
« Reply #6 on: November 12, 2010, 07:11:50 PM »
Note that there was a little mistake in Post #4 where I did this...

Let oCFVol=oBFVol

After I did that I was still using oBFVol instead of oCFVol.  It doesn't really matter unless you are a forester and are buying or selling this timber!

I fixed it in the code of Post #4 but the zip is still wrong.  You just need to change the lines under the above statement to oCFVol. instead of oBFVol the way it was.