Load HTML from IPersistMoniker to add base URL to relative links - c++builder

I am attempting to load HTML from URL using IPersistMoniker to add relative URLs base path, for example <img src="foo.jpg"> to load from mypath/images/ (or any other path). From what I found the process is (based on this example):
implement IMoniker instance, in particular GetDisplayName (gives the URL for relative links) and BindToStorage (loads the content)
QueryInterface of the TWebBrowser Document for IID_IPersistMoniker
CreateBindCtx (not sure what this is for though)
use Load method of the IPersistMoniker to load HTML, passing the IMoniker instance from (1) and CreateBindCtx instance from (3)
GetDisplayName in my instance does get called, but the BindToStorage where I am supposed to pass the IStream to the actual HTML never gets called so the document always turns out blank, not loaded. The HRESULT is E_INVALIDARG for the call to Load. What have I missed?
IMoniker implementation (some things omitted):
// Simple IMoniker implementation
class TMoniker : public IMoniker
{
private: OleVariant baseUrl;
TMemoryStream* memStream;
LONG m_cRef;
public: TMoniker(const UnicodeString& fBaseUrl, const UnicodeString& fContent)
{
m_cRef = 1; // Set to 1 so that the AddRef() doesn't need to be called when initialized the first time
this->baseUrl = fBaseUrl;
memStream = new TMemoryStream;
memStream->LoadFromFile(fContent.SubString(8,fContent.Length()));
memStream->Position = 0;
}
//--------------------------------------------------------------
// IUnknown
//--------------------------------------------------------------
STDMETHODIMP QueryInterface(REFIID riid, void** ppv);
STDMETHODIMP_(ULONG) AddRef();
STDMETHODIMP_(ULONG) Release();
//--------------------------------------------------------------
// IMoniker
//--------------------------------------------------------------
STDMETHODIMP GetDisplayName(IBindCtx *pbc, IMoniker *pmkToLeft, LPOLESTR *ppszDisplayName)
{
Application->MessageBox(L"GetDisplayName", L"Info", MB_OK); // Check if method is called
// UPDATE - should be *ppszDisplayName = this->baseUrl;
ppszDisplayName = this->baseUrl;
return S_OK;
}
STDMETHODIMP BindToStorage(IBindCtx *pbc, IMoniker *pmkToLeft, REFIID riid, void **ppvObj)
{
Application->MessageBox(L"BindToStorage", L"Info", MB_OK); // Check if method is called
ppvObj = NULL;
if (IsEqualIID(riid, IID_IStream))
{
Application->MessageBox(L"IMoniker::BindToStorage", L"Info", MB_OK);
// DelphiInterface<IStream> sa(*(new TStreamAdapter(memStream.get(), soReference)));
// ppvObj = (IStream)sa;
}
return S_OK;
}
STDMETHODIMP BindToObject(IBindCtx *pbc, IMoniker *pmkToLeft, REFIID riidResult, void **ppvResult) { return E_NOTIMPL; }
STDMETHODIMP Reduce(IBindCtx *pbc, DWORD dwReduceHowFar, IMoniker **ppmkToLeft, IMoniker **ppmkReduced) { return E_NOTIMPL; }
STDMETHODIMP ComposeWith(IMoniker *pmkRight, BOOL fOnlyIfNotGeneric, IMoniker **ppmkComposite) { return E_NOTIMPL; }
STDMETHODIMP Enum(BOOL fForward, IEnumMoniker **ppenumMoniker) { return E_NOTIMPL; }
STDMETHODIMP IsEqual(IMoniker *pmkOtherMoniker) { return E_NOTIMPL; }
STDMETHODIMP Hash(DWORD *pdwHash) { return E_NOTIMPL; }
STDMETHODIMP IsRunning(IBindCtx *pbc, IMoniker *pmkToLeft, IMoniker *pmkNewlyRunning) { return E_NOTIMPL; }
STDMETHODIMP GetTimeOfLastChange(IBindCtx *pbc, IMoniker *pmkToLeft, FILETIME *pFileTime) { return E_NOTIMPL; }
STDMETHODIMP Inverse(IMoniker **ppmk) { return E_NOTIMPL; }
STDMETHODIMP CommonPrefixWith(IMoniker *pmkOther, IMoniker **ppmkPrefix) { return E_NOTIMPL; }
STDMETHODIMP RelativePathTo(IMoniker *pmkOther, IMoniker **ppmkRelPath) { return E_NOTIMPL; }
STDMETHODIMP ParseDisplayName(IBindCtx *pbc, IMoniker *pmkToLeft, LPOLESTR pszDisplayName, ULONG *pchEaten, IMoniker **ppmkOut) { return E_NOTIMPL; }
STDMETHODIMP IsSystemMoniker(DWORD *pdwMksys) { return E_NOTIMPL; }
//--------------------------------------------------------------
// IPersistStream
//--------------------------------------------------------------
STDMETHODIMP IsDirty() { return E_NOTIMPL; }
STDMETHODIMP Load(IStream *pStm) { return E_NOTIMPL; }
STDMETHODIMP Save(IStream *pStm, BOOL fClearDirty) { return E_NOTIMPL; }
STDMETHODIMP GetSizeMax(ULARGE_INTEGER *pcbSize) { return E_NOTIMPL; }
//--------------------------------------------------------------
// IPersist
//--------------------------------------------------------------
STDMETHODIMP GetClassID(CLSID *pClassID) { return E_NOTIMPL; }
};
//------------------------------------------------------------------------------
// IUnknown::QueryInterface
//------------------------------------------------------------------------------
STDMETHODIMP TMoniker::QueryInterface(REFIID riid, void** ppv)
{
if (!ppv) return E_POINTER;
if (IID_IUnknown == riid) *ppv = (IUnknown *) this;
else if (IID_IMoniker == riid) *ppv = (IMoniker *) this;
else if (IID_IPersistStream == riid) *ppv = (IPersistStream *)this;
else if (IID_IPersist == riid) *ppv = (IPersist *) this;
else
{
*ppv = NULL;
return E_NOINTERFACE;
}
// AddRef It
((IUnknown*)*ppv)->AddRef();
return S_OK;
}
//------------------------------------------------------------------------------
// IUnknown::AddRef
//------------------------------------------------------------------------------
STDMETHODIMP_(ULONG) TMoniker::AddRef()
{
return ::InterlockedIncrement(&m_cRef);
}
//------------------------------------------------------------------------------
// IUnknown::Release
//------------------------------------------------------------------------------
STDMETHODIMP_(ULONG) TMoniker::Release()
{
LONG cRef = ::InterlockedDecrement(&m_cRef);
if (0 == cRef) delete this;
return cRef;
}
Load the content:
TMoniker* pMnk = new TMoniker("about:blank", "file://c:\\temp\\file.html");
LPBC pbc=0;
DelphiInterface<IHTMLDocument2> diDoc2 = WB->Document;
if (diDoc2)
{
DelphiInterface<IPersistMoniker> diPM;
if (SUCCEEDED(diDoc2->QueryInterface(IID_IPersistMoniker, (void**)&diPM)))
{
if (SUCCEEDED(CreateBindCtx(0, &pbc)))
{
// !!! returns `E_INVALIDARG` here !!!
if (SUCCEEDED(diPM->Load(TRUE, pmk, pbc, STGM_READWRITE)))
{
}
}
}
}
if (pbc) pbc->Release();
pMnk->Release();

I see a few issues with your code:
the ppszDisplayName parameter of GetDisplayName() is an [out] parameter. It receives the address of a caller-provided OLESTR* pointer, and you are expected to set that pointer to an OLE string that is allocated with IMalloc::Alloc() or equivalent. But you are not doing that. In fact, you are not returning any string back to the caller at all, because you are not dereferencing the ppszDisplayName parameter so you can access the pointer it is pointing at to assign a value to it.
You can change baseUrl from OleVariant to WideString, and then use WideString::Copy() (which uses SysAllocStringLen(), which is compatible with IMalloc) to return an allocated copy of baseUrl to the caller:
private: WideString baseUrl;
STDMETHODIMP GetDisplayName(IBindCtx *pbc, IMoniker *pmkToLeft, LPOLESTR *ppszDisplayName)
{
//Application->MessageBox(L"GetDisplayName", L"Info", MB_OK); // Check if method is called
if (!ppszDisplayName) return E_POINTER;
*ppszDisplayName = baseUrl.Copy();
return S_OK;
}
the ppvObj parameter of BindToStorage() is likewise also an [out] parameter, but you are not dereferencing the passed pointer to return something back to the caller.
You were on the right track using TStreamAdapter, though, you just need to finish it:
STDMETHODIMP BindToStorage(IBindCtx *pbc, IMoniker *pmkToLeft, REFIID riid, void **ppvObj)
{
//Application->MessageBox(L"BindToStorage", L"Info", MB_OK); // Check if method is called
if (!ppvObj) return E_POINTER;
*ppvObj = NULL;
if (!IsEqualIID(riid, IID_IStream)) return E_NOINTERFACE;
//Application->MessageBox(L"IMoniker::BindToStorage", L"Info", MB_OK);
DelphiInterface<IStream> sa(*(new TStreamAdapter(memStream.get(), soReference)));
*ppvObj = (IStream*)sa;
/* or simply:
*ppvObj = (IStream*) *(new TStreamAdapter(memStream.get(), soReference));
*/
sa->AddRef(); // <-- don't forget this, whether you use DelphiInterface or not!
return S_OK;
}
However, I would actually suggest changing memStream from TMemoryStream to IStream so it is not possible for any IStream given out by BindToStorage() to outlive the HTML data it is referring to:
#include <System.StrUtils.hpp>
#include <memory>
private: DelphiInterface<IStream> diStrm;
TMoniker(const UnicodeString& fBaseUrl, const UnicodeString& fContent)
{
...
UnicodeString path = fContent;
if (StartsText(L"file://", fContent))
path.Delete(1, 7);
std::auto_ptr<TMemoryStream> memStream(new TMemoryStream); // or std::unique_ptr in C++11 and later...
memStream->LoadFromFile(fContent);
memStream->Position = 0;
diStrm = *(new TStreamAdapter(memStream.get(), soOwned));
memStream.release();
}
...
STDMETHODIMP BindToStorage(IBindCtx *pbc, IMoniker *pmkToLeft, REFIID riid, void **ppvObj)
{
return diStrm->QueryInterface(riid, ppvObj);
}
though this is optional, I highly suggest you wrap the pMnk and pbc variables in DelphiInterface or other smart COM pointer, let it handle calling Release() for you. You can also use OleCheck() to simplify your error handling:
DelphiInterface<IHTMLDocument2> diDoc2 = WB->Document;
if (diDoc2)
{
DelphiInterface<IPersistMoniker> diPM;
OleCheck(diDoc2->QueryInterface(IID_IPersistMoniker, (void**)&diPM));
// or: OleCheck(diDoc2->QueryInterface(IID_PPV_ARGS(&diPM)));
DelphiInterface<IBindCtx> diBC;
OleCheck(CreateBindCtx(0, &diBC));
// set m_cRef to 0 in the TMoniker constructor, not 1...
DelphiInterface<IMoniker> diMnk(new TMoniker(L"about:blank", L"file://c:\\temp\\file.html"));
OleCheck(diPM->Load(TRUE, diMnk, diBC, STGM_READ));
}

Related

Catching WM_POWERBROADCAST in a TWinControl child control

I have a TWinControl that needs to catch WM_POWERBROADCAST messages, but they never seem to reach it despite adding the message handler to the control's VCL_MESSAGE_MAP. I've also tried a custom WndProc() and that also never receives these messages. Other messages are working fine.
I can catch the message successfully in the main form, but it's never passed to my controls.
BEGIN_MESSAGE_MAP
VCL_MESSAGE_HANDLER(WM_PAINT, TMessage, WMPaint); // Works
VCL_MESSAGE_HANDLER(WM_ERASEBKGND, TMessage, WMEraseBackground); // Works
VCL_MESSAGE_HANDLER(WM_POWERBROADCAST, TMessage, WMPower); // Doesn't work!
END_MESSAGE_MAP(inherited);
WM_POWERBROADCAST is sent only to top-level windows, never to child windows. So, you have a few choices:
have your WinControl intercept the message that is sent to the hidden TApplication window by using the TApplication.HookMainWindow() method. Be sure to remove the hook when your WinControl is destroyed.
__fastcall TMyControl::TMyControl(TComponent *Owner)
: TWinControl(Owner)
{
Application->HookMainWindow(&AppHook);
}
__fastcall TMyControl::~TMyControl()
{
Application->UnhookMainWindow(&AppHook);
}
bool __fastcall TMyControl::AppHook(TMessage &Message)
{
if (Message.Msg == WM_POWERBROADCAST)
{
// ...
}
return false;
}
intercept the message that is sent to the TForm window, either by applying a MESSAGE_MAP to the Form class, or by overriding the Form's virtual WndProc() method, and then have the From forward the message to your WinControl.
BEGIN_MESSAGE_MAP
...
VCL_MESSAGE_HANDLER(WM_POWERBROADCAST, TMessage, WMPowerBroadcast);
END_MESSAGE_MAP(inherited);
...
void __fastcall TForm1::WMPowerBroadcast(TMessage &Message)
{
inherited::Dispatch(&Message);
MyControl->Perform(Message.Msg, Message.WParam, Message.LParam);
}
Or:
void __fastcall TForm1::WndProc(TMessage &Message)
{
inherited::WndProc(Message);
if (Message.Msg == WM_POWERBROADCAST)
MyControl->Perform(Message.Msg, Message.WParam, Message.LParam);
}
have your WinControl create its own hidden top-level window by using the RTL's AllocateHWnd() function.
private:
HWND FPowerWnd;
void __fastcall PowerWndProc(TMessage &Message);
...
__fastcall TMyControl::TMyControl(TComponent *Owner)
: TWinControl(Owner)
{
FPowerWnd = AllocateHWnd(&PowerWndProc);
}
__fastcall TMyControl::~TMyControl()
{
DeallocateHWnd(FPowerWnd);
}
void __fastcall TMyControl::PowerWndProc(TMessage &Message)
{
if (Message.Msg == WM_POWERBROADCAST)
{
// ...
}
else
{
Message.Result = ::DefWindowProc(FPowerWnd, Message.Msg, Message.WParam, Message.LParam);
}
}

reinit.pas translated to C++

I have semi-successfully translated reinit.pas to C++ to use it in my project. The part where int __fastcall LoadNewResourceModule(LCID locale); is called works fine, in fact I can even call it prior to Application->Initialize() and it will load the proper language at startup. However, the part that calls void __fastcall ReinitializeForms(void); does not work, and gives a runtime error:
Resource TControl not found
Here is the dirty version of .cpp, and .h, I've yet to clean it up and comment it properly, at this point the thing just has to work fully. Please help me sort this out.
//---------------------------------------------------------------------------
#include <System.Classes.hpp>
#include <SysInit.hpp>
#include <Vcl.Forms.hpp>
#pragma hdrstop
#include "reinit.h"
//---------------------------------------------------------------------------
#pragma package(smart_init)
class TAsInheritedReader : public TReader
{
public:
void __fastcall ReadPrefix(TFilerFlags &_flags, int &_aChildPos);
inline __fastcall TAsInheritedReader(TStream* Stream, int BufSize) : TReader(Stream, BufSize) {}
};
//---------------------------------------------------------------------------
void __fastcall TAsInheritedReader::ReadPrefix(TFilerFlags &_flags, int &_aChildPos)
{
TReader::ReadPrefix(_flags, _aChildPos);
_flags = _flags << ffInherited;
}
//---------------------------------------------------------------------------
int __fastcall SetResourceHInstance(int _newInstance)
{
PLibModule CurModule = LibModuleList;
while(CurModule != NULL) {
if (reinterpret_cast<void*>(CurModule->Instance) == HInstance) {
if (CurModule->ResInstance != CurModule->Instance) {
FreeLibrary(reinterpret_cast<HMODULE>(CurModule->ResInstance));
CurModule->ResInstance = _newInstance;
return _newInstance;
}
CurModule = CurModule->Next;
}
}
return 0;
}
//---------------------------------------------------------------------------
int __fastcall LoadNewResourceModule(LCID locale)
{
wchar_t FileName[260];
PChar P;
wchar_t LocaleName[4];
int NewInst = 0;
GetModuleFileName(HInstance, FileName, sizeof(FileName));
GetLocaleInfo(locale, LOCALE_SABBREVLANGNAME, LocaleName, sizeof(LocaleName));
P = PChar(&FileName) + lstrlen(FileName);
while((*P != L'.') && (P != reinterpret_cast<PChar>(&FileName))) {
--P;
}
if (P != reinterpret_cast<PChar>(&FileName)) {
++P;
if (LocaleName[0] != L'\0') {
NewInst = reinterpret_cast<int>(LoadLibraryEx(FileName, 0, LOAD_LIBRARY_AS_DATAFILE));
if (NewInst == 0) {
LocaleName[2] = L'\0';
lstrcpy(P, LocaleName);
NewInst = reinterpret_cast<int>(LoadLibraryEx(FileName, 0, LOAD_LIBRARY_AS_DATAFILE));
}
}
}
if (NewInst != 0) {
return SetResourceHInstance(NewInst);
}
return 0;
}
//---------------------------------------------------------------------------
bool __fastcall InternalReloadComponentRes(const String ResName, THandle HInst, TComponent* Instance)
{
//TResourceStream* ResStream = new TResourceStream;
//TAsInheritedReader* AsInheritedReader = new TAsInheritedReader;
if (HInst == 0) {
HInst = reinterpret_cast<THandle>(HInstance);
}
THandle HRsrc = reinterpret_cast<THandle>(FindResource((HMODULE)HInst, (LPCWSTR)ResName.w_str(), (LPCWSTR)RT_RCDATA));
if(HRsrc != 0) {
return false;
}
/* THIS IS THE OFFENDING LINE OF CODE THAT THROWS EXCEPTION
I checked HInst, it is not 0...
ResName = "TControl"
and it throws exception here for some reason
saying resource tcontrol not found
*/
TResourceStream* ResStream = new TResourceStream(HInst, ResName, RT_RCDATA);
try {
TAsInheritedReader* AsInheritedReader = new TAsInheritedReader(ResStream, 4096);
try {
Instance = AsInheritedReader->ReadRootComponent(Instance);
} __finally {
delete AsInheritedReader;
}
}
__finally {
delete ResStream;
}
return true;
}
//---------------------------------------------------------------------------
bool __fastcall InitComponent(TClass ClassType)
{
if ((ClassType->ClassName() == "TComponent") || (ClassType->ClassName() == "RootAncestor")) {
return false;
}
InitComponent(ClassType->ClassParent());
return InternalReloadComponentRes(ClassType->ClassName(), FindResourceHInstance(FindClassHInstance(ClassType)), (TComponent*)&ClassType);
}
//---------------------------------------------------------------------------
bool __fastcall ReloadInheritedComponent(TComponent* Instance)
{
return InitComponent(Instance->ClassType());
}
//---------------------------------------------------------------------------
void __fastcall ReinitializeForms(void)
{
for(int i=0; i<Screen->FormCount-1; i++) {
ReloadInheritedComponent(Screen->Forms[i]);
}
}
#ifndef _reinit_h
#define _reinit_h
#include <windows.h>
extern int __fastcall LoadNewResourceModule(LCID locale);
extern void __fastcall ReinitializeForms(void);
#endif
You don't really need to translate the code at all. You can use Delphi .pas units as-is in C++Builder projects. Simply add the .pas file to your project and compile it, the IDE will generate a .hpp file that you can then #include in your C++ code.
In any case, your translation is not correct in many places.
For instance, the original code wasn't written with Unicode in mind, but you are using Unicode strings in your code. Expressions like sizeof(FileName) and sizeof(LocaleName) are the wrong buffer sizes to pass to the Win32 APIs being used, which can potentially allow buffer overflows. The code was clearly expecting BYTE-sized narrow characters, not WORD-sized wide characters.
It also looks like the original code was not written with 64-bit in mind, either. It is using 32-bit integers in places where 64-bit integers would be needed (for resource handles, etc).
So, the original code needs some updating to support modern systems properly.
But also, your translation of InitComponent() is wrong. It is using strings where the original code is using metaclass references instead, and it is passing the wrong value in the last parameter of InternalReloadComponentRes(), which you have not even declared correctly.
And also, your loop in ReinitializeForms() is skipping the last TForm in the Screen->Forms[] array.
Now, that all being said, try something more like this:
ReInit.h
#ifndef REINIT_H
#define REINIT_H
void __fastcall ReinitializeForms();
NativeUInt __fastcall LoadNewResourceModule(unsigned long Locale);
#endif
ReInit.cpp
#include "ReInit.h"
#include <Windows.hpp>
#include <SysInit.hpp>
#include <SysUtils.hpp>
#include <Classes.hpp>
#include <Forms.hpp>
#include <memory>
class TAsInheritedReader : public TReader
{
public:
void __fastcall ReadPrefix(TFilerFlags &Flags, int &AChildPos) override;
};
void __fastcall TAsInheritedReader::ReadPrefix(TFilerFlags &Flags, int &AChildPos)
{
TReader::ReadPrefix(Flags, AChildPos);
Flags << ffInherited;
}
NativeUInt __fastcall SetResourceHInstance(NativeUInt NewInstance)
{
PLibModule CurModule = LibModuleList;
while (CurModule)
{
if (CurModule->Instance == HInstance)
{
if (CurModule->ResInstance != CurModule->Instance)
::FreeLibrary(reinterpret_cast<HMODULE>(CurModule->ResInstance));
CurModule->ResInstance = NewInstance;
return NewInstance;
}
CurModule = CurModule->Next;
}
return 0;
}
NativeUInt __fastcall LoadNewResourceModule(unsigned long Locale)
{
WCHAR FileName[MAX_PATH+1] = {};
::GetModuleFileNameW(reinterpret_cast<HMODULE>(HInstance), FileName, MAX_PATH+1);
WCHAR LocaleName[5] = {};
::GetLocaleInfoW(Locale, LOCALE_SABBREVLANGNAME, LocaleName, 5);
LPWSTR P = &FileName[lstrlenW(FileName)];
while ((*P != L'.') && (P != FileName)) --P;
HMODULE NewInst = nullptr;
if (P != FileName)
{
++P;
if (LocaleName[0] != L'\0')
{
// Then look for a potential language/country translation
lstrcpyW(P, LocaleName);
NewInst = LoadLibraryEx(FileName, 0, LOAD_LIBRARY_AS_DATAFILE);
if (!NewInst)
{
// Finally look for a language only translation
LocaleName[2] = L'\0';
lstrcpyW(P, LocaleName);
NewInst = LoadLibraryEx(FileName, 0, LOAD_LIBRARY_AS_DATAFILE);
}
}
}
if (NewInst)
return SetResourceHInstance(reinterpret_cast<NativeUInt>(NewInst));
return 0;
}
bool __fastcall InternalReloadComponentRes(const UnicodeString &ResName, NativeUInt HInst, TComponent* &Instance)
{
// avoid possible EResNotFound exception
if (HInst == 0) HInst = HInstance;
HRSRC HRsrc = FindResourceW(reinterpret_cast<HMODULE>(HInst), ResName.c_str(), MAKEINTRESOURCEW(10)/*RT_RCDATA*/);
if (!HRsrc) return false;
auto ResStream = std::make_unique<TResourceStream>(HInst, ResName, MAKEINTRESOURCEW(10)/*RT_RCDATA*/);
auto AsInheritedReader = std::make_unique<TAsInheritedReader>(ResStream.get(), 4096);
Instance = AsInheritedReader->ReadRootComponent(Instance);
return true;
}
bool __fastcall ReloadInheritedComponent(TComponent *Instance, TClass RootAncestor)
{
const auto InitComponent = [&Instance,RootAncestor](TClass ClassType) -> bool
{
auto InitComponent_impl = [&Instance,RootAncestor](TClass ClassType, auto& InitComponent_ref) -> bool
{
if ((ClassType == __classid(TComponent)) || (ClassType == RootAncestor)) return false;
bool Result = InitComponent_ref(ClassType->ClassParent(), InitComponent_ref);
return InternalReloadComponentRes(ClassType->ClassName(), FindResourceHInstance(FindClassHInstance(ClassType)), Instance) || Result;
}
return InitComponent_impl(ClassType, InitComponent_impl);
}
return InitComponent(Instance->ClassType());
}
void __fastcall ReinitializeForms()
{
int Count = Screen->FormCount;
for(int i = 0; i < Count; ++i)
{
ReloadInheritedComponent(Screen->Forms[I], __classid(TForm));
}
}

C++ Builder XE4, 10.2 Tokyo > TStreamWriter > clWhite cannot be copied

My environment:
RadStudio 10.2 Tokyo (and also XE4)
I was implementing a copy property method to copy TShape properties.
Following is what I implemented:
//---------------------------------------------------------------------------
#include <vcl.h>
#pragma hdrstop
#include "Unit1.h"
//---------------------------------------------------------------------------
#pragma package(smart_init)
#pragma resource "*.dfm"
TForm1 *Form1;
//---------------------------------------------------------------------------
__fastcall TForm1::TForm1(TComponent* Owner)
: TForm(Owner)
{
// set Shape1 color to [clWhite]
Shape1->Brush->Color = clRed; // clWhite
Shape2->Brush->Color = clAqua;
}
//---------------------------------------------------------------------------
void __fastcall TForm1::copyProperties(TControl *srcCtrl, TControl *dstCtrl)
{
// to Keep original names
String orgName_src = srcCtrl->Name;
String orgName_dst = dstCtrl->Name;
// copy properties
TMemoryStream *strm = new TMemoryStream;
Shape1->Name = L""; // to avoid source collision
try {
strm->WriteComponent(srcCtrl);
strm->Position = 0;
strm->ReadComponent(dstCtrl);
}
__finally
{
delete strm;
}
srcCtrl->Name = orgName_src;
dstCtrl->Name = orgName_dst;
}
void __fastcall TForm1::Button1Click(TObject *Sender)
{
copyProperties((TControl *)Shape1, (TControl *)Shape2);
// shift to avoid position-overlapping
Shape2->Left = Shape1->Left + 150;
}
//---------------------------------------------------------------------------
The code seems work fine.
But there is a single case, in which the code does not work.
i.e. when the Brush->Color = clWhite for Shape1.
This bug? can be reproduced also for XE4.
I wonder why only the clWhite has this kind of bug? Other colors does not have this kind of bug.
There is no bug in the streaming. It is operating as designed. You are simply using it in a way that it is not intended for.
clWhite is the declared default value of the TBrush.Color property. The DFM streaming system does not stream properties that are currently set to their default values, unless those properties are declared as nodefault or stored=true. TBrush.Color is neither. So the current Brush.Color value will not be streamed when it is set to clWhite.
Consider using the RTTI system directly instead of using the DFM system to copy properties from one object to another. Then you can copy property values regardless of defaults, if you choose to do so. And you can opt to ignore the Name property without having to (re)store it each time.
For example:
#include <System.TypInfo.hpp>
void __fastcall TForm1::copyProperties(TControl *srcCtrl, TControl *dstCtrl)
{
PTypeInfo pDstTypeInfo = static_cast<PTypeInfo>(dstCtrl->ClassInfo());
PPropList srcPropList;
int srcPropCount = GetPropList(srcCtrl, srcPropList);
try
{
for (int i = 0; i < srcPropCount; ++i)
{
PPropInfo pSrcPropInfo = (*srcPropList)[i];
if (pSrcPropInfo->Name == "Name") continue;
PTypeInfo pSrcPropTypeInfo = *(pSrcPropInfo->PropType);
if (pSrcPropTypeInfo->Kind == tkClass)
{
PPropInfo pDstPropInfo = GetPropInfo(pDstTypeInfo, pSrcPropInfo->Name, TTypeKinds() << tkClass);
if (pDstPropInfo)
{
TPersistent *pDstObj = static_cast<TPersistent*>(GetObjectProp(dstCtrl, pDstPropInfo, __classid(TPersistent)));
if (pDstObj)
{
TPersistent *pSrcObj = static_cast<TPersistent*>(GetObjectProp(srcCtrl, pSrcPropInfo, __classid(TPersistent)));
pDstObj->Assign(pSrcObj);
}
}
}
else
{
PPropInfo pDstPropInfo = GetPropInfo(pDstTypeInfo, pSrcPropInfo->Name);
if (pDstPropInfo)
{
Variant value = GetPropValue(srcCtrl, pSrcPropInfo);
SetPropValue(dstCtrl, pDstPropInfo, value);
}
}
}
}
__finally
{
FreeMem(srcPropList);
}
}
Alternatively:
#include <System.Rtti.hpp>
void __fastcall TForm1::copyProperties(TControl *srcCtrl, TControl *dstCtrl)
{
TRttiContext ctx;
TRttiType *pSrcType = ctx.GetType(srcCtrl->ClassInfo());
TRttiType *pDstType = ctx.GetType(dstCtrl->ClassInfo());
DynamicArray<TRttiProperty*> srcProps = pSrcType->GetProperties();
for (int i = 0; i < srcProps.Length; ++i)
{
TRttiProperty *pSrcProp = srcProps[i];
if (pSrcProp->Name == L"Name") continue;
if (pSrcProp->PropertyType->TypeKind == tkClass)
{
TRttiProperty *pDstProp = pDstType->GetProperty(pSrcPropInfo->Name);
if ((pDstProp) && (pDstProp->PropertyType->TypeKind == tkClass))
{
TPersistent *pDstObj = dynamic_cast<TPersistent*>(pDstProp->GetValue(dstCtrl).AsObject());
if (pDstObj)
{
TPersistent *pSrcObj = dynamic_cast<TPersistent*>(pSrcProp->GetValue(srcCtrl).AsObject());
pDstObj->Assign(pSrcObj);
}
}
}
else
{
TRttiProperty *pDstProp = pDstType->GetProperty(pSrcPropInfo->Name);
if (pDstProp)
{
TValue value = pSrcProp->GetValue(srcCtrl);
pDstProp->SetValue(dstCtrl, value);
}
}
}
}

C++ Builder ActiveX get property method overflow

In C++ Builder XE7, I created a simple COM automation object:
File > New > ActiveX > ActiveX Library
File > New > ActiveX > Automation Object
Add new property MyProperty
Push 'Refresh implementation'
So, the wizard created declarations/implementations for get/set methods:
interface IMyObject: IDispatch
{
[propget, id(0x000000CA)]
HRESULT _stdcall MyProperty([out, retval] long* Value);
[propput, id(0x000000CA)]
HRESULT _stdcall MyProperty([in] long Value);
};
STDMETHODIMP TMyObjectImpl::get_MyProperty(long* Value)
{
try
{
}
catch(Exception &e)
{
return Error(e.Message.c_str(), IID_IMyObject);
}
return S_OK;
}
// ---------------------------------------------------------------------------
...
In order to get the property value for automation clients, I inserted the code to assign the Property value to the Value referenced by the parameter:
STDMETHODIMP TMyObjectImpl::get_MyProperty(long* Value)
{
try
{
*Value = MyProperty;
}
catch(Exception &e)
{
return Error(e.Message.c_str(), IID_IMyObject);
}
return S_OK;
}
Getting the property value in the client application, the server function TMyObjectImpl::get_MyProperty(long* Value) seems to run recursively until gets stack overflow.
Here is a simple client code:
Variant Object;
double N;
V = Variant::CreateObject("MyProject.MyObject");
N = V.OlePropertyGet("MyProperty");
What I am doing wrong in this assignment?
*Value = MyProperty;
STDMETHODIMP TMyObjectImpl::get_MyProperty(long* Value)
{
try
{
*Value = MyProperty;
}
catch(Exception &e)
{
return Error(e.Message.c_str(), IID_IMyObject);
}
return S_OK;
}
Reading MyProperty is implemented by a call to get_MyProperty. Hence the unterminated recursion.
You need to implement get_MyProperty by returning a value obtained by some other means. For instance, you might return a constant value:
*Value = 42;
Or you might return a value stored in a member field:
*Value = myPropertyValue;
where myPropertyValue is a member field of your class.

Code equivalent of out or reference parameters in Dart

In Dart, how would I best code the equivalent of an (immutable/value/non-object) out or reference parameter?
For example in C#-ish I might code:
function void example()
{
int result = 0;
if (tryFindResult(anObject, ref result))
processResult(result);
else
processForNoResult();
}
function bool tryFindResult(Object obj, ref int result)
{
if (obj.Contains("what I'm looking for"))
{
result = aValue;
return true;
}
return false;
}
This is not possible in Dart. Support for struct value types, ref or val keywords were discussed on the Dart mailing list just like week. Here is a link to the discussion where you should let your desire be known:
https://groups.google.com/a/dartlang.org/d/topic/misc/iP5TiJMW1F8/discussion
The Dart-way would be:
void example() {
List result = tryFindResult(anObject);
if (result[0]) {
processResult(result[1]);
} else {
processForNoResult();
}
}
List tryFindResult(Object obj) {
if (obj.contains("What I'm looking for")) {
return [true, aValue];
}
return [false, null];
}
you can also use a tuple package like tuple-2.0.0
add tuple: ^2.0.0
to your pubspec.yaml
then any function can return many typed objects like this:
import 'package:tuple/tuple.dart';
Tuple3<int, String, bool?>? returnMany() {
return ok ? Tuple3(5, "OK", null) : null;
}
var str = returnMany().item2;
In your case:
void example() {
var result = tryFindResult(anObject);
if (result.item1) {
processResult(result.item2!);
} else {
processForNoResult();
}
}
Tuple2<bool, int?> tryFindResult(Object obj) {
if (obj.contains("What I'm looking for")) {
return Tuple2(true, aValue);
}
return Tuple2(false, null);
}
you can throw an exception too when no result.
void example() {
var result = tryFindResult(anObject);
try {
processResult(result);
} on NullException catch(e){
processForNoResult();
}
}
int tryFindResult(Object obj) { // throws NullException
if (obj.contains("What I'm looking for")) {
return aValue;
}
throw NullException();
}

Resources