== Developing a Noah Fitting Module ==
== Noah 2.0 Fitting Module ==
=== Module Installation ===
* Internal Setup Program: Registering the module using the Moduleinstall.ocx Component. (Required)
==== Internal Setup Program ====
The installation is performed from within the Noah System
* From within NOAH 2.0:
** Select from menu: Setup > Install Module
** Type the drive and folder name (full path) where the files are. For example: ''D:\''
* From within NOAH 3.0:
** Select from menu: Tools > Setup > Install Module
** Press button: < Install New Module >
** Find and select installer in folder where the files are: For example: ''D:\install.ini''
** Click on < Finish > button to finish the installation.
** Click on < Ok > when the dialog "Click OK when module installation is complete" shows up.
The module developer only needs to refer to the ''setup.exe''. For example, NOAHAud3’s ''install.ini'' has just two lines:
[Installation]
InstallCmd2=setup.exe
===== Installation of the Accessibility layer =====
Source: //NOAH 2.0 32-bit Accessibility Layer Installation//, NOAH 3.0 SDK, HIMSA.
The NOAH16.exe and Online32.exe must be installed, if your Module uses the 32-bit Accessibility
Layer. If your module is not using the NOAHvb.ocx then it is not necessary to install it.
Check the registry to see if the NOAH16.exe, the Online32.exe and the NOAHvb.ocx have already
been installed. If the components are already installed:
* Check the registry to see where the components have been installed
* Check the version of the components, if a more recent version exists then upgrade the components
* When upgrading one or all of the components install the components in same path as the existing components
* Do not assume that the components are installed in a certain path
* Do not uninstall any of the components
* Do not move any of the existing components
* Do not downgrade the existing version of the components
* Do not install any of the three components as shared
If the two components are not already installed. This is only the case when NOAH 3 in not installed, and no modules using the Accessibility Layer has previously been installed.
* Install the NOAH16.exe and the Online32.exe
* Register the two components in the registry
If your module uses the NOAHvb.ocx
* Install or upgrade the two runtime DLLs msvcrt.dll and mfc42.dll prior to installing the NOAHvb.ocx. Please note that these two DLLs could be used by other applications when your installation is launched. This will prevent you from upgrading the DLL’s immediately. The usual approach is to delay the upgrade until the next boot of the system.
===== How to check the registry =====
In order to find out if the Wrapper components have already been installed or where they have
been installed, then you will need to check the registry:
To find the entries in registry the Prog. ID’s are found in ''HKEY_CLASSES_ROOT''. The Prog. ID’s
have a CLSID. In ''HKEY_CLASSES_ROOT\CLSID\//{class ID for component}//'' you find the
''LocalServer'', ''LocalServer32'', ''InprocServer32'' paths respectively. The Prog. ID’s to look for are:
HKEY_CLASSES_ROOT\Noah16.ModuleIF
HKEY_CLASSES_ROOT\OnLine32.OnLine
HKEY_CLASSES_ROOT\NOAHVB.NoahVBCtrl
== Noah 3.0 Fitting Module ==
=== Module Installation ===
Installation types:
* External Setup Program: Registering the program using the module’s own Setup Program. (Required)
* Internal Setup Program: Registering the module using the Moduleinstall.ocx Component. (Optional)
==== External Setup Program ====
The module developer must program his own module setup program (for example, ''Setup.exe'') to register module data with the //Module Installation Server// component.
* Import Type Library:
** Open Delphi and create a new project.
** Select Project > Import Type Library.
** Select "ModuleInstallationServer 1.0 Type Library (Version 1.0)"
** Palette Name: Noah
** Unit dir name: ''C:\Program Files\Borland\Delphi7\Imports\''
** Check "Generate Component Wrapper".
** Press < Install > button.
* Place object ModuleInstServer1 (an instance of TModuleInstServer) on the project's main form.
* Create an Installation routine in the main form.
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, OleCtrls, ModuleInstallationServer_TLB;
type
TfrmMain = class(TForm)
btnInstall: TButton;
btnUninstall: TButton;
StatusBar1: TStatusBar;
ModuleInstServer1: TModuleInstServer;
procedure FormActivate(Sender: TObject);
procedure btnInstallClick(Sender: TObject);
procedure btnUninstallClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.dfm}
procedure TfrmMain.FormActivate(Sender: TObject);
begin
ModuleInstServer1.Initialize();
end;
//------------------------------------------------------------------------------
//{*
// @section procbtnInstallClick Procedure: btnInstallClick
// @brief
// @param[in] Sender: TObject
// @retval None
// @remarks Rev.History:
// - smayr 2007-Aug-31, Routine creation.
//
//------------------------------------------------------------------------------
procedure TfrmMain.btnInstallClick(Sender: TObject);
begin
var
oMod: Module;
oDTs: DataTypes;
oDT: DataType;
oProts: Protocols;
oProt: Protocol;
oSub: SubModule;
begin
try
// create objects
oMod := CoModule.Create();
oDTs := CoDataTypes.Create();
oDT := CoDataType.Create();
oProts := CoProtocols.Create();
oProt := CoProtocol.Create();
oSub := CoSubModule.Create();
try
// Set datatype that the module can make/show
oDT.Code := 1;
oDT.Format := 100;
// Add datatype to collection
oDTs.Add(oDT);
// Set on-line protocol and related datatype that the module supports
oProt.DataTypes := oDTs;
oProt.Number := 1;
oProts.Add(oProt);
// Set submodule
oSub.LocalID := 1;
oSub.ManufacturerID := 044; // 044=Audina, 1=HIMSA;
oMod.CanMake := oDTs;
oMod.CanShow := oDTs;
// ClassID of the module. Remember that the module must also have a valid ProgID entry.
oMod.CLSID := '{444DA45F-3BE7-11D1-BAD1-07704FC9C2B9}';
oMod.HelpPath := 'C:\Program Files\HIMSA\NOAH System\HIMSA\Modules\Fitting\044\FITTING.HLP';
//oMod.KeyName := 'NoKey';
oMod.LocalID := 2; // Manufacturer's internal Local Module Identifier
oMod.LogoDLLPath := 'C:\Program Files\HIMSA\NOAH System\HIMSA\Modules\Fitting\044\Logo044.dll'; // logo.dll
oMod.ManufacturerID := 044; // 044=Audina, 1=HIMSA;
oMod.Name := 'The AudinaTestManuf Module'; // module name
oMod.Protocols := oProts; // protocols used in Inter-module Communication (IMC)
oMod.Show := True;
// Set the module category using the ModuleInstallationServer collection of ModuleCategories
oMod.Category := ModuleInstServer1.ModuleCategories.Item[1];
oMod.SubModules.Add(oSub);
ModuleInstServer1.InstallModule('AudinaTestManuf', oMod);
except
on E:Exception do begin
ShowMessage('Error: '{+ IntToStr(Err.Number)} + ' ' + E.ClassName + ' ' + E.Message);
end;
end;
finally
// destroy objects (in reverse order)
oSub := nil;
oProt := nil;
oProts := nil;
oDT := nil;
oDTs := nil;
oMod := nil;
end;
end;
procedure TfrmMain.btnUninstallClick(Sender: TObject);
begin
try
ModuleInstServer1.UninstallModule(044 {ManufCode assigned by HIMSA},
2 {ModuleCode assigned by Manuf});
except
on E:Exception do begin
ShowMessage('Error: '+ E.ClassName + ' ' + E.Message);
end;
end;
end;
end.
==== Internal Setup Program ====
The installation is performed from within the Noah System
* From within NOAH 2.0:
** Select from menu: Setup > Install Module
** Type the drive and folder name (full path) where the files are. For example: ''D:\''
* From within NOAH 3.0:
** Select from menu: Tools > Setup > Install Module
** Press button: < Install New Module >
** Find and select installer in folder where the files are: For example: ''D:\install.ini''
** Click on < Finish > button to finish the installation.
** Click on < Ok > when the dialog "Click OK when module installation is complete" shows up.
The module developer only needs to refer to the ''setup.exe''. For example, NOAHAud3’s ''install.ini'' has just two lines:
[Installation]
InstallCmd2=setup.exe
==== Registry Keys ====
Once a NOAH 2.0 fitting module has been installed and registered in NOAH 3.0, these are the registry entries related to that module:
Windows Registry Editor Version 5.00
[HKEY_LOCAL_MACHINE\SOFTWARE\HIMSA\NOAH\Version 3.0\Modules\Audina Hearing Instruments]
"ID"=dword:0000002c
[HKEY_LOCAL_MACHINE\SOFTWARE\HIMSA\NOAH\Version 3.0\Modules\Audina Hearing Instruments\Module 44]
"Name"="Audina"
"Show"=hex:01
"Category"=dword:00000000
"ButtonDLLPath"="C:\\Program Files\\HIMSA\\Modules\\Fitting\\044\\Logo044.DLL"
"ID"=dword:0000002c
"CLSID"="C:\\Program Files\\HIMSA\\Modules\\Fitting\\044\\Fit044WM.exe"
"InstalledDate"=hex:94,49,aa,b5,72,33,e3,40
"HelpPath"="C:\\Program Files\\HIMSA\\Modules\\Fitting\\044\\FITTING.HLP"
"ActionMake"=hex:81,00,64,00,82,00,64,00,83,00,64,00,84,00,64,00,85,00,64,00
"ActionShow"=hex:81,00,64,00,82,00,64,00,83,00,64,00,84,00,64,00,85,00,64,00
=== Module Creation ===
==== Create Noah Components ====
Create Noah Components in Delphi for use in a Fitting Module by creating a project:
* Create a component project folder.
* Create a new Package (File > New > Other > Package (under New tab).
* Import ActiveX Components (click on Add icon, select Import ActiveX tab).
** Select the required Noah components to import (see list).
** Class Names: Rename each class names by adding a prefix to keep class names unique (eg. TModuleServer --> TNhModuleServer, TSession --> TNhSession).
** Palette Name: ''Noah''
** Unit Dir Name: //(point to project folder)//
** Add.
* Save and Build project, then Install components to the palette.
====== Required ActiveX Components (or Type Libraries) to import ======
* HimsaIMCClientCtrlLib: for Inter-process Communication in module development.
* HimsaIMCServerCtrlLib: N/A.
* IMCLib: for Inter-process Communication in module development.
* ModuleInstallationServer: for external module installation.
* ModuleServer: for module development.
* NoahActiveDocContainerLib: for module container.
====== Optional ActiveX Components (or Type Libraries) ======
Other possible NOAH Type Libraries to import:
db_tester
DBEVentServer
DH1030
DH1031
DH1033
DH1035
DH1036
DH1038
DH1040
DH1041
DH1043
DH1044
DH1045
DH1046
DH1049
DH1053
DH2052
DH2055
DH2057
DH2064
DH2070
DH3081
DH3082
DH3084
DH4105
DH4108
DH5129
FittingDataTrans
HimsaGeneralError
HIMSAIMCClientCtrl
HIMSAIMCServerCtrl
HIPAACryptation
HIPAALib
HitPrn2
imc
IMCLegacyClient
IMCLegacyServer
JournalPrintHandler ActiveX Control module
LegacyHost
LegacyIMCHost
LegacyPrintHandler
LocaleBase
Module Selection component presents logos for install modules
ModuleInstallation
ModuleInstallationServer
ModuleServer
MSProxy
NoahActiveDocContainer
NOAHAudiogram32
NOAHAudiogramC
NOAHAudReport
NoahBasicInterfaces
NoahClient
NoahCom
NoahDatabase
NoahDatabaseSchedulerSetup ActiveX Control module
NoahDatabaseTools
NoahDbHelper
NoahExtReport
NoahFitPrintHdl
NOAHFitting
NoahGlobalObjects
NoahLegacyConverter
NOAHLicenseServer
NoahProxy32
NOAHRemHitConverter
NoahReportGracphis ActiveX Control module
NoahServer
NoahUtil
NoahVB ActiveX Control module
NoahVersion
OfficeServer
OnLine32
OSPrintProxy
RainierChart
Sample VB module for VB
ScriptHost
SessionBrowser ActiveX Control module
VBPrintHelper
==== Create Active Document Container ====
The fitting module consists of an container (an Active Document Server, found in the form of an ActiveX component called "Noah Active Document Container") which will have the actual form (Active Document Server, in Delphi called Active Form).
To create the Active Document Container (ADC), perform the following steps:
* Install the type library NoahActiveDocContainer (see Importing Type Libraries, above).
* Create a Delphi project.
* Place a NoahModuleContainerCtrl object on the form.
* Add code to initalize and launch the module.
Example:
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IMCLib_TLB, NOAHACTIVEDOCCONTAINERLib_TLB, OleServer, OleCtrls,
StdCtrls;
type
TfrmMain = class(TForm)
NhModContainer: TNoahModuleContainerCtrl;
btnLaunchMod: TButton;
NhFrame1: TNhFrame;
procedure FormCreate(Sender: TObject);
procedure btnLaunchModClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure LaunchModule(ModProgId: string);
end;
function DataToVariant(const Data; Len: integer): Variant;
procedure DebugStr(str: string);
var
frmMain: TfrmMain;
implementation
{$R *.dfm}
//------------------------------------------------------------------------------
procedure TfrmMain.FormCreate(Sender: TObject);
//var
// ModProgID: string;
begin
// ModProgID := '{DB12A360-C57D-43A5-8BB9-23CDB46808E4}';
// LaunchModule(ModProgID);
end;
//------------------------------------------------------------------------------
procedure TfrmMain.btnLaunchModClick(Sender: TObject);
var
ModProgID: string;
begin
//ModProgID := 'GenericServer.Document'; //'{DB12A360-C57D-43A5-8BB9-23CDB46808E4}';
//ModProgID := 'Word.Basic'; //'{DB12A360-C57D-43A5-8BB9-23CDB46808E4}';
ModProgID := 'UnitSvr.AreaUnitConverter';
DebugStr('LaunchModule(): Ready to Launch Module = ' + ModProgID);
LaunchModule(ModProgID);
DebugStr('LaunchModule(): Finished launching module');
end;
//------------------------------------------------------------------------------
procedure TfrmMain.LaunchModule(ModProgId: string);
var
MenuWidth: array [0..2] of integer;
MenuTitles: array [0..2] of shortstring;
MenuIdx: array [0..2] of integer;
vMenuWidth: OleVariant;
vMenuTitles: OleVariant;
vMenuIdx: OleVariant;
begin
MenuWidth[0] := 1; // file menu group
MenuWidth[1] := 0; // application menu group
MenuWidth[2] := 1; // window menu group
vMenuWidth := DataToVariant(MenuWidth, Sizeof(integer)*3);
DebugStr('LaunchModule(): Size MenuWidth = ' + IntToStr(Sizeof(MenuWidth)));
// there are two menus in the application
MenuTitles[0] := '&File';
MenuTitles[1] := '&WindowsMenu';
vMenuTitles := DataToVariant(MenuTitles, Sizeof(MenuTitles));
DebugStr('LaunchModule(): Size MenuTitles = ' + IntToStr(Sizeof(MenuTitles)));
MenuIdx[0] := -1; // no application menus
MenuIdx[1] := 3; // window menu has position 1
MenuIdx[2] := 4; // helpmenu has position 2
vMenuIdx := DataToVariant(MenuIdx, Sizeof(integer)*3);
DebugStr('LaunchModule(): Size MenuIdx = ' + IntToStr(Sizeof(MenuIdx)));
try
NhModContainer.launch(vMenuWidth, vMenuTitles, vMenuIdx, ModProgID, 'NOAH 3.0');
//NhFrame1.launch(ModProgID, 'Noah Active Document Container');
except
on E:Exception do begin
DebugStr('LaunchModule(): Error ' + E.ClassName + ' ' + E.Message);
ShowMessage('LaunchModule(): Error ' + E.ClassName + ' ' + E.Message);
end;
end;
end;
//------------------------------------------------------------------------------
{*
// @section procDataToVariant Procedure: DataToVariant
// @brief
// @param[in] const Data; Len: integer
// @retval Variant
// @remarks Rev.History:
// - smayr 2007-Sep-27, Routine creation.
}
//------------------------------------------------------------------------------
function DataToVariant(const Data; Len: integer): Variant;
var
p: pByte;
begin
Result := VarArrayCreate([0,len-1], varByte);
p := VarArrayLock(Result);
try
move(Data, p^, Len);
finally
VarArrayUnLock(Result);
end;
end;
//------------------------------------------------------------------------------
procedure DebugStr(str: string);
begin
OutputDebugString(PChar(str));
end;
end.
===== Parent vs ParentWindow =====
From Delphi User Documentation: (("ParentWindow property (TWinControl)", Delphi Help, Borland))
ParentWindow refers to the window handle that underlies the parent control. To designate a non-VCL control as a parent, assign that control’s handle to ParentWindow. This assignment causes the control to be moved into the parent’s screen area. Setting ParentWindow has no effect if Parent is not nil (Delphi) or NULL (C++).
TActiveXControl objects use ParentWindow to insert a control in an ActiveX container window. ParentWindow is set automatically when a control is constructed with a call to CreateParented (Delphi) or the appropriate overloaded constructor (C++).
Some controls (such as ActiveX controls) are contained in native windows rather than in a parent VCL control. For these controls, the value of Parent is nil (Delphi) or NULL (C++) and the ParentWindow property specifies the window. (("Parent property (TControl)", Delphi Help, Borland))
==== Create Active Document Server ====
The actual work of the module is done by an Active Document Server (ADS). This ADS will be contained and launched by the Noah Module Container (Active Document Container).
Perform the following steps to create this ADS:
1. Hide the main form when started via automation. In the project file, add the line ''Application.ShowMainForm := (ComServer.StartMode = smStandAlone);'' before the creation of the forms.
For example (N3Module.dpr):
program N3Module;
uses
ComServ,
Forms,
DAXDocLib_TLB in 'DAXDocLib_TLB.pas',
Main in 'Main.pas' {DAXDocSvr: CoClass},
MainForm in 'MainForm.pas' {frmMain},
AxCtrls in 'AxCtrls.pas',
AxDocs in 'AxDocs.pas',
dlgIMCSvrSel in 'dlgIMCSvrSel.pas' {dlgIMCServerSelection};
{$R *.TLB}
{$R *.RES}
begin
Application.Initialize;
// Don't show main form when started via automation
Application.ShowMainForm := (ComServer.StartMode = smStandAlone);
Application.CreateForm(TfrmMain, frmMain);
Application.CreateForm(TdlgIMCServerSelection, dlgIMCServerSelection);
Application.Run;
end.
2. Make the form fit inside the module container window. For example (FormMain.pas):
procedure TfrmMain.FormActivate(Sender: TObject);
begin
if Application.ShowMainForm = False then begin
ShowWindow(Application.Handle, SW_HIDE); // hide application from Windows taskbar
self.BorderStyle := bsNone; // no borders
self.Align := alClient; // maximize inside Noah module container
end;
end;
3. Create and initialize ActiveX Document. For example (main.pas):
unit Main;
interface
uses
ComObj, ActiveX, AxDocs, Menus, ComCtrls, DAXDocLib_TLB, StdVcl;
type
TDAXDocSvr = class(TActiveXDocument, IDAXDocSvr, IPersistStreamInit)
private
FItem: TMenuItem;
FSubItem: TMenuItem;
protected
{ IPersistStreamInit }
function IPersistStreamInit.Load = PersistStreamLoad;
function IPersistStreamInit.Save = PersistStreamSave;
function IsDirty: HResult; stdcall;
public
destructor Destroy; override;
procedure DoMenuClick(Sender: TObject);
procedure Initialize; override;
end;
implementation
uses ComServ, StdCtrls, MainForm, AxCtrls, Windows, Dialogs;
{ TDelphiAxDoc }
destructor TDAXDocSvr.Destroy;
begin
inherited Destroy;
FSubItem.Free;
FItem.Free;
end;
procedure TDAXDocSvr.DoMenuClick(Sender: TObject);
begin
// with TColorDialog.Create(nil) do
// begin
// if Execute then (Control as TMemo).Color := Color;
// Free;
// end;
end;
procedure TDAXDocSvr.Initialize;
begin
inherited Initialize;
FItem := NewItem('&Change color', 0, False, True, DoMenuClick, 0, 'ColorItem');
FSubItem := NewSubMenu('&Edit', 0, 'EditItem', [FItem]);
Menu := NewMenu(Control, 'MainMenu', [FSubItem]);
end;
{ TDelphiAxDoc.IPersistStreamInit }
function TDAXDocSvr.IsDirty: HResult;
begin
// if (Control as TMemo).Modified then Result := S_OK
// else Result := S_FALSE;
result := S_FALSE;
end;
initialization
TActiveXDocumentFactory.Create(
ComServer {ComServerObject},
TDAXDocSvr {ActiveXDocClass},
TfrmMain {WinCtrlClass},
CLASS_DAXDocSvr {ClassID},
0 {ToolBoxBitmapID},
131473 {MiscStatus},
tmApartment {ThreadingModel},
'' {Handler. If empty, then 'ole32.dll'},
8 {DOCMISC_NOFILESUPPORT} {DocMiscStatus}
);
finalization
end.
4. Create a Type Library for the ActiveX Document Server. For example (DAXDocLib_TLB.pas):
unit DAXDocLib_TLB;
// ************************************************************************ //
// WARNING
// -------
// The types declared in this file were generated from data read from a
// Type Library. If this type library is explicitly or indirectly (via
// another type library referring to this type library) re-imported, or the
// 'Refresh' command of the Type Library Editor activated while editing the
// Type Library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ************************************************************************ //
// PASTLWTR : 1.2
// File generated on 10/2/2007 9:05:47 AM from Type Library described below.
// ************************************************************************ //
// Type Lib: D:\proj\ezFITNoah-Nh3Native\DAXDocSvr-N3Module\N3Module.tlb (1)
// LIBID: {1C76ACA2-F8F8-42F6-9C11-04C441289BAD}
// LCID: 0
// Helpfile:
// HelpString: Delphi ActiveX Document Server for Noah 3.0 Module
// DepndLst:
// (1) v2.0 stdole, (C:\WINDOWS\system32\stdole2.tlb)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface
uses Windows, ActiveX, Classes, Graphics, StdVCL, Variants;
// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// TypeLibrary Major and minor versions
DAXDocLibMajorVersion = 1;
DAXDocLibMinorVersion = 0;
LIBID_DAXDocLib: TGUID = '{1C76ACA2-F8F8-42F6-9C11-04C441289BAD}';
IID_IDAXDocSvr: TGUID = '{A0C777B2-1731-4869-8570-DC4D2D722000}';
CLASS_DAXDocSvr: TGUID = '{0E83087B-76E9-48D2-8285-9F72AD4C56AC}';
type
// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
IDAXDocSvr = interface;
IDAXDocSvrDisp = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
DAXDocSvr = IDAXDocSvr;
// *********************************************************************//
// Interface: IDAXDocSvr
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {A0C777B2-1731-4869-8570-DC4D2D722000}
// *********************************************************************//
IDAXDocSvr = interface(IDispatch)
['{A0C777B2-1731-4869-8570-DC4D2D722000}']
end;
// *********************************************************************//
// DispIntf: IDAXDocSvrDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {A0C777B2-1731-4869-8570-DC4D2D722000}
// *********************************************************************//
IDAXDocSvrDisp = dispinterface
['{A0C777B2-1731-4869-8570-DC4D2D722000}']
end;
// *********************************************************************//
// The Class CoDAXDocSvr provides a Create and CreateRemote method to
// create instances of the default interface IDAXDocSvr exposed by
// the CoClass DAXDocSvr. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoDAXDocSvr = class
class function Create: IDAXDocSvr;
class function CreateRemote(const MachineName: string): IDAXDocSvr;
end;
implementation
uses ComObj;
class function CoDAXDocSvr.Create: IDAXDocSvr;
begin
Result := CreateComObject(CLASS_DAXDocSvr) as IDAXDocSvr;
end;
class function CoDAXDocSvr.CreateRemote(const MachineName: string): IDAXDocSvr;
begin
Result := CreateRemoteComObject(MachineName, CLASS_DAXDocSvr) as IDAXDocSvr;
end;
end.
5. Include the ActiveX Document Support Unit ''AxDocs.pas'' (Author: Steve Teixeira) in the project. Here is the listing:
{*******************************************************}
{ }
{ ActiveX Document Support Unit }
{ Copyright (c) 1999, Steve Teixeira }
{ }
{*******************************************************}
unit AxDocs;
interface
uses
Windows, ComObj, ActiveX, AxCtrls, Controls, Classes, Menus, Messages, Variants;
type
TActiveXDocumentFactory = class;
TActiveXDocument = class(TActiveXControl, IOleDocument, IOleDocumentView,
IOleInPlaceActiveObject, IOleInPlaceObject)
private
FFactory: TActiveXDocumentFactory;
FMenu: TMainMenu;
FOleMenu: HMENU;
FSharedMenu: HMENU;
function GetAncestorValueByField(FieldNum: Cardinal): Cardinal;
procedure SetAncestorValueByField(FieldNum, Value: Cardinal);
function GetOleInPlaceSite: IOleInPlaceSite;
procedure SetOleInPlaceSite(const Value: IOleInPlaceSite);
procedure InPlaceMenuCreate;
procedure InPlaceMenuDestroy;
procedure MergeMenus(SharedMenu, SourceMenu: HMENU;
MenuWidths: PInteger; WidthIndex: Integer);
procedure UnmergeMenus(SharedMenu, SourceMenu: HMENU);
protected
{ IOleDocument methods }
function CreateView(Site: IOleInPlaceSite; Stream: IStream; rsrvd: DWORD;
out View: IOleDocumentView):HResult; stdcall;
function GetDocMiscStatus(var Status: DWORD):HResult; stdcall;
function EnumViews(out Enum: IEnumOleDocumentViews;
out View: IOleDocumentView):HResult; stdcall;
{ IOleDocumentView methods }
function SetInPlaceSite(Site: IOleInPlaceSite): HResult; stdcall;
function GetInPlaceSite(out Site: IOleInPlaceSite): HResult; stdcall;
function GetDocument(out P: IUnknown): HResult; stdcall;
function SetRect(const View: TRECT): HResult; stdcall;
function GetRect(var View: TRECT): HResult; stdcall;
function SetRectComplex(const View, HScroll, VScroll, SizeBox): HResult; stdcall;
function Show(fShow: BOOL): HResult; stdcall;
function UIActivate(fUIActivate: BOOL): HResult; stdcall;
function Open: HResult; stdcall;
function CloseView(dwReserved: DWORD): HResult; stdcall;
function SaveViewState(pstm: IStream): HResult; stdcall;
function ApplyViewState(pstm: IStream): HResult; stdcall;
function Clone(NewSite: IOleInPlaceSite; out NewView: IOleDocumentView):HResult; stdcall;
{ IOleInPlaceActiveObject }
function OnDocWindowActivate(fActivate: BOOL): HResult; stdcall;
{ IOleInPlaceObject }
function InPlaceDeactivate: HResult; stdcall;
{ Overrides }
procedure GetDocUIInfo(var Menu: TMainMenu);
function InPlaceActivate(ActivateUI: Boolean): HResult; override;
procedure WndProc(var Message: TMessage); override;
public
procedure Initialize; override;
function ObjQueryInterface(const IID: TGUID; out Obj): HResult; override;
property Menu: TMainMenu read FMenu write FMenu;
property OleInPlaceSite: IOleInPlaceSite read GetOleInPlaceSite write SetOleInPlaceSite;
end;
TActiveXDocClass = class of TActiveXDocument;
TActiveXDocumentFactory = class(TActiveXControlFactory)
private
FDocMiscStatus: DWORD;
FHandler: string;
public
property DocMiscStatus: DWORD read FDocMiscStatus;
constructor Create(ComServer: TComServerObject;
ActiveXDocClass: TActiveXDocClass; WinControlClass: TWinControlClass;
const ClassID: TGUID; ToolboxBitmapID, MiscStatus: Integer;
ThreadingModel: TThreadingModel; const Handler: string;
DocMiscStatus: DWORD);
procedure UpdateRegistry(Register: Boolean); override;
end;
implementation
uses ComServ, SysUtils, Forms;
{ TActiveXDocument }
function TActiveXDocument.ObjQueryInterface(const IID: TGUID; out Obj): HResult;
begin
// Must stub out IOleLink, or container will assume this is a linked object
// rather than an embedded object.
if IsEqualGuid(IID, IOleLink) then Result := E_NOINTERFACE
else Result := inherited ObjQueryInterface(IID, Obj);
end;
function TActiveXDocument.GetOleInPlaceSite: IOleInPlaceSite;
begin
// Work around fact that FOleInPlaceSite is private in TActiveXControl
// Note: this work around only guaranteed to work in Delphi 4
Result := IOleInPlaceSite(GetAncestorValueByField(9));
end;
procedure TActiveXDocument.SetOleInPlaceSite(const Value: IOleInPlaceSite);
begin
// Work around fact that FOleInPlaceSite is private in TActiveXControl
// Note: this work around only guaranteed to work in Delphi 4
SetAncestorValueByField(9, Cardinal(Value));
end;
function TActiveXDocument.GetAncestorValueByField(FieldNum: Cardinal): Cardinal;
var
ParentInstanceSize, Ofs: Cardinal;
begin
// Nasty hack: this method returns the value of a particular field in the
// ancestor class, with the assumption that the given field and all prior
// fields are 4 bytes in size.
ParentInstanceSize := ClassParent.ClassParent.InstanceSize;
Ofs := ParentInstanceSize + ((FieldNum - 1) * 4);
asm
mov eax, Self
add eax, Ofs
mov eax, dword ptr [eax]
mov @Result, eax
end;
end;
procedure TActiveXDocument.SetAncestorValueByField(FieldNum, Value: Cardinal);
var
ParentInstanceSize, Ofs: Cardinal;
begin
// Nasty hack: this method sets the value of a particular field in the
// ancestor class, with the assumption that the given field and all prior
// fields are 4 bytes in size.
ParentInstanceSize := ClassParent.ClassParent.InstanceSize;
Ofs := ParentInstanceSize + ((FieldNum - 1) * 4);
asm
mov eax, Self
add eax, Ofs
mov ecx, Value
mov dword ptr [eax], ecx
end;
end;
procedure TActiveXDocument.Initialize;
begin
inherited Initialize;
FFactory := Factory as TActiveXDocumentFactory;
end;
procedure TActiveXDocument.GetDocUIInfo(var Menu: TMainMenu);
begin
Menu := nil;
end;
function TActiveXDocument.InPlaceActivate(ActivateUI: Boolean): HResult;
begin
Result := inherited InPlaceActivate(ActivateUI);
InPlaceMenuCreate;
end;
procedure TActiveXDocument.WndProc(var Message: TMessage);
begin
inherited WndProc(Message);
if Message.Msg = WM_LBUTTONDBLCLK then InPlaceActivate(True);
end;
procedure TActiveXDocument.InPlaceMenuCreate;
var
IPFrame: IOleInPlaceFrame;
IPSite: IOleInPlaceSite;
IPUIWindow: IOleInPlaceUIWindow;
omgw: TOleMenuGroupWidths;
FrameInfo: TOleInPlaceFrameInfo;
PosRect, ClipRect: TRect;
begin
OleCheck(ClientSite.QueryInterface(IOleInPlaceSite, IPSite));
FrameInfo.cb := sizeof(FrameInfo);
IPSite.GetWindowContext(IPFrame, IPUIWindow, PosRect, ClipRect, FrameInfo);
FillChar(omgw, SizeOf(omgw), 0);
omgw.width[1] := 1;
// Create a blank menu and ask the container to add it's menus into the
// TOleMenuGroupWidths record
FSharedMenu := CreateMenu;
try
OleCheck(IPFrame.InsertMenus(FSharedMenu, omgw));
if FMenu = nil then Exit;
MergeMenus(FSharedMenu, FMenu.Handle, @omgw.width, 1);
// Send the menu to the client
FOleMenu := OleCreateMenuDescriptor(FSharedMenu, omgw);
IPFrame.SetMenu(FSharedMenu, FOleMenu, Control.Handle);
except
DestroyMenu(FSharedMenu);
FSharedMenu := 0;
raise;
end;
end;
procedure TActiveXDocument.InPlaceMenuDestroy;
var
IPFrame: IOleInPlaceFrame;
IPSite: IOleInPlaceSite;
IPUIWindow: IOleInPlaceUIWindow;
FrameInfo: TOleInPlaceFrameInfo;
PosRect, ClipRect: TRect;
begin
// Get the clients IOleInPlaceFrame so we can ask it to remove it's menu
OleCheck(ClientSite.QueryInterface(IOleInPlaceSite, IPSite));
FrameInfo.cb := sizeof(FrameInfo);
IPSite.GetWindowContext(IPFrame, IPUIWindow, PosRect, ClipRect, FrameInfo);
if IPFrame <> nil then IPFrame.SetMenu(0, 0, 0);
OleDestroyMenuDescriptor(FOleMenu);
FOleMenu := 0;
UnmergeMenus(FSharedMenu, FMenu.Handle);
end;
type
PIntArray = ^TIntArray;
TIntArray = array[0..0] of Integer;
procedure TActiveXDocument.MergeMenus(SharedMenu, SourceMenu: HMENU;
MenuWidths: PInteger; WidthIndex: Integer);
var
MenuItems, GroupWidth, Position, I, Len: Integer;
MenuState: UINT;
PopupMenu: HMENU;
ItemText: array[0..255] of char;
begin
// Copy the popups from the pMenuSource
MenuItems := GetMenuItemCount(SourceMenu);
GroupWidth := 0;
Position := 0;
// Insert at appropriate spot depending on WidthIndex
if (WidthIndex < 0) or (WidthIndex > 1) then Exit;
if WidthIndex = 1 then Position := MenuWidths^;
for I := 0 to MenuItems - 1 do
begin
// Get the HMENU of the popup
PopupMenu := GetSubMenu(SourceMenu, I);
// Separators move us to next group
MenuState := GetMenuState(SourceMenu, I, MF_BYPOSITION);
if (PopupMenu = NULL) and ((MenuState and MF_SEPARATOR) <> 0) then
begin
if WidthIndex > 5 then Exit; // Servers should not touch past 5
PIntArray(MenuWidths)^[WidthIndex] := GroupWidth;
GroupWidth := 0;
if WidthIndex < 5 then
Inc(Position, PIntArray(MenuWidths)^[WidthIndex + 1]);
Inc(WidthIndex, 2);
end
else begin
// Get the menu item text
Len := GetMenuString(SourceMenu, I, ItemText, SizeOf(ItemText), MF_BYPOSITION);
// Popups are handled differently than normal menu items
if PopupMenu <> 0 then
begin
if GetMenuItemCount(PopupMenu) <> 0 then
begin
// Strip the HIBYTE because it contains a count of items
MenuState := LoByte(MenuState) or MF_POPUP; // Must be popup
// Non-empty popup -- add it to the shared menu bar
InsertMenu(SharedMenu, Position, MenuState or MF_BYPOSITION, PopupMenu,
ItemText);
Inc(Position);
Inc(GroupWidth);
end;
end
else if Len > 0 then
begin
// only non-empty items are added
if ItemText <> '' then
begin
// here the state does not contain a count in the HIBYTE
InsertMenu(SharedMenu, Position, MenuState or MF_BYPOSITION,
GetMenuItemID(SourceMenu, I), ItemText);
Inc(Position);
Inc(GroupWidth);
end;
end;
end;
end;
end;
procedure TActiveXDocument.UnmergeMenus(SharedMenu, SourceMenu: HMENU);
var
TheseItems, MenuItems, I, J: Integer;
PopupMenu: HMENU;
begin
MenuItems := GetMenuItemCount(SharedMenu);
TheseItems := GetMenuItemCount(SourceMenu);
for I := MenuItems - 1 downto 0 do
begin
// Check the popup menus
PopupMenu := GetSubMenu(SharedMenu, I);
if PopupMenu <> 0 then
begin
// If it is one of ours, remove it from the SharedMenu
for J := 0 to TheseItems - 1 do
begin
if GetSubMenu(SourceMenu, J) = PopupMenu then
begin
// Remove the menu from SharedMenu
RemoveMenu(SharedMenu, I, MF_BYPOSITION);
Break;
end;
end;
end;
end;
end;
{ TActiveXDocument.IOleDocument }
function TActiveXDocument.CreateView(Site: IOleInPlaceSite;
Stream: IStream; rsrvd: DWORD; out View: IOleDocumentView): HResult;
var
OleDocView: IOleDocumentView;
begin
Result := S_OK;
try
if View = nil then
begin
Result := E_POINTER;
Exit;
end;
OleDocView := Self as IOleDocumentView;
if (OleInPlaceSite = nil) or (OleDocView = nil) then
begin
Result := E_FAIL;
Exit;
end;
// Use site provided
if Site <> nil then OleDocView.SetInPlaceSite(Site);
// Use stream provided for initialization
if Stream <> nil then OleDocView.ApplyViewState(Stream);
// Return the view
View := OleDocView;
except
Result := E_FAIL;
end;
end;
function TActiveXDocument.EnumViews(out Enum: IEnumOleDocumentViews;
out View: IOleDocumentView): HResult;
begin
Result := S_OK;
try
// We only support one view
View := Self as IOleDocumentView;
except
Result := E_FAIL;
end;
end;
function TActiveXDocument.GetDocMiscStatus(var Status: DWORD): HResult;
begin
Status := (Factory as TActiveXDocumentFactory).DocMiscStatus;
Result := S_OK;
end;
{ TActiveXDocument.IOleDocument }
function TActiveXDocument.ApplyViewState(pstm: IStream): HResult;
begin
Result := E_NOTIMPL;
end;
function TActiveXDocument.Clone(NewSite: IOleInPlaceSite;
out NewView: IOleDocumentView): HResult;
begin
Result := E_NOTIMPL;
end;
function TActiveXDocument.CloseView(dwReserved: DWORD): HResult;
begin
Result := S_OK;
try
Show(False);
SetInPlaceSite(nil);
except
Result := E_UNEXPECTED;
end;
end;
function TActiveXDocument.GetDocument(out P: IUnknown): HResult;
begin
Result := S_OK;
try
P := Self as IUnknown;
except
Result := E_FAIL;
end;
end;
function TActiveXDocument.GetInPlaceSite(out Site: IOleInPlaceSite): HResult;
begin
Result := S_OK;
try
Site := OleInPlaceSite;
except
Result := E_FAIL;
end;
end;
function TActiveXDocument.GetRect(var View: TRECT): HResult;
begin
Result := S_OK;
try
View := Control.BoundsRect;
except
Result := E_UNEXPECTED;
end;
end;
function TActiveXDocument.Open: HResult;
begin
Result := E_NOTIMPL;
end;
function TActiveXDocument.SaveViewState(pstm: IStream): HResult;
begin
Result := E_NOTIMPL;
end;
function TActiveXDocument.SetInPlaceSite(Site: IOleInPlaceSite): HResult;
begin
Result := S_OK;
try
if OleInPlaceSite <> nil then
Result := InPlaceDeactivate;
if Result <> S_OK then Exit;
if Site <> nil then OleInPlaceSite := Site;
except
Result := E_UNEXPECTED;
end;
end;
function TActiveXDocument.SetRect(const View: TRECT): HResult;
begin
// Implement using TActiveXControl's IOleInPlaceObject.SetObjectRects impl
Result := SetObjectRects(View, View);
end;
function TActiveXDocument.SetRectComplex(const View; const HScroll;
const VScroll; const SizeBox): HResult;
begin
Result := E_NOTIMPL;
end;
function TActiveXDocument.Show(fShow: BOOL): HResult;
begin
try
if fShow then
Result := InPlaceActivate(False)
else begin
Result := UIActivate(False);
Control.Visible := False;
end;
except
Result := E_UNEXPECTED;
end;
end;
function TActiveXDocument.UIActivate(fUIActivate: BOOL): HResult;
begin
Result := S_OK;
try
if FUIActivate then
begin
if OleInPlaceSite <> nil then InPlaceActivate(True)
else Result := E_UNEXPECTED;
end
else begin
UIDeactivate;
InPlaceMenuDestroy;
end;
except
Result := E_UNEXPECTED;
end;
end;
{ TActiveXDocument.IOleInPlaceActiveObject }
function TActiveXDocument.OnDocWindowActivate(fActivate: BOOL): HResult;
begin
Result := inherited OnDocWindowActivate(fActivate);
if fActivate then InPlaceMenuCreate
else InPlaceMenuDestroy;
end;
{ TActiveXDocument.IOleInPlaceObject }
function TActiveXDocument.InPlaceDeactivate: HResult;
var
ParentWnd: HWND;
begin
// This is a work-around for the fact that TActiveXControl implementation of
// this method makes the control go away to ParkingWindow la-la land. It
// needs to stay put within the document.
ParentWnd := Control.ParentWindow;
Result := inherited InplaceDeactivate;
Control.ParentWindow := ParentWnd;
Control.Visible := True;
end;
{ TActiveXDocumentFactory }
constructor TActiveXDocumentFactory.Create(ComServer: TComServerObject;
ActiveXDocClass: TActiveXDocClass; WinControlClass: TWinControlClass;
const ClassID: TGUID; ToolboxBitmapID, MiscStatus: Integer;
ThreadingModel: TThreadingModel; const Handler: string;
DocMiscStatus: DWORD);
begin
FDocMiscStatus := DocMiscStatus;
if Handler <> '' then FHandler := Handler
else FHandler := 'ole32.dll';
inherited Create(ComServer, ActiveXDocClass, WinControlClass, ClassId,
ToolboxBitmapID, '', MiscStatus, ThreadingModel);
end;
procedure TActiveXDocumentFactory.UpdateRegistry(Register: Boolean);
var
ClassKey, ProgKey, MiscFlags: string;
begin
ClassKey := 'CLSID\' + GUIDToString(ClassID) + '\';
ProgKey := ProgID + '\';
if Register then
begin
inherited UpdateRegistry(Register);
MiscFlags := IntToStr(FDocMiscStatus);
// Add reg keys under CLSID
CreateRegKey(ClassKey + 'DocObject', '', MiscFlags);
CreateRegKey(ClassKey + 'Programmable', '', '');
CreateRegKey(ClassKey + 'Insertable', '', '');
CreateRegKey(ClassKey + 'InprocHandler32', '', FHandler);
// Add reg keys under ProgID
CreateRegKey(ProgKey + 'DocObject', '', MiscFlags);
CreateRegKey(ProgKey + 'Insertable', '', '');
// Need to remove "control" key added by inherited method
DeleteRegKey(ClassKey + 'Control');
end
else begin
DeleteRegKey(ClassKey + 'DefaultExtension');
DeleteRegKey(ClassKey + 'DefaultIcon');
DeleteRegKey(ClassKey + 'DocObject');
DeleteRegKey(ClassKey + 'Programmable');
DeleteRegKey(ClassKey + 'Insertable');
DeleteRegKey(ClassKey + 'InprocHandler32');
DeleteRegKey(ProgKey + 'DocObject');
DeleteRegKey(ProgKey + 'Insertable');
inherited UpdateRegistry(Register);
end;
end;
end.
6. Create a customized ''AxCtrls.pas'' file:
* Make a copy of Delphi unit ''AxCtrls.pas'' (found under ''C:\Program Files\Borland\Delphi7\Source\Vcl'') and place it under the project folder.
* Edit the file ''AxCtrls.pas'' to make ''TActiveXControl.InPlaceActivate'' method ''Virtual''.
* Include this file in the project.
== Fitting Module Icon (Logo.DLL) ==
From the //NOAH 2.0 Framework System Architecture Specification//:
We need a DLL file containing logos used by the NOAH Framework selection screen when the user chooses a piece of measurement equipment or a hearing instrument. The logo DLL file must contain the following resources for both measurement and fitting modules:
* A bitmap named ''LOGO001'' of size 40x88 pixels by 16 colors. This bitmap will be shown by the NOAH Framework, when the user selects manufacturer.
* A string table with an entry numbered 1001. This string entry must contain a text identifying the module. The text should not exceed 30 characters in length.
* Optionally, the file may contain a bitmap name ''LOGO002'' of the same size as bitmap ''LOGO001'', but with 256 colors. The framework will automatically use this bitmap, if present, instead of ''LOGO001'' when running on a system with 256 or more colors.
* The name of the logo DLL must be unique among all NOAH modules.
===== Basic Steps =====
1. Create an icon file called ''logo16.bmp'' (16 colors Windows Bitmap) and ''logo256.bmp'' (256 colors Windows Bitmap). Each module must provide its icon, or logo, to NOAH upon installation. The icon must be 88x40 pixels (some other documentation specifies 90x40 pixels) and may use up to 256 colors.
2. Create a resource file ''LogoRes.RC''. NOTE: Do not ''#define'' the ''LOGO001'' and ''LOGO002'' resources because it then does not register the correct icon in Noah. Create file as follows:
LOGO001 BITMAP "logo16.bmp"
LOGO002 BITMAP "logo256.bmp"
STRINGTABLE
{
1001, "Audina ezFIT"
}
3. Create a resource-only DLL project ''Logo044.dpr'' in Delphi:
//------------------------------------------------------------------------------
// Unit Name: Logo044.dpr (for Logo044.dll)
// Author: smayr
// Date: 04-Sep-2007
// Purpose:
// Resource only DLL to contain Audina icon for Noah Fitting Module.
//------------------------------------------------------------------------------
library logo044;
{$R 'LogoRes.res' 'LogoRes.rc'} // modify these files with images
uses
SysUtils, Classes;
{$R *.res}
begin
end.
For more information, refer to:
* Section 6.7.1 of the //NOAH Framework System Architecture Specification// for a list of the necessary contents of the logo-DLL file.
* Section 3.2.5 "Sub Modules Object" in //Programmers Guide to NOAH 3 Module Development// for an explanation on how to use the logo icons.
== Tools ==
* Install NOAH 3.x SDK
* Use Module Tester to test the fitting module.
* Login using: User initials: adm, Password: Noah30
* No Login. Verify that the application icon properties have the "nologin" option to run without having to login: "C:\Program Files\HIMSA\NOAH 3.0 SDK\Tools\Module Tester\MODULETESTER.EXE" /nologin
== Glossary ==
====== ActiveX Document Server ======
An Automation Server that supports a number of specific interfaces (IPersistStorage, IPersistFile, IOleObject, IDataObject, IOleInPlaceObject, IOleInPlaceActiveObject, IOleDocument, IOleDocumentView, IOleCommandTarget (optional), IPrint (Optional)). It is made up of frames, documents and views. ((Teixeira, Steve. //COM Corner: ActiveX Documents, Part 1//. The Delphi Magazine, February 1999.))
* The frame is (IOleInPlaceFrame, IOleInPlaceSite, IOleContainer) the 'socket' provided by the container application in which the ActiveX Document resides.
* The document (IOleDocument) is the server data being manipulated in the container.
* The item (IOleDocumentView) represents a specific view of the document data.
====== ClassID ======
The GUID of an automation server or a COM interface. For example: '''{208464B8-70F5-4C7F-99B5-A8050138A54B}'''
====== Interface ======
"Conceptually, an interface is nothing more than a contract between the implementor of the interface and the user of the interface. By defining an interface, you are in effect saying, 'I see the need for this functionality. I recognize that this functionality could be implemented in many different ways. I don't really care how the functionality is physically implemented, but it had better adhere to these specifications.'" ((Harmon, Eric, //Delphi COM Programming//, Macmillan Technical Publishing, Indianapolis, IN, 2000.))
====== ProgID ======
The automation server name and document. For example: ''ModProgID := 'GenericServer.Document';''