Really all that's involved in making TXMLDocument available as a component is registering it and providing the property editors. According to one Borland source, Pro users actually have most of the property editor code needed to componentize TXMLDocument .
In order for us to "emulate" the designer code used in the enterprise SKU we need to create a Delphi unit, and, in the end, register the component. Keep in mind C++Builder can compile Delphi code. Let's take a look at this Delphi code in Listing D.1, which can found in the code folder for this appendix on the companion CD-ROM.
{*******************************************************} { } { TXMLDocument VCL Registration Support for BCB6/D6 Pro } { } { Developed by Paul Gustavson } { - pgustavson@simventions.com } { } { Special Thanks to Mark Edington of Borland for his } { guidance. } { } { This is open source. } { } {*******************************************************} unit xmlcomponent; //{$DEFINE D6BUILD} // comment this out for BCB6 build interface uses Dialogs, {$IFDEF D6BUILD} StrEdit, // use this for Delphi compilation / // not fully available under BCB6 compilation {$ENDIF} Classes, DesignEditors, DesignIntf, ToolsAPI, XMLDoc, HTTPProd, msxmldom, oxmldom, XMLIntf; type { TXMLDocumentEditor } TVerbProc = procedure of object; TVerbInfo = record Description: string; VerbProc: TVerbProc; end; TVerbInfoArray = array of TVerbInfo; TXMLDocumentEditor = class(TComponentEditor) private FVerbs: TVerbInfoArray; FDocument: TXMLDocument; protected procedure AddVerbInfo(const Description: string; const VerbProc: TVerbProc); property Document: TXMLDocument read FDocument; property Verbs: TVerbInfoArray read FVerbs; public procedure AfterConstruction; override; procedure Edit; override; procedure ExecuteVerb(Index: Integer); override; function GetVerb(Index: Integer): string; override; function GetVerbCount: Integer; override; procedure EditXMLFile; procedure OpenXMLFile; procedure SaveXMLFile; end; { TXMLDocumentFileProperty } TXMLDocumentFileProperty = class(TStringProperty) public function GetAttributes: TPropertyAttributes; override; procedure Edit; override; end; { TXMLDocumentDOMVendorProperty } TXMLDocumentDOMVendorProperty = class(TClassProperty) public function GetAttributes: TPropertyAttributes; override; procedure GetValues(Proc: TGetStrProc); override; function GetValue: string; override; procedure SetValue(const Value: string); override; end; { TXMLNodeIndentStrProperty } TXMLNodeIndentStrProperty = class(TStringProperty) protected function LiteralToDesc(const Literal: string): string; public function GetAttributes: TPropertyAttributes; override; procedure GetValues(Proc: TGetStrProc); override; function GetValue: string; override; procedure SetValue(const Value: string); override; end; { TXMLProperty } // unable to support this property in BCB6 {$IFDEF D6BUILD} TXMLProperty = class(TStringListProperty) public function GetValue: string; override; end; {$ENDIF} { TXMLDocumentSelectionEditor } TXMLDocumentSelectionEditor = class(TSelectionEditor) public procedure RequiresUnits(Proc: TGetStrProc); override; end; procedure Register; { this must appear in the interface section } // ----------------------------------------------------------------------------- // ----------------------------------------------------------------------------- implementation uses ExtActns, SysUtils, xmldom; const Tab = #9; STab = 'tab'; SSpace = ' space'; SOpenXMLTitle = 'Open XML Document'; SXMLExtension = '.xml'; SXMLFilter = 'XML Files (*.xml)*.xmlXSL Files (*.xsl)*.xslSchema Files (*.xsd,*.xdr, *.biz)*.xsd;*.xdr;*.bizXML Skin Files (*.xkn)*.xknHTML Files (*.html)*.html;*. htmAll files (*.*)*.*'; sXMLEditDataFile = 'Edit XML file (code editor)'; sXMLOpenDataFile = 'Open XML file (external editor)'; sXMLSaveDataFile = 'Save XML file...'; // ----------------------------------------------------------------------------- { TXMLDocumentEditor } procedure TXMLDocumentEditor.AfterConstruction; begin inherited; FDocument := GetComponent as TXMLDocument; end; // ----------------------------------------------------------------------------- procedure TXMLDocumentEditor.AddVerbInfo(const Description: string; const VerbProc: TVerbProc); var OldLen: Integer; begin OldLen := Length(Verbs); SetLength(FVerbs, OldLen+1); Verbs[OldLen].Description := Description; Verbs[OldLen].VerbProc := VerbProc; end; //----------------------------------------------------------------------------- procedure TXMLDocumentEditor.Edit; begin EditXMLFile; end; //----------------------------------------------------------------------------- procedure TXMLDocumentEditor.EditXMLFile; var ActServ: IOTAActionServices; begin ActServ := BorlandIDEServices as IOTAActionServices; if DesignerFileManager <> nil then ActServ.OpenFile(DesignerFileManager.QualifyFileName(Document.FileName)) else ActServ.OpenFile(Document.FileName) end; //----------------------------------------------------------------------------- procedure TXMLDocumentEditor.OpenXMLFile; begin with TFileRun.Create(nil) do try FileName := Document.FileName; if DesignerFileManager <> nil then FileName := DesignerFileManager.QualifyFileName(FileName); Execute; finally Free; end; end; //----------------------------------------------------------------------------- procedure TXMLDocumentEditor.SaveXMLFile; var InitialDir, FileName: string; begin FileName := Document.FileName; InitialDir := ExtractFilePath(FileName); // if PromptForFileName(FileName, SXMLFilter, SXML, '', InitialDir, True) then if PromptForFileName(FileName, SXMLFilter, SXMLExtension, '', InitialDir, True) then Document.SaveToFile(FileName); end; //----------------------------------------------------------------------------- procedure TXMLDocumentEditor.ExecuteVerb(Index: Integer); begin inherited; Verbs[Index].VerbProc; end; //----------------------------------------------------------------------------- function TXMLDocumentEditor.GetVerb(Index: Integer): string; begin Result := Verbs[Index].Description; end; //----------------------------------------------------------------------------- function TXMLDocumentEditor.GetVerbCount: Integer; begin if Document.FileName <> '' then begin if FileExists(Document.FileName) then begin AddVerbInfo(sXMLEditDataFile, EditXMLFile); AddVerbInfo(sXMLOpenDataFile, OpenXMLFile); end; if Document.Active then AddVerbInfo(sXMLSaveDataFile, SaveXMLFile); end; Result := Length(Verbs); end; //----------------------------------------------------------------------------- { TXMLDocumentFileProperty } function TXMLDocumentFileProperty.GetAttributes: TPropertyAttributes; begin Result := [paDialog, paMultiSelect]; end; //----------------------------------------------------------------------------- procedure TXMLDocumentFileProperty.Edit; const SXMLExt = 'xml'; { Do not localize } var FileName: string; begin FileName := GetValue; if PromptForFileName(FileName, SXMLFilter, SXMLExt, SOpenXMLTitle) then SetValue(FileName); end; //----------------------------------------------------------------------------- { TXMLDocumentDOMVendorProperty } function TXMLDocumentDOMVendorProperty.GetAttributes: TPropertyAttributes; begin Result := [paValueList, paMultiSelect]; end; //----------------------------------------------------------------------------- procedure TXMLDocumentDOMVendorProperty.GetValues(Proc: TGetStrProc); var I: Integer; begin for I := 0 to DOMVendors.Count - 1 do Proc(DOMVendors[I].Description); end; //----------------------------------------------------------------------------- function TXMLDocumentDOMVendorProperty.GetValue: string; begin if Assigned(TXMLDocument(GetComponent(0)).DOMVendor) then Result := TXMLDocument(GetComponent(0)).DOMVendor.Description else Result := ''; end; //----------------------------------------------------------------------------- procedure TXMLDocumentDOMVendorProperty.SetValue(const Value: string); var DOMVendor: TDOMVendor; begin if Value = '' then DOMVendor := nil else DOMVendor := DOMVendors.Find(Value); TXMLDocument(GetComponent(0)).DOMVendor := DOMVendor; Modified; end; //----------------------------------------------------------------------------- { TXMLNodeIndentStrProperty } function TXMLNodeIndentStrProperty.LiteralToDesc(const Literal: string): string; var PropLen: Integer; Desc: string; begin { Translate the literal string into a descriptive string (' ' = <1 space>) } if Literal = Tab then Desc := STab else begin PropLen := Length(Literal); if StringOfChar(' ', PropLen) = Literal then begin Desc := IntToStr(PropLen)+ SSpace; if PropLen > 1 then Desc := Desc + 's'; end; end; if Desc <> '' then Result := '<'+Desc+'>' else Result := Literal; end; //----------------------------------------------------------------------------- function TXMLNodeIndentStrProperty.GetAttributes: TPropertyAttributes; begin Result := [paValueList, paMultiSelect]; end; //----------------------------------------------------------------------------- function TXMLNodeIndentStrProperty.GetValue: string; begin Result := LiteralToDesc(inherited GetValue); end; //----------------------------------------------------------------------------- procedure TXMLNodeIndentStrProperty.GetValues(Proc: TGetStrProc); var I: Integer; begin Proc('<'+STab+'>'); Proc('<1'+SSpace+'>'); for I := 2 to 8 do Proc('<'+IntToStr(I)+SSpace+'s>'); end; //----------------------------------------------------------------------------- procedure TXMLNodeIndentStrProperty.SetValue(const Value: string); var I: Integer; literal: string; begin { If it's <1 space> or <tab> then translate it } if LiteralToDesc(Tab) = Value then inherited SetValue(Tab) else begin for I := 1 to 8 do begin Literal := StringOfChar(' ', I); if LiteralToDesc(Literal) = Value then begin inherited SetValue(Literal); Exit; end; end; { Otherwise, just store what we got } inherited SetValue(Value); end; end; //----------------------------------------------------------------------------- { TXMLProperty } // unable to support this property in BCB6 {$IFDEF D6BUILD} function TXMLProperty.GetValue: string; begin with (GetComponent(0) as TXMLDocument) do if (XML.Count > 0) and (FileName = '') then Result := '(XML)' else Result := '(xml)'; end; {$ENDIF} //----------------------------------------------------------------------------- { TXMLDocumentSelectionEditor } procedure TXMLDocumentSelectionEditor.RequiresUnits(Proc: TGetStrProc); begin Proc('xmldom'); Proc('XMLIntf'); end; //----------------------------------------------------------------------------- // "register" procedure... procedure Register; begin RegisterComponents('Internet', [TXMLDocument]); RegisterComponentEditor(TXMLDocument, TXMLDocumentEditor); RegisterPropertyEditor(TypeInfo(TDOMVendor), TXMLDocument, 'DOMVendor', TXMLDocumentDOMVendorProperty); RegisterPropertyEditor(TypeInfo(WideString), TXMLDocument, 'FileName', TXMLDocumentFileProperty); RegisterPropertyEditor(TypeInfo(WideString), TXMLDocument, 'NodeIndentStr', TXMLNodeIndentStrProperty); {$IFDEF D6BUILD} RegisterPropertyEditor(TypeInfo(TStrings), TXMLDocument, 'XML', TXMLProperty); // unable to support this property in BCB6 {$ENDIF} RegisterSelectionEditor(TXMLDocument, TXMLDocumentSelectionEditor); end; end.
You'll notice in this code, that a compilation flag is used to differentiate between a C++Builder build and Delphi build. One of the issues is that C++Builder won't compile with StrEdit in the Uses clause. You'll receive a Pascal Fatal Error - "File not found: 'StrEdit.DCU'." However, if you compile the code under Delphi, everything is fine. While most of the expected capabilities are supported by C++Builder, not all the property elements are available. For those elements that are not available, we simply choose to ignore them under C++Builder using a compile time constant that we've defined called D6BUILD . Despite missing a few elements for C++Builder, there's still plenty of design-time support that will be provided.
NOTE
There was no predefined constant that could be used to differentiate between a C++Builder compilation and a Delphi compilation. Thus, we had to create our own.
TIP
If you have Delphi to compile this code, one of the other options is to create a Delphi package, which will generate a .BPL file that should work just fine in C++Builder. Simply install the BPL file using the Install Packages menu item selection.
Top |