FireFly PowerBASIC RAD编程，调用PowerBASIC COM对象
一、序言
初步看了看PowerBASIC编程，很类似用VC注册窗体后调用回调函数，先是一个Dialog new，然后添加组件 Control add ......， 然后在处理 Windows MSG和发给组件的消息，这种编程方式和早期DOS 25x80屏幕上编程一样，要自己处理显示内容的位置和区域大小。
PowerBASIC还自带了一个Dlgedit.exe ， 它是微软的 Dialog Editor，用于设计窗口和摆放组件。
同时，PowerBASIC带了RC.exe和PBRES.exe用于资源编译，但设计器是16位的，在Win10和Win11上要处理一下才能运行。处理的方法是到github下载 OTVDM，解压到C盘根目录，执行Install向注册表填加16位程序转向即可。安装有OTVDM的计算机，可以安装VB3， VB6， Delphi2， Delphi3， 而且窗口样式和现在的一样，界面倍加美观。
后来，有了PBFORMS，类似Linux上Glade的界面设计器，属性方法框架基本上在上面完成了。
在菜单上，VIEW， DDT 代码， 全部考贝粘到程序代码页，编译就能运行这个框架。
#PBFORMS CREATED V2.01
'------------------------------------------------------------------------------
' The first line in this file is a PB/Forms metastatement.
' It should ALWAYS be the first line of the file. Other
' PB/Forms metastatements are placed at the beginning and
' end of "Named Blocks" of code that should be edited
' with PBForms only. Do not manually edit or delete these
' metastatements or PB/Forms will not be able to reread
' the file correctly. See the PB/Forms documentation for
' more information.
' Named blocks begin like this: #PBFORMS BEGIN ...
' Named blocks end like this: #PBFORMS END ...
' Other PB/Forms metastatements such as:
' #PBFORMS DECLARATIONS
' are used by PB/Forms to insert additional code.
' Feel free to make changes anywhere else in the file.
'------------------------------------------------------------------------------
#COMPILE EXE
#DIM ALL
'------------------------------------------------------------------------------
' ** Includes **
'------------------------------------------------------------------------------
#PBFORMS BEGIN INCLUDES
#RESOURCE "noname1.pbr"
%USEMACROS = 1
#INCLUDE ONCE "WIN32API.INC"
#INCLUDE ONCE "COMMCTRL.INC"
#INCLUDE ONCE "PBForms.INC"
#PBFORMS END INCLUDES
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Constants **
'------------------------------------------------------------------------------
#PBFORMS BEGIN CONSTANTS
%IDD_DIALOG1 = 101
%IDC_TEXTBOX1 = 1001
%IDC_TEXTBOX2 = 1002
%IDC_TEXTBOX3 = 1003
%IDC_TEXTBOX4 = 1004
%IDC_TEXTBOX5 = 1005
%IDC_BUTTON1 = 1006
%IDR_IMGFILE1 = 102 '*
#PBFORMS END CONSTANTS
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Declarations **
'------------------------------------------------------------------------------
DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
#PBFORMS DECLARATIONS
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Main Application Entry Point **
'------------------------------------------------------------------------------
FUNCTION PBMAIN()
PBFormsInitComCtls (%ICC_WIN95_CLASSES OR %ICC_DATE_CLASSES OR _
%ICC_INTERNET_CLASSES)
ShowDIALOG1 %HWND_DESKTOP
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** CallBacks **
'------------------------------------------------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()
SELECT CASE AS LONG CB.MSG
CASE %WM_INITDIALOG
' Initialization handler
CASE %WM_NCACTIVATE
STATIC hWndSaveFocus AS DWORD
IF ISFALSE CB.WPARAM THEN
' Save control focus
hWndSaveFocus = GetFocus()
ELSEIF hWndSaveFocus THEN
' Restore control focus
SetFocus(hWndSaveFocus)
hWndSaveFocus = 0
END IF
CASE %WM_COMMAND
' Process control notifications
SELECT CASE AS LONG CB.CTL
CASE %IDC_TEXTBOX1
CASE %IDC_TEXTBOX2
CASE %IDC_TEXTBOX3
CASE %IDC_TEXTBOX4
CASE %IDC_TEXTBOX5
CASE %IDC_BUTTON1
IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
MSGBOX "%IDC_BUTTON1=" + FORMAT$(%IDC_BUTTON1), _
%MB_TASKMODAL
END IF
END SELECT
END SELECT
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Dialogs **
'------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
LOCAL lRslt AS LONG
#PBFORMS BEGIN DIALOG %IDD_DIALOG1->->
LOCAL hDlg AS DWORD
DIALOG NEW hParent, "Dialog1", 191, 173, 184, 181, %WS_POPUP OR _
%WS_BORDER OR %WS_THICKFRAME OR %WS_CAPTION OR %WS_SYSMENU OR _
%WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR %WS_VISIBLE OR %DS_SYSMODAL OR _
%DS_CENTER OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, _
%WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
%WS_EX_RIGHTSCROLLBAR, TO hDlg
CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX1, "TextBox1", 40, 25, 70, 15
CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX2, "TextBox2", 40, 55, 105, 15
CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX3, "TextBox3", 40, 75, 105, 15
CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX4, "TextBox4", 40, 95, 105, 15
CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX5, "TextBox5", 40, 115, 105, 15
CONTROL ADD BUTTON, hDlg, %IDC_BUTTON1, "Button1", 40, 145, 60, 15
#PBFORMS END DIALOG
DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
#PBFORMS BEGIN CLEANUP %IDD_DIALOG1
#PBFORMS END CLEANUP
FUNCTION = lRslt
END FUNCTION
'------------------------------------------------------------------------------感觉这些东西挺不错的，代表着一种不同VB6的实现思想。PowerBASIC是32位编译器、没有64位编译器、现在已经停更了，但仍然在一些地方得到应用。PowerBASIC支持多线程，用它编写DLL体积小速度快。后来，又有好事者 FireFly 为它开发了 RAD 。
二、FireFly RAD powerBASIC
控件几十项，代码可以用PowerBASIC原装语句，也可以用它自己的语句，但编译器完全是PowerBASIC的，只是又做了一些封装。
这个习练程序是按如下步骤调用PowerBASIC COM对象的。
用FireFly带的 Type_lib browser 找到已经注册的COM对象
双击找到的COM对象，然后点击菜单上的Code
会自动生成Type library，将它们全部考贝到FireFly RAD中的一个模块中即可。
' ########################################################################################
' Library name: Prime
' Version: 1.0, Locale ID = 0
' Description: Prime
' Documentation string: Prime number detector
' Path: D:\PBASICWIN104\SAMPLES\OBJECTS\VB\PRIME.DLL
' Library GUID: {66098C79-60F3-44F5-B30C-845E1171E87B}
' Code generated by the TypeLib Browser 5.0.0 (c) 2011 by Jos?Roca
' Date: 20 9月 2023 Time: 18:35:24
' Options used to generate the code:
' - Use METHOD and PROPERTY GET/SET statements
' - Use parameter names in interface declarations
' - Use interface names with external objects
' - Include dispatch only interfaces
' - Retrieve license key
' - Use automation view
' ########################################################################################
' ========================================================================================
' CoClass name: MATHCLASS
' ========================================================================================
' CLSID (Class identifier): {590B350A-D462-485E-A35C-40FACA1ABC16}
' Attributes: 2 [&H00000002] [Cancreate]
' ProgID (Program identifier): MATHCLASS
' Default interface: IPRIME
' Default interface IID: {19C9E340-205F-4AA6-A58F-A62179D0E26B}
' Default events interface: IPROGRESS
' Default events interface IID: {AB813267-178F-47A0-8EFC-CE0CCB06D359}
' Implemented interfaces:
' IPRIME (default interface)
' IPROGRESS (default events interface)
' ========================================================================================
' ========================================================================================
' ProgIDs (Program identifiers)
' ========================================================================================
' CLSID = {590B350A-D462-485E-A35C-40FACA1ABC16}
$PROGID_MATHCLASS = "MATHCLASS"
' ========================================================================================
' ClsIDs (Class identifiers)
' ========================================================================================
$CLSID_MATHCLASS = GUID$("{590B350A-D462-485E-A35C-40FACA1ABC16}")
' ========================================================================================
' IIDs (Interface identifiers)
' ========================================================================================
$IID_IPRIME = GUID$("{19C9E340-205F-4AA6-A58F-A62179D0E26B}")
$IID_IPROGRESS = GUID$("{AB813267-178F-47A0-8EFC-CE0CCB06D359}")
' ########################################################################################
' Interface name = IPRIME
' IID = {19C9E340-205F-4AA6-A58F-A62179D0E26B}
' IPRIME is a custom interface for Direct VTable access.
' Attributes = 128 [&H00000080] [Nonextensible]
' Inherited interface = IUnknown
' ########################################################################################
#IF NOT %DEF(%IPRIME_INTERFACE_DEFINED)
%IPRIME_INTERFACE_DEFINED = 1
INTERFACE IPRIME $IID_IPRIME
INHERIT IAutomation
' =====================================================================================
METHOD ADDNUMBERS1 ( _ ' VTable offset = 12
BYVAL NUM1 AS INTEGER _ ' [in] NUM1 VT_I2
, BYVAL NUM2 AS INTEGER _ ' [in] NUM2 VT_I2
, BYREF LRETURN AS LONG _ ' [in][out] *LRETURN VT_I4
) ' void
' =====================================================================================
PROPERTY GET ADDNUMBERS ( _ ' VTable offset = 16
BYVAL NUM1 AS INTEGER _ ' [in] NUM1 VT_I2
, BYVAL NUM2 AS INTEGER _ ' [in] NUM2 VT_I2
, BYREF IN LRETURN AS LONG _ ' [in][out] *LRETURN VT_I4
) AS LONG ' VT_I4
' =====================================================================================
PROPERTY GET ISPRIME ( _ ' VTable offset = 20
) AS LONG ' [in] N VT_I4
' =====================================================================================
END INTERFACE
#ENDIF ' /* __IPRIME_INTERFACE_DEFINED__ */
全部考贝，一个字都不需要更改！
双击frmMAIN上Command1钮，试手操作它左边的Text1文本。在自动生成的框架上加一句：FF_Control_SetText(HWND_FrmMain_TEXT1,"中文" + "and English" )，运行程序后点击Command1，就会在Text1上显示 "中文 and English" 字样。这是在PowerBASIC原有的 Control Set Text hWnd, IDC, text 基础上封装的，调用方法基本上不变，但它们与 Text1.Text = "中文 and English" 是很大不同的。
'--------------------------------------------------------------------------------
Function FRMMAIN_COMMAND1_BN_CLICKED ( _
ControlIndex As Long, _ ' index in Control Array
hWndForm As Dword, _ ' handle of Form
hWndControl As Dword, _ ' handle of Control
idButtonControl As Long _ ' identifier of button
) As Long
FF_Control_SetText(HWND_FrmMain_TEXT1,"中文" + "and English" )
End Function再来看看一段代码，当程序运行后，将窗体置于屏幕中央。
先得到Desktop的尺寸，然后得到主窗体尺寸，相减后除以2作为窗体的top和left，窗体就在中央位置了。LanID可以是FF，也可以是PB，接着的判断根据FF或FB，决定用PowerBASIC和是FF的封装函数实现。两者样式差不多，实现的功能完全相同。
Function FRMMAIN_WM_CREATE ( _
hWndForm As Dword, _ ' handle of Form
ByVal UserData As Long _ ' optional user defined Long value
) As Long
Local nScreenX As Long, nScreenY As Long
Local nfrmMainWidth As Long, nfrmMainHeight As Long
Local LanID As String
Local hWndDeskTop As Dword
hWndDesktop = GetDesktopWindow() '%HWND_DESKTOP
LanID = "FF" 'PB for powerbasic statements, and FF for FireFly statements
If LanID = "PB" Then
Desktop Get Size To nScreenX, nScreenY 'Get screen size
Dialog Get Size hWndForm To nfrmMainWidth, nfrmMainHeight 'Get frmMain size
Dialog Set LoC hWndForm, (nScreenX - nfrmMainWidth)/2, (nScreenY - nfrmMainHeight)/2 'Center frmMain
Else
FF_Control_GetSize hWndDesktop, nScreenX, nScreenY '%HWND_DESKTOP = hWndDesktop = 0
FF_Control_GetSize hWndForm, nfrmMainWidth, nfrmMainHeight
FF_Control_SetLoc hWndForm, (nScreenX - nfrmMainWidth)/2, (nScreenY - nfrmMainHeight)/2
End If
End Function最后是调用COM对象代码
IPRIME是Class的实现接口，在Class内部完成。在程序中 Local Glossary As IPRIME，Let Glossary = NewCom $PROGID_MATHCLASS 完成接口对象创建。原COM中用了Property GET和Method两种方式实现了AddNumbers，用Method方法要用 call 调用。参数回传要用 byref， 不能用byval，否则收不到COM的数据。
Function FRMMAIN_COMMAND2_BN_CLICKED ( _
ControlIndex As Long, _ ' index in Control Array
hWndForm As Dword, _ ' handle of Form
hWndControl As Dword, _ ' handle of Control
idButtonControl As Long _ ' identifier of button
) As Long
Local Glossary As IPRIME
Let Glossary = NewCom $PROGID_MATHCLASS
'If IsFalse(IsObject(Glossary)) Then Exit Function
If IsObject(Glossary) Then
Local iParam1 As Integer
Local iParam2 As Integer
Local lReturn As Long
iParam1 = 3: iParam2 = 5
'Method using Property GET
Glossary.AddNumbers(ByVal iParam1, ByVal iParam2, ByRef lReturn)
'Methond using Method routine
'Call Glossary.AddNumbers1(ByVal iParam1, ByVal iParam2, ByRef lReturn)
FF_Control_SetText(HWND_FrmMain_TEXT2, Format$(lReturn))
Glossary = Nothing
End If
End Function三、Prime COM对象代码
主要函数一个是method方式，一个是property get方式
'------------------------------------------------------------------------------
'
' PowerBASIC COM Server and Visual Basic 6 client example
' Copyright (c) 2009-2011 PowerBASIC, Inc.
' All Rights Reserved.
'
' Be sure to register the COM Server (prime.dll) before
' using it in a Visual Basic application!
'
' See the ReadMe.txt file!
'
'------------------------------------------------------------------------------
#COMPILE DLL
#DIM ALL
' Include the Type Library file as a resource file in the DLL
#RESOURCE TYPELIB, 1, "prime.tlb"
' The #COM DOC statement sets the description of this server Visual
' Basic does not display the servers name in it's project references
' dialog box, it only displays the description.
#COM DOC "Prime number detector" ' Description of the server
#COM NAME "Prime", 1.0 ' Server name and version number
#COM TLIB ON ' Generate a type library file
' Event Interface definition. This is required so that the event interface
' is saved in the type library file and so that VB knows how to receive the events.
INTERFACE IProgress GUID$("{AB813267-178F-47A0-8EFC-CE0CCB06D359}") AS EVENT
INHERIT IAUTOMATION
METHOD sOutString(BYVAL p AS WSTRING)
METHOD Value(BYVAL p AS LONG)
END INTERFACE
' MathClass that conatins the IPrime interface
CLASS MathClass GUID$("{590B350A-D462-485E-A35C-40FACA1ABC16}") AS COM
INTERFACE IPrime GUID$("{19C9E340-205F-4AA6-A58F-A62179D0E26B}")
INHERIT IUNKNOWN
METHOD AddNumbers1(BYVAL Num1 AS INTEGER, BYVAL Num2 AS INTEGER, BYREF lReturn AS LONG)
lReturn = Num1 + Num2
END METHOD
PROPERTY GET AddNumbers(BYVAL Num1 AS INTEGER, BYVAL Num2 AS INTEGER, BYREF lReturn AS LONG) AS LONG
lReturn = Num1 + Num2
END PROPERTY
' While not the fastest way to determine if a number is prime,
' it is good for an sample server with an event.
PROPERTY GET IsPrime(BYVAL n AS LONG) AS LONG
LOCAL w AS LONG
LOCAL h AS LONG
LOCAL i AS LONG
LOCAL k AS WSTRING
IF n < 2 THEN
' Any value less than two is not a prime number
PROPERTY = 0
EXIT PROPERTY
ELSEIF n = 2 THEN
' Two is a prime number
PROPERTY = 1
EXIT PROPERTY
END IF
' Test the value and see if the value can be divided
' by any number between two and the value minus 1
FOR i = 2 TO n-1
IF (n MOD i) = 0 THEN
' Not a prime number
PROPERTY = 0
EXIT PROPERTY
END IF
IF (i MOD 300) = 0 THEN
' Call the event handler and inform it of our progress
' This is the Sub prime_Value(ByVal p As Long) routine in VB
k = "A message from ActiveX component!"
RAISEEVENT IProgress.sOutString(k)
RAISEEVENT IProgress.Value(i/n * 100)
END IF
NEXT i
' The value is a prime number
PROPERTY = 1
END PROPERTY
END INTERFACE
' Specify that this class is an event source and sends
' events to the IProgress interface
EVENT SOURCE IProgress
END CLASS代码是在原Prime基础上修改的，另外做了Event接口提供两个 Event， 在VB6上使用的话可以自加 vbPrime_Value和vbPrime_sOutString函数，COM对象会按条件要求自动触发VB6相应的功能。
运行结果
习练至此，其它功能没练，调用webservice和socket至少可以通过DLL封装实现，因此，感觉这套基于PowerBASIC的RAD开发环境做简单应用开发是可行的。