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.
'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
'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
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...
'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.
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
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!
'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
#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.
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...
'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...
//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...
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...
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...
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.
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...
'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
'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
'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!
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...
'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
'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__ */
'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
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.