First Lets Create A Simple Visual Basic 6 ActiveX Dll

[Frederick J. Harris]

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 Expand


'vbBdFtVols.cls
Option Explicit
Private m_iSpecies As Integer
Private m_sngDbh As Single
Private m_sngSawHt As Single
Private m_iCull As Integer
Private m_iFormClass As Integer
Private Sub Class_Initialize()
  MsgBox ("Called vbBdFtVols Constructor, which in Visual Basic 6 Is The Class_Initialize() Method.")
End Sub
Public Property Get Species() As Integer
  Species = m_iSpecies
End Property
Public Property Let Species(ByVal iSpecies As Integer)
  m_iSpecies = iSpecies
End Property
Public Property Get Dbh() As Single
  Dbh = m_sngDbh
End Property
Public Property Let Dbh(ByVal sngDbh As Single)
  m_sngDbh = sngDbh
End Property
Public Property Get SawlogHeight() As Single
  SawlogHeight = m_sngSawHt
End Property
Public Property Let SawlogHeight(ByVal sngSawHt As Single)
  m_sngSawHt = sngSawHt
End Property
Public Property Get Cull() As Integer
  Cull = m_iCull
End Property
Public Property Let Cull(ByVal iCull As Integer)
  m_iCull = iCull
End Property
Public Property Get FormClass() As Integer
  FormClass = m_iFormClass
End Property
Public Property Let FormClass(ByVal iFormClass As Integer)
  m_iFormClass = iFormClass
End Property
Public 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) / 100
End Function
Public 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 Function
Private 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 Expand


'vbCuFtVols.cls
Option Explicit
Private m_iSpecies As Integer
Private m_sngDbh As Single
Private m_sngSawHt As Single
Private m_iCull As Integer
Private Sub Class_Initialize()
  MsgBox ("Called The vbCuFtVols Constructor, Which In Visual Basic 6 Is The Class_Initialize Method")
End Sub
Public Property Get Species() As Integer
  Species = m_iSpecies
End Property
Public Property Let Species(ByVal iSpecies As Integer)
  m_iSpecies = iSpecies
End Property
Public Property Get Dbh() As Single
  Dbh = m_sngDbh
End Property
Public Property Let Dbh(ByVal sngDbh As Single)
  m_sngDbh = sngDbh
End Property
Public Property Get SawlogHeight() As Single
  SawlogHeight = m_sngSawHt
End Property
Public Property Let SawlogHeight(ByVal sngSawHt As Single)
  m_sngSawHt = sngSawHt
End Property
Public Property Get Cull() As Integer
  Cull = m_iCull
End Property
Public Property Let Cull(ByVal iCull As Integer)
  m_iCull = iCull
End Property
Public 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) / 100
End Function
Private Sub Class_Terminate()
  MsgBox ("Called The vbCuFtVols Destructor, Which In Visual Basic 6 Is The Class_Terminate Method")
End Sub


[Frederick J. Harris]

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 Expand


'frmVolume.frm
Option Explicit
Private 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.PsuVolume
End 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.

[Frederick J. Harris]

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 Expand


Type WndEventArgs
  wParam As Long
  lParam As Long
  hWnd   As Dword
  hInst  As Dword
End Type

Declare Function FnPtr(wea As WndEventArgs) As Long

Type MessageHandler
  wMessage As Long
  dwFnPtr As Dword
End Type

Global MsgHdlr() As MessageHandler   



'vbVolumes.inc    !!!IMPORTANT!!! You need to make your own vbVolumes.inc from your computer!

Code Select Expand

              '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 Single
End Interface

Interface 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 Single
End Interface


'vbBdFtVolClient.bas

Code Select Expand


#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=0
End Function


Function fnWndProc_OnClose(Wea As WndEventArgs) As Long
  Call PostQuitMessage(0)
  Call DestroyWindow(Wea.hWnd)
  fnWndProc_OnClose=0
End Function


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


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


Function 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.wParam
End 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.

[Frederick J. Harris]

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 Expand


'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 Interface
End 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 Expand


//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 Expand


CD\
cd C:\Code\PwrBasic\PBWin90\pbVolumes
C:\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 Expand


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 Expand


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.

[Frederick J. Harris]

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 Expand


'Main.inc
Type WndEventArgs
 wParam As Long
 lParam As Long
 hWnd   As Dword
 hInst  As Dword
End Type

Declare Function FnPtr(wea As WndEventArgs) As Long

Type MessageHandler
 wMessage As Long
 dwFnPtr As Dword
End Type

Global MsgHdlr() As MessageHandler


Code Select Expand


'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 Single
End Interface

Interface 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 Single
End Interface


Code Select Expand


'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=0
End Function


Function fnWndProc_OnClose(Wea As WndEventArgs) As Long
 Call PostQuitMessage(0)
 Call DestroyWindow(Wea.hWnd)
 fnWndProc_OnClose=0
End Function


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


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


Function 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.wParam
End 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!

[Frederick J. Harris]

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 Expand


'Main.inc  -- Main Program Include

Type WndEventArgs
  wParam As Long
  lParam As Long
  hWnd   As Dword
  hInst  As Dword
End Type

Declare Function FnPtr(wea As WndEventArgs) As Long

Type MessageHandler
  wMessage As Long
  dwFnPtr As Dword
End Type

Global MsgHdlr() As MessageHandler


Code Select Expand


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

INTERFACE 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 = 1

INTERFACE 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 Expand


'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=0
End Function


Function fnWndProc_OnClose(Wea As WndEventArgs) As Long
  Call PostQuitMessage(0)
  Call DestroyWindow(Wea.hWnd)
  fnWndProc_OnClose=0
End Function


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


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


Function 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.wParam
End Function


[Frederick J. Harris]

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.