Inserting ole object to TRxRichEdit - delphi

I'm using TRxRichEdit in my program. How can I insert ole object to RxRichEdit at run time.

If you call "InsertObjectDialog" method of the RxRichEdit, the control executes the Insert Object dialog where the user can choose the type of the object to create anew or from an existing file.
I don't think it would be possible to insert an object without using the dialog, because the IRichEditOle interface (FRichEditOle) is private to the class.
edit:
Regardless the interface being private or not to the class, apparently, one can request the IRichEditOle interface directly from the RichEdit control itself by using EM_GETOLEINTERFACE. Below is D3 sample code (the last version I used RX controls with), but it would also probably suit the 'TJvRichEdit' of JVCL, which is originally the same control. The code inserts an Ole object from a file name at run-time:
uses
activex, richedit, comobj;
type
_ReObject = record
cbStruct: DWORD;
cp: ULONG;
clsid: TCLSID;
poleobj: IOleObject;
pstg: IStorage;
polesite: IOleClientSite;
sizel: TSize;
dvAspect: Longint;
dwFlags: DWORD;
dwUser: DWORD;
end;
TReObject = _ReObject;
IRichEditOle = interface(IUnknown)
['{00020d00-0000-0000-c000-000000000046}']
function GetClientSite(out clientSite: IOleClientSite): HResult; stdcall;
function GetObjectCount: HResult; stdcall;
function GetLinkCount: HResult; stdcall;
function GetObject(iob: Longint; out reobject: TReObject;
dwFlags: DWORD): HResult; stdcall;
function InsertObject(var reobject: TReObject): HResult; stdcall;
function ConvertObject(iob: Longint; rclsidNew: TIID;
lpstrUserTypeNew: LPCSTR): HResult; stdcall;
function ActivateAs(rclsid: TIID; rclsidAs: TIID): HResult; stdcall;
function SetHostNames(lpstrContainerApp: LPCSTR;
lpstrContainerObj: LPCSTR): HResult; stdcall;
function SetLinkAvailable(iob: Longint; fAvailable: BOOL): HResult; stdcall;
function SetDvaspect(iob: Longint; dvaspect: DWORD): HResult; stdcall;
function HandsOffStorage(iob: Longint): HResult; stdcall;
function SaveCompleted(iob: Longint; const stg: IStorage): HResult; stdcall;
function InPlaceDeactivate: HResult; stdcall;
function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
function GetClipboardData(var chrg: TCharRange; reco: DWORD;
out dataobj: IDataObject): HResult; stdcall;
function ImportDataObject(dataobj: IDataObject; cf: TClipFormat;
hMetaPict: HGLOBAL): HResult; stdcall;
end;
const
REO_CP_SELECTION = ULONG(-1);
REO_RESIZABLE = $00000001;
IID_IOleObject: TGUID = (
D1:$00000112;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
procedure InsertOleObjectFromFile(RichEdit: TRxRichEdit; FileName: string);
var
RichEditOle: IRichEditOle;
LockBytes: ILockBytes;
Storage: IStorage;
FormatEtc: TFormatEtc;
ClientSite: IOleClientSite;
OleObject: IOleObject;
ClassID: TCLSID;
ReObject: TReObject;
begin
SendMessage(RichEdit.Handle, EM_GETOLEINTERFACE, 0, Longint(#RichEditOle));
if not Assigned(RichEditOle) then
raise EOleError.Create('Failed to retrieve IRichEditOle');
OleCheck(CreateILockBytesOnHGlobal(0, True, LockBytes));
OleCheck(StgCreateDocfileOnILockBytes(LockBytes,
STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, 0, Storage));
LockBytes := nil;
OleCheck(RichEditOle.GetClientSite(ClientSite));
FillChar(FormatEtc, SizeOf(FormatEtc), 0);
FormatEtc.dwAspect := DVASPECT_CONTENT;
FormatEtc.lIndex := -1;
OleCheck(OleCreateFromFile(GUID_NULL, PWideChar(WideString(FileName)),
IID_IOleObject, OLERENDER_DRAW, #FormatEtc, ClientSite, Storage,
OleObject));
OleCheck(OleSetContainedObject(OleObject, True));
OleCheck(OleObject.GetUserClassID(ClassID));
FillChar(ReObject, SizeOf(TReObject), 0);
ReObject.cbStruct := SizeOf(TReObject);
ReObject.cp := REO_CP_SELECTION;
ReObject.clsid := ClassID;
ReObject.poleobj := OleObject;
ReObject.pstg := Storage;
ReObject.polesite := ClientSite;
ReObject.dvAspect := DVASPECT_CONTENT;
ReObject.dwFlags := REO_RESIZABLE;
OleCheck(RichEditOle.InsertObject(ReObject));
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
InsertOleObjectFromFile(RxRichEdit1,
ExtractFilePath(Application.ExeName) + 'xltest.xls');
end;

Related

Delphi Components and Screen Readers

I use Delphi and C++Builder and have some accessibility questions in regards to screen readers.
I have a button on a form which descends from TWinControl. If I put a caption on the button the screen reader will read it to me when the button is in focus. However, there are cases where I use buttons with an image and no caption. The screen reader doesn’t say anything if there is no caption. What can I do to have the screen reader say what this button is?
Similarly for an image on a form which descends from TGraphicControl. How can I tell the screen reader what to say when the object is moused over?
I’ve looked into the IAccessible wrapper, but I would prefer not to extend every control we use if at all possible.
However, there are cases where I use buttons with an image and no caption. The screen reader doesn’t say anything if there is no caption. What can I do to have the screen reader say what this button is?
An IAccessible implementation for the button must provide the desired text to screen readers. By default, the OS provides a default IAccessible implementation for many UI controls, including buttons.
So, one simple trick you could do would be to owner-draw the button manually, then you can set its standard Caption for the default IAccessible implementation to use normally, and then you could simply do not include the Caption when you draw the button.
Otherwise, you can handle the WM_GETOBJECT message directly to retrieve the button's default IAccessible implementation and then wrap it so you can return your desired text and delegate everything else to the default implementation. For example:
type
TMyAccessibleText = class(TInterfacedObject, IAccessible)
private
fAcc: IAccessible;
fAccessibleText: string;
public:
constructor Create(Acc: IAccessible; AccessibleText: string);
function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
function Get_accParent(out ppdispParent: IDispatch): HResult; stdcall;
function Get_accChildCount(out pcountChildren: Integer): HResult; stdcall;
function Get_accChild(varChild: OleVariant; out ppdispChild: IDispatch): HResult; stdcall;
function Get_accName(varChild: OleVariant; out pszName: WideString): HResult; stdcall;
function Get_accValue(varChild: OleVariant; out pszValue: WideString): HResult; stdcall;
function Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult; stdcall;
function Get_accRole(varChild: OleVariant; out pvarRole: OleVariant): HResult; stdcall;
function Get_accState(varChild: OleVariant; out pvarState: OleVariant): HResult; stdcall;
function Get_accHelp(varChild: OleVariant; out pszHelp: WideString): HResult; stdcall;
function Get_accHelpTopic(out pszHelpFile: WideString; varChild: OleVariant; out pidTopic: Integer): HResult; stdcall;
function Get_accKeyboardShortcut(varChild: OleVariant; out pszKeyboardShortcut: WideString): HResult; stdcall;
function Get_accFocus(out pvarChild: OleVariant): HResult; stdcall;
function Get_accSelection(out pvarChildren: OleVariant): HResult; stdcall;
function Get_accDefaultAction(varChild: OleVariant; out pszDefaultAction: WideString): HResult; stdcall;
function accSelect(flagsSelect: Integer; varChild: OleVariant): HResult; stdcall;
function accLocation(out pxLeft: Integer; out pyTop: Integer; out pcxWidth: Integer; out pcyHeight: Integer; varChild: OleVariant): HResult; stdcall;
function accNavigate(navDir: Integer; varStart: OleVariant; out pvarEndUpAt: OleVariant): HResult; stdcall;
function accHitTest(xLeft: Integer; yTop: Integer; out pvarChild: OleVariant): HResult; stdcall;
function accDoDefaultAction(varChild: OleVariant): HResult; stdcall;
function Set_accName(varChild: OleVariant; const pszName: WideString): HResult; stdcall;
function Set_accValue(varChild: OleVariant; const pszValue: WideString): HResult; stdcall;
end;
constructor TMyAccessibleText.Create(Acc: IAccessible; AccessibleText: string);
begin
inherited Create;
fAcc := Acc;
fAccessibleText := AccessibleText;
end;
function TMyAccessibleText.QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
begin
if IID = IID_IAccessible then
Result := inherited QueryInterface(IID, Obj)
else
Result := fAcc.QueryInterface(IID, Obj);
end;
function TMyAccessibleText.GetTypeInfoCount(out Count: Integer): HResult; stdcall;
begin
Result := fAcc.GetTypeInfoCount(Count);
end;
function TMyAccessibleText.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
begin
Result := fAcc.GetTypeInfo(Index, LocaleID, TypeInfo);
end;
function TMyAccessibleText.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
begin
Result := fAcc.GetIDsOfNames(IID, Names, NameCount, LocaleID, DispIDs);
end;
function TMyAccessibleText.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
begin
Result := fAcc.Invoke(DispID, IID, LocaleID, Flags, Params, VarResult, ExcepInfo, ArgErr);
end;
function TMyAccessibleText.Get_accParent(out ppdispParent: IDispatch): HResult; stdcall;
begin
Result := fAcc.Get_accParent(ppdispParent);
end;
function TMyAccessibleText.Get_accChildCount(out pcountChildren: Integer): HResult; stdcall;
begin
Result := fAcc.Get_accChildCount(pcountChildren);
end;
function TMyAccessibleText.Get_accChild(varChild: OleVariant; out ppdispChild: IDispatch): HResult; stdcall;
begin
Result := fAcc.Get_accChild(varChild, ppdispChild);
end;
function TMyAccessibleText.Get_accName(varChild: OleVariant; out pszName: WideString): HResult; stdcall;
begin
Result := fAcc.Get_accName(varChild, pszName);
end;
function TMyAccessibleText.Get_accValue(varChild: OleVariant; out pszValue: WideString): HResult; stdcall;
begin
if varChild = CHILDID_SELF then
begin
pszValue := fAccessibleText;
Result := S_OK;
end else
Result := fAcc.Get_accValue(varChild, pszValue);
end;
function TMyAccessibleText.Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult; stdcall;
begin
Result := fAcc.Get_accDescription(varChild, pszDescription);
end;
function TMyAccessibleText.Get_accRole(varChild: OleVariant; out pvarRole: OleVariant): HResult; stdcall;
begin
Result := fAcc.Get_accRole(varChild, pvarRole);
end;
function TMyAccessibleText.Get_accState(varChild: OleVariant; out pvarState: OleVariant): HResult; stdcall;
begin
Result := fAcc.Get_accState(varChild, pvarState);
end;
function TMyAccessibleText.Get_accHelp(varChild: OleVariant; out pszHelp: WideString): HResult; stdcall;
begin
Result := fAcc.Get_accHelp(varChild, pszHelp);
end;
function TMyAccessibleText.Get_accHelpTopic(out pszHelpFile: WideString; varChild: OleVariant; out pidTopic: Integer): HResult; stdcall;
begin
Result := fAcc.Get_accHelpTopic(pszHelpFile, varChild, pidTopic);
end;
function TMyAccessibleText.Get_accKeyboardShortcut(varChild: OleVariant; out pszKeyboardShortcut: WideString): HResult; stdcall;
begin
Result := fAcc.Get_accKeyboardShortcut(varChild, pszKeyboardShortcut);
end;
function TMyAccessibleText.Get_accFocus(out pvarChild: OleVariant): HResult; stdcall;
begin
Result := fAcc.Get_accFocus(pvarChild);
end;
function TMyAccessibleText.Get_accSelection(out pvarChildren: OleVariant): HResult; stdcall;
begin
Result := fAcc.Get_accSelection(pvarChildren);
end;
function TMyAccessibleText.Get_accDefaultAction(varChild: OleVariant; out pszDefaultAction: WideString): HResult; stdcall;
begin
Result := fAcc.Get_accDefaultAction(varChild, pszDefaultAction);
end;
function TMyAccessibleText.accSelect(flagsSelect: Integer; varChild: OleVariant): HResult; stdcall;
begin
Result := fAcc.accSelect(flagsSelect, varChild);
end;
function TMyAccessibleText.accLocation(out pxLeft: Integer; out pyTop: Integer; out pcxWidth: Integer; out pcyHeight: Integer; varChild: OleVariant): HResult; stdcall;
begin
Result := fAcc.accLocation(pxLeft, pyTop, pcxWidth, pcyHeight, varChild);
end;
function TMyAccessibleText.accNavigate(navDir: Integer; varStart: OleVariant; out pvarEndUpAt: OleVariant): HResult; stdcall;
begin
Result := fAcc.accNavigate(navDir, varStart, pvarEndUpAt);
end;
function TMyAccessibleText.accHitTest(xLeft: Integer; yTop: Integer; out pvarChild: OleVariant): HResult; stdcall;
begin
Result := fAcc.accHitTest(xLeft, yTop, pvarChild);
end;
function TMyAccessibleText.accDoDefaultAction(varChild: OleVariant): HResult; stdcall;
begin
Result := fAcc.accDoDefaultAction(varChild);
end;
function TMyAccessibleText.Set_accName(varChild: OleVariant; const pszName: WideString): HResult; stdcall;
begin
Result := fAcc.Set_accName(varChild, pszName);
end;
function TMyAccessibleText.Set_accValue(varChild: OleVariant; const pszValue: WideString): HResult; stdcall;
begin
if varChild = CHILDID_SELF then
begin
fAccessibleText := pszValue;
Result := S_OK;
end else
Result := fAcc.Set_accValue(varChild, pszValue);
end;
type
TBitBtn = class(Vcl.Buttons.TBitBtn)
private
procedure WMGetObject(var Message: TMessage): message WM_GETOBJECT;
public
MyAccessibleText: string;
end;
TMyForm = class(TForm)
Button1: TBitBtn;
...
procedure FormCreate(Sender: TObject);
...
end;
procedure TMyForm.FormCreate(Sender: TObject);
begin
Button1.MyAccessibleText := 'There is an image here';
end;
procedure TBitBtn.WMGetObject(var Message: TMessage);
var
Acc: IAccessible;
begin
inherited;
if (Message.LParam = OBJID_CLIENT) and (Message.Result > 0) and (Caption = '') and (MyAccessibleText <> '') then
begin
if ObjectFromLresult(Message.Result, IAccessible, Message.WParam, Acc) = S_OK then
begin
Acc := TMyAccessibleText.Create(Acc, MyAccessibleText) as IAccessible;
Message.Result := LresultFromObject(IAccessible, Message.WParam, Acc);
end;
end;
end;
Similarly for an image on a form which descends from TGraphic. How can I tell the screen reader what to say when the object gets focus?
First off, TGraphic is not a component class. It is a wrapper for image data used by TPicture, which itself is a helper used by TImage, for instance. I assume you mean TGraphicControl instead (which TImage derives from).
A TGraphicControl-based component is not directly accessible to screen readers by default, as it has no window of its own, and as such it is not even known to the OS itself.
If you want a screen reader to interact with a graphical control, you must provide a full implementation of IAccessible from the Parent component (which does have a window) and have it expose additional Accessibility information about its graphical children.
I’ve looked into the IAccessible wrapper, but I would prefer not to extend every control we use if at all possible.
Sorry, but you will have to (unless you can find a 3rd party implementation that does what you need). The VCL simply does not implement any IAccessible functionality, so you have to implement it manually in your own code if you need to customize it beyond what the OS provides for you.

Controlling the master speaker volume in Windows 7

I have a written a very simple application that I use to play my music collection with in Delphi 2007 that runs on Windows 7. I shell out to the Windows Media Player to avoid the Delphi Media Player component which refuses to play some tracks that I throw at it. I would now like to control the volume of the speaker from the application.
At this point I say 'speaker volume' rather than 'WMP volume' because I imagine controlling the volume of the WMP is more difficult than controlling the overall speaker/master volume for all applications.
I'm sure this was very simple in the past but OS get more complex and all the code snippets that I have found and tried don't work for the master/core volume that controls the speakers.
Is it possible to control this master volume from a Delphi 2007 running on Windows 7?
If it is, then a couple of functions like GetVolume and SetVolume I could use to do what is such a basic task would be very much appreciated.
I have looked at similar questions asked in the past and I am not hopeful.
Bruce.
Under Windows 7 you must use the Core Audio SDK to control the Windows audio. from here you can try the IAudioEndpointVolume::SetMasterVolumeLevelScalar or the IAudioEndpointVolume::SetMasterVolumeLevel method.
Try this code which uses the SetMasterVolumeLevelScalar method.
{$APPTYPE CONSOLE}
uses
SysUtils,
Windows,
ActiveX,
ComObj;
const
CLASS_IMMDeviceEnumerator : TGUID = '{BCDE0395-E52F-467C-8E3D-C4579291692E}';
IID_IMMDeviceEnumerator : TGUID = '{A95664D2-9614-4F35-A746-DE8DB63617E6}';
IID_IAudioEndpointVolume : TGUID = '{5CDF2C82-841E-4546-9722-0CF74078229A}';
type
IAudioEndpointVolumeCallback = interface(IUnknown)
['{657804FA-D6AD-4496-8A60-352752AF4F89}']
end;
IAudioEndpointVolume = interface(IUnknown)
['{5CDF2C82-841E-4546-9722-0CF74078229A}']
function RegisterControlChangeNotify(AudioEndPtVol: IAudioEndpointVolumeCallback): HRESULT; stdcall;
function UnregisterControlChangeNotify(AudioEndPtVol: IAudioEndpointVolumeCallback): HRESULT; stdcall;
function GetChannelCount(out PInteger): HRESULT; stdcall;
function SetMasterVolumeLevel(fLevelDB: single; pguidEventContext: PGUID): HRESULT; stdcall;
function SetMasterVolumeLevelScalar(fLevelDB: single; pguidEventContext: PGUID): HRESULT; stdcall;
function GetMasterVolumeLevel(out fLevelDB: single): HRESULT; stdcall;
function GetMasterVolumeLevelScaler(out fLevelDB: single): HRESULT; stdcall;
function SetChannelVolumeLevel(nChannel: Integer; fLevelDB: double; pguidEventContext: PGUID): HRESULT; stdcall;
function SetChannelVolumeLevelScalar(nChannel: Integer; fLevelDB: double; pguidEventContext: PGUID): HRESULT; stdcall;
function GetChannelVolumeLevel(nChannel: Integer; out fLevelDB: double): HRESULT; stdcall;
function GetChannelVolumeLevelScalar(nChannel: Integer; out fLevel: double): HRESULT; stdcall;
function SetMute(bMute: Boolean; pguidEventContext: PGUID): HRESULT; stdcall;
function GetMute(out bMute: Boolean): HRESULT; stdcall;
function GetVolumeStepInfo(pnStep: Integer; out pnStepCount: Integer): HRESULT; stdcall;
function VolumeStepUp(pguidEventContext: PGUID): HRESULT; stdcall;
function VolumeStepDown(pguidEventContext: PGUID): HRESULT; stdcall;
function QueryHardwareSupport(out pdwHardwareSupportMask): HRESULT; stdcall;
function GetVolumeRange(out pflVolumeMindB: double; out pflVolumeMaxdB: double; out pflVolumeIncrementdB: double): HRESULT; stdcall;
end;
IAudioMeterInformation = interface(IUnknown)
['{C02216F6-8C67-4B5B-9D00-D008E73E0064}']
end;
IPropertyStore = interface(IUnknown)
end;
IMMDevice = interface(IUnknown)
['{D666063F-1587-4E43-81F1-B948E807363F}']
function Activate(const refId: TGUID; dwClsCtx: DWORD; pActivationParams: PInteger; out pEndpointVolume: IAudioEndpointVolume): HRESULT; stdCall;
function OpenPropertyStore(stgmAccess: DWORD; out ppProperties: IPropertyStore): HRESULT; stdcall;
function GetId(out ppstrId: PLPWSTR): HRESULT; stdcall;
function GetState(out State: Integer): HRESULT; stdcall;
end;
IMMDeviceCollection = interface(IUnknown)
['{0BD7A1BE-7A1A-44DB-8397-CC5392387B5E}']
end;
IMMNotificationClient = interface(IUnknown)
['{7991EEC9-7E89-4D85-8390-6C703CEC60C0}']
end;
IMMDeviceEnumerator = interface(IUnknown)
['{A95664D2-9614-4F35-A746-DE8DB63617E6}']
function EnumAudioEndpoints(dataFlow: TOleEnum; deviceState: SYSUINT; DevCollection: IMMDeviceCollection): HRESULT; stdcall;
function GetDefaultAudioEndpoint(EDF: SYSUINT; ER: SYSUINT; out Dev :IMMDevice ): HRESULT; stdcall;
function GetDevice(pwstrId: pointer; out Dev: IMMDevice): HRESULT; stdcall;
function RegisterEndpointNotificationCallback(pClient: IMMNotificationClient): HRESULT; stdcall;
end;
procedure SetMasterVolume(fLevelDB: single);
var
pEndpointVolume: IAudioEndpointVolume;
LDeviceEnumerator: IMMDeviceEnumerator;
Dev: IMMDevice;
begin
if not Succeeded(CoCreateInstance(CLASS_IMMDeviceEnumerator, nil, CLSCTX_INPROC_SERVER, IID_IMMDeviceEnumerator, LDeviceEnumerator)) then
RaiseLastOSError;
if not Succeeded(LDeviceEnumerator.GetDefaultAudioEndpoint($00000000, $00000000, Dev)) then
RaiseLastOSError;
if not Succeeded( Dev.Activate(IID_IAudioEndpointVolume, CLSCTX_INPROC_SERVER, nil, pEndpointVolume)) then
RaiseLastOSError;
if not Succeeded(pEndpointVolume.SetMasterVolumeLevelScalar(fLevelDB, nil)) then
RaiseLastOSError;
end;
begin
try
CoInitialize(nil);
try
SetMasterVolume(1.0); //set the volume to the max
Sleep(2000);
SetMasterVolume(0.5); //set the volume to the 50 %
Sleep(2000);
SetMasterVolume(0.1); //set the volume to the 10 %
Sleep(2000);
finally
CoUninitialize;
end;
except
on E:Exception do
Writeln(E.Classname, ':', E.Message);
end;
Writeln('Press Enter to exit');
Readln;
end.

How to check if the system master volume is mute or unmute?

I'm using this code to mute/unmute system master volume:
const
APPCOMMAND_VOLUME_MUTE = $80000;
WM_APPCOMMAND = $319;
procedure TForm1.Button1Click(Sender: TObject);
begin
// toggle mute/unmute
SendMessageW(Handle, WM_APPCOMMAND, Handle, APPCOMMAND_VOLUME_MUTE);
end;
(Got the code from https://stackoverflow.com/a/154128/1140885)
It works fine on XP (Didn't test it on Win7 yet).
I need a method to check (get) what is the current "mute" state? Is it mute or not.
Any ideas?
Update: For XP I ended up using the code from here: How to get the master volume in windows xp? (Thanks to #Sertac Akyuz)
I had to change only a single line:
mxlc.dwControlType := MIXERCONTROL_CONTROLTYPE_VOLUME;
to:
mxlc.dwControlType := MIXERCONTROL_CONTROLTYPE_MUTE;
return value is either 0 (not mute) or 1 (mute).
Starting with Windows Vista you must use the Core Audio SDK to control the Windows audio. To check if the master volume is muted you must use the IAudioEndpointVolume.GetMute method.
Try this sample code
{$APPTYPE CONSOLE}
uses
SysUtils,
Windows,
ActiveX,
ComObj;
const
CLASS_IMMDeviceEnumerator : TGUID = '{BCDE0395-E52F-467C-8E3D-C4579291692E}';
IID_IMMDeviceEnumerator : TGUID = '{A95664D2-9614-4F35-A746-DE8DB63617E6}';
IID_IAudioEndpointVolume : TGUID = '{5CDF2C82-841E-4546-9722-0CF74078229A}';
type
IAudioEndpointVolumeCallback = interface(IUnknown)
['{657804FA-D6AD-4496-8A60-352752AF4F89}']
end;
IAudioEndpointVolume = interface(IUnknown)
['{5CDF2C82-841E-4546-9722-0CF74078229A}']
function RegisterControlChangeNotify(AudioEndPtVol: IAudioEndpointVolumeCallback): HRESULT; stdcall;
function UnregisterControlChangeNotify(AudioEndPtVol: IAudioEndpointVolumeCallback): HRESULT; stdcall;
function GetChannelCount(out PInteger): HRESULT; stdcall;
function SetMasterVolumeLevel(fLevelDB: single; pguidEventContext: PGUID): HRESULT; stdcall;
function SetMasterVolumeLevelScalar(fLevelDB: single; pguidEventContext: PGUID): HRESULT; stdcall;
function GetMasterVolumeLevel(out fLevelDB: single): HRESULT; stdcall;
function GetMasterVolumeLevelScaler(out fLevelDB: single): HRESULT; stdcall;
function SetChannelVolumeLevel(nChannel: Integer; fLevelDB: double; pguidEventContext: PGUID): HRESULT; stdcall;
function SetChannelVolumeLevelScalar(nChannel: Integer; fLevelDB: double; pguidEventContext: PGUID): HRESULT; stdcall;
function GetChannelVolumeLevel(nChannel: Integer; out fLevelDB: double): HRESULT; stdcall;
function GetChannelVolumeLevelScalar(nChannel: Integer; out fLevel: double): HRESULT; stdcall;
function SetMute(bMute: Boolean; pguidEventContext: PGUID): HRESULT; stdcall;
function GetMute(out bMute: Boolean): HRESULT; stdcall;
function GetVolumeStepInfo(pnStep: Integer; out pnStepCount: Integer): HRESULT; stdcall;
function VolumeStepUp(pguidEventContext: PGUID): HRESULT; stdcall;
function VolumeStepDown(pguidEventContext: PGUID): HRESULT; stdcall;
function QueryHardwareSupport(out pdwHardwareSupportMask): HRESULT; stdcall;
function GetVolumeRange(out pflVolumeMindB: double; out pflVolumeMaxdB: double; out pflVolumeIncrementdB: double): HRESULT; stdcall;
end;
IAudioMeterInformation = interface(IUnknown)
['{C02216F6-8C67-4B5B-9D00-D008E73E0064}']
end;
IPropertyStore = interface(IUnknown)
end;
IMMDevice = interface(IUnknown)
['{D666063F-1587-4E43-81F1-B948E807363F}']
function Activate(const refId: TGUID; dwClsCtx: DWORD; pActivationParams: PInteger; out pEndpointVolume: IAudioEndpointVolume): HRESULT; stdCall;
function OpenPropertyStore(stgmAccess: DWORD; out ppProperties: IPropertyStore): HRESULT; stdcall;
function GetId(out ppstrId: PLPWSTR): HRESULT; stdcall;
function GetState(out State: Integer): HRESULT; stdcall;
end;
IMMDeviceCollection = interface(IUnknown)
['{0BD7A1BE-7A1A-44DB-8397-CC5392387B5E}']
end;
IMMNotificationClient = interface(IUnknown)
['{7991EEC9-7E89-4D85-8390-6C703CEC60C0}']
end;
IMMDeviceEnumerator = interface(IUnknown)
['{A95664D2-9614-4F35-A746-DE8DB63617E6}']
function EnumAudioEndpoints(dataFlow: TOleEnum; deviceState: SYSUINT; DevCollection: IMMDeviceCollection): HRESULT; stdcall;
function GetDefaultAudioEndpoint(EDF: SYSUINT; ER: SYSUINT; out Dev :IMMDevice ): HRESULT; stdcall;
function GetDevice(pwstrId: pointer; out Dev: IMMDevice): HRESULT; stdcall;
function RegisterEndpointNotificationCallback(pClient: IMMNotificationClient): HRESULT; stdcall;
end;
function IsMasterVolumeMute : Boolean;
var
pEndpointVolume: IAudioEndpointVolume;
LDeviceEnumerator: IMMDeviceEnumerator;
Dev: IMMDevice;
bMute: Boolean;
begin
if not Succeeded(CoCreateInstance(CLASS_IMMDeviceEnumerator, nil, CLSCTX_INPROC_SERVER, IID_IMMDeviceEnumerator, LDeviceEnumerator)) then
RaiseLastOSError;
if not Succeeded(LDeviceEnumerator.GetDefaultAudioEndpoint($00000000, $00000000, Dev)) then
RaiseLastOSError;
if not Succeeded( Dev.Activate(IID_IAudioEndpointVolume, CLSCTX_INPROC_SERVER, nil, pEndpointVolume)) then
RaiseLastOSError;
if not Succeeded(pEndpointVolume.GetMute(bMute)) then
RaiseLastOSError
else
Result:=bMute;
end;
begin
try
CoInitialize(nil);
try
Writeln(Format('Master Volume is Mute ? : %s',[BoolToStr(IsMasterVolumeMute, True)]));
finally
CoUninitialize;
end;
except
on E:Exception do
Writeln(E.Classname, ':', E.Message);
end;
Writeln('Press Enter to exit');
Readln;
end.
Use this snipped, I've tested it and works for me.
This will check and set master volume.
(Copied from http://www.swissdelphicenter.ch/torry/showcode.php?id=1630)
I hope this helps:
uses
MMSystem;
function GetMasterMute(
Mixer: hMixerObj;
var Control: TMixerControl): MMResult;
// Returns True on success
var
Line: TMixerLine;
Controls: TMixerLineControls;
begin
ZeroMemory(#Line, SizeOf(Line));
Line.cbStruct := SizeOf(Line);
Line.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
Result := mixerGetLineInfo(Mixer, #Line,
MIXER_GETLINEINFOF_COMPONENTTYPE);
if Result = MMSYSERR_NOERROR then
begin
ZeroMemory(#Controls, SizeOf(Controls));
Controls.cbStruct := SizeOf(Controls);
Controls.dwLineID := Line.dwLineID;
Controls.cControls := 1;
Controls.dwControlType := MIXERCONTROL_CONTROLTYPE_MUTE;
Controls.cbmxctrl := SizeOf(Control);
Controls.pamxctrl := #Control;
Result := mixerGetLineControls(Mixer, #Controls,
MIXER_GETLINECONTROLSF_ONEBYTYPE);
end;
end;
procedure SetMasterMuteValue(
Mixer: hMixerObj;
Value: Boolean);
var
MasterMute: TMixerControl;
Details: TMixerControlDetails;
BoolDetails: TMixerControlDetailsBoolean;
Code: MMResult;
begin
Code := GetMasterMute(0, MasterMute);
if Code = MMSYSERR_NOERROR then
begin
with Details do
begin
cbStruct := SizeOf(Details);
dwControlID := MasterMute.dwControlID;
cChannels := 1;
cMultipleItems := 0;
cbDetails := SizeOf(BoolDetails);
paDetails := #BoolDetails;
end;
LongBool(BoolDetails.fValue) := Value;
Code := mixerSetControlDetails(0, #Details,
MIXER_SETCONTROLDETAILSF_VALUE);
end;
if Code <> MMSYSERR_NOERROR then
raise Exception.CreateFmt('SetMasterMuteValue failure, '+
'multimedia system error #%d', [Code]);
end;
// Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
SetMasterMuteValue(0, CheckBox1.Checked); // Mixer device #0 mute on/off
end;
The GetMute method's parameter should be BOOL rather than Boolean. Likewise for SetMute. –
Well, that is to say.. Yes and no.. Yes A Delphi BOOL (actually a LongBool) can store a C-BOOL.
No, because it can't be used to write to a C-BOOL property. You will get a 0x80070057 = "Wrong Parameter" result.
The simple reason is that In Delphi True means "everything but 0" and represents -1.
A C-BOOL True, however represents 1 and only 1.
So, using a LongBool doesn't work and you should use a workaround using an INT, LongInt, Integer or your own proper defined "BOOL" to avoid "Wrong Parameter" results.
Here an example (that works in Delphi XE7 and tested with SDK version 10.0.10586.15:
// Workaround for BOOL
type TcBOOL = (cFalse = Integer(0),
cTrue = Integer(1));
// IAudioEndpointVolume
function SetMute(bMute: BOOL; pguidEventContext: PGUID): HRESULT; stdcall;
function GetMute(out pbMute: BOOL): HRESULT; stdcall;
// Client functions
function TMfpMixer.GetMute(): TcBOOL;
var
hr: HResult;
Res: BOOL;
begin
hr:= FAudioEndpoint.GetMute(Res);
if FAILED(hr) then
OleCheck(hr);
Result:= TcBOOL(Res);
end;
//
procedure TMfpMixer.SetMute(Value: TcBOOL);
var
hr: HResult;
begin
// This is a workaround on the Delphi BOOL issue.
hr:= FAudioEndpoint.SetMute(BOOL(Value),
Nil);
OleCheck(hr);
end;

How to copy OLE Object from TJvRichEdit to TOleContainer without OLE Server

Task
I have thousands of RTF documents with embedded OLE objects. The OLE objects need to be extracted and saved in the TOleContainer.SaveToFile() format.
Current Solution
Load each RTF file into a TJvRichEdit control and cycle through its OLE objects. These objects can be loaded into a TOleContainer and then saved to disk.
Problem
If my computer doesn't have a particular OLE server installed on it, the code TOleContainer.CreateObjectFromInfo() fails with the error "Invalid FORMATETC structure".
Is there another way to copy the OLE object from the TJvRichEdit control to a TOleContainer that does not require the OLE server to be installed?
Code
uses ActiveX, JvRichEdit, RichEdit, ComObj;
----
{ used to iterate through OLE objects }
type
_ReObject = record
cbStruct: DWORD;
cp: ULONG;
clsid: TCLSID;
poleobj: IOleObject;
pstg: IStorage;
polesite: IOleClientSite;
sizel: TSize;
dvAspect: Longint;
dwFlags: DWORD;
dwUser: DWORD;
end;
TReObject = _ReObject;
IRichEditOle = interface(IUnknown)
['{00020d00-0000-0000-c000-000000000046}']
function GetClientSite(out clientSite: IOleClientSite): HResult; stdcall;
function GetObjectCount: HResult; stdcall;
function GetLinkCount: HResult; stdcall;
function GetObject(iob: Longint; out reobject: TReObject;
dwFlags: DWORD): HResult; stdcall;
function InsertObject(var reobject: TReObject): HResult; stdcall;
function ConvertObject(iob: Longint; rclsidNew: TIID;
lpstrUserTypeNew: LPCSTR): HResult; stdcall;
function ActivateAs(rclsid: TIID; rclsidAs: TIID): HResult; stdcall;
function SetHostNames(lpstrContainerApp: LPCSTR;
lpstrContainerObj: LPCSTR): HResult; stdcall;
function SetLinkAvailable(iob: Longint; fAvailable: BOOL): HResult; stdcall;
function SetDvaspect(iob: Longint; dvaspect: DWORD): HResult; stdcall;
function HandsOffStorage(iob: Longint): HResult; stdcall;
function SaveCompleted(iob: Longint; const stg: IStorage): HResult; stdcall;
function InPlaceDeactivate: HResult; stdcall;
function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
function GetClipboardData(var chrg: TCharRange; reco: DWORD;
out dataobj: IDataObject): HResult; stdcall;
function ImportDataObject(dataobj: IDataObject; cf: TClipFormat;
hMetaPict: HGLOBAL): HResult; stdcall;
end;
{ Note: 'ole' is a TOleContainer and 're' is a TJvRichEdit }
procedure TForm1.Button1Click(Sender: TObject);
var
reOle: IRichEditOle;
reObj: TReObject;
oData: IDataObject;
oInfo: TCreateInfo;
i, cnt: Integer;
begin
if dlgOpen.Execute then
begin
re.Clear;
re.Lines.LoadFromFile(dlgOpen.FileName);
if SendMessage(re.Handle, EM_GETOLEINTERFACE, 0, Longint(#reOle)) <> 0 then
try
if not Assigned(reOle) then
raise Exception.Create('Failed to retrieve IRichEditOle');
cnt := reOle.GetObjectCount;
// cycle through objects
for i := 0 to cnt - 1 do
begin
// initialize 'reObj' structure
FillChar(reObj, SizeOf(reObj), 0);
reObj.cbStruct := SizeOf(reObj);
// get OLE object
OleCheck(reOle.GetObject(i, reObj, 7));
try
// get the OLE object's data
reObj.poleobj.QueryInterface(IDataObject, oData);
if Assigned(oData) then
try
// needed for some OLE servers (like MSPaint)
OleRun(oData);
// initialize TCreateInfo object
oInfo.CreateType := ctFromData;
oInfo.ShowAsIcon := False;
oInfo.IconMetaPict := 0;
oInfo.DataObject := oData;
try
ole.DestroyObject;
ole.CreateObjectFromInfo(oInfo); // <- this is where it fails
ole.SaveToFile([a filename]);
finally
oInfo.DataObject := nil;
end;
finally
oData := nil;
end;
finally
reObj.poleobj := nil;
end;
end;
finally
reOle := nil;
end;
end;
end;
OLE requires the OLE server to be present; there's no way to avoid it.
OLE uses ActiveX automation with embedding of the activated server, and to work with it the server has to be there in the first place. You can't automate something that isn't installed.

Delphi: TOleControl puts ActiveControl in wrong state?

In Mike Lischke's Virtual Treeview, there was workaround code
added to fix a bug when using a TWebBrowser control on the same form.
The problem was that if the user tries to interact with a TOleControl (from which TWebBrowser descends), the first mouse click is eaten. They have to then click again to give the control focus. Then they can interact with the control.
He has comments to explain:
Every control derived from TOleControl has potentially the focus problem.
In order to avoid including the OleCtrls unit (which will, among others, include Variants), which would allow to test for the TOleControl class, the IOleClientSite interface is used for the test, which is supported by TOleControl and a good indicator.
From the full snippit:
procedure TBaseVirtualTree.WMKillFocus(var Msg: TWMKillFocus);
var
Form: TCustomForm;
Control: TWinControl;
Pos: TSmallPoint;
Unknown: IUnknown;
begin
inherited;
[snip]
{
Workaround for wrapped non-VCL controls (like TWebBrowser),
which do not use VCL mechanisms and
leave the ActiveControl property in the wrong state,
which causes trouble when the control is refocused.
}
Form := GetParentForm(Self);
if Assigned(Form) and (Form.ActiveControl = Self) then
begin
Cardinal(Pos) := GetMessagePos;
Control := FindVCLWindow(SmallPointToPoint(Pos));
{
Every control derived from TOleControl has potentially
the focus problem. In order to avoid including
the OleCtrls unit (which will, among others, include Variants),
which would allow to test for the TOleControl
class, the IOleClientSite interface is used for the test,
which is supported by TOleControl and a good indicator.
}
if Assigned(Control) and Control.GetInterface(IOleClientSite, Unknown) then
Form.ActiveControl := nil;
// For other classes the active control should not be modified. Otherwise you need two clicks to select it.
end;
end;
Problem is that the workaround is no longer working for me. And to be honest i have no idea what the problem really was, and how his solution fixed it.
Is there anyone who knows what his comments understand what he's talking about, could explain what the problem is, and how what he's doing was supposed to fix it?
Workaround for wrapped non-VCL
controls (like TWebBrowser), which do
not use VCL mechanisms and leave the
ActiveControl property in the wrong
state, which causes trouble when the
control is refocused. Every control
derived from TOleControl has
potentially the focus problem.
The code is reaching the intended
Form.ActiveControl := nil;
statement, but it just isn't doing the trick.
i'd fix it, but i have no idea how he found it, or how it can come about that TOleControl doesn't "use VCL mechanisms and leaves the ActiveControl property in the wrong state."
Bonus Reading
I originally asked this question on
borland.public.delphi.nativeapi.win32 newsgroup in 2008
Question on Soft-Gems forum
Bump 20110515 (12 months later)
Bump 20150401 (7 years later): Still doesn't work in XE6
Bump 20210309 (11 years later)
I have overcome this issue by using TEmbeddedWB (which is much better than the standard TWebBrowser) and then I had to add this OnShowUI event:
function THtmlFrame.webBrowserShowUI(const dwID: Cardinal;
const pActiveObject: IOleInPlaceActiveObject;
const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
const pDoc: IOleInPlaceUIWindow): HRESULT;
begin
try
if WebBrowser.CanFocus then
WebBrowser.SetFocus; // tell the VCL that the web-browser is focused
except
on E: EInvalidOperation do
; // ignore "Cannot focus inactive or invisible control"
end;
Result := S_FALSE;
end;
But if you must use TWebBrowser you need to write more code:
type
IDocHostUIHandler = interface(IUnknown)
['{bd3f23c0-d43e-11cf-893b-00aa00bdce1a}']
function ShowContextMenu(const dwID: DWORD; const ppt: PPOINT;
const CommandTarget: IUnknown; const Context: IDispatch): HRESULT; stdcall;
function GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT; stdcall;
function ShowUI(const dwID: DWORD; const pActiveObject: IOleInPlaceActiveObject;
const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
const pDoc: IOleInPlaceUIWindow): HRESULT; stdcall;
function HideUI: HRESULT; stdcall;
function UpdateUI: HRESULT; stdcall;
function EnableModeless(const fEnable: BOOL): HRESULT; stdcall;
function OnDocWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
function OnFrameWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
function ResizeBorder(const prcBorder: PRECT; const pUIWindow: IOleInPlaceUIWindow; const fRameWindow: BOOL): HRESULT; stdcall;
function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID; const nCmdID: DWORD): HRESULT; stdcall;
function GetOptionKeyPath(out pchKey: POLESTR; const dw: DWORD): HRESULT; stdcall;
function GetDropTarget(const pDropTarget: IDropTarget; out ppDropTarget: IDropTarget): HRESULT; stdcall;
function GetExternal(out ppDispatch: IDispatch): HRESULT; stdcall;
function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR; out ppchURLOut: POLESTR): HRESULT; stdcall;
function FilterDataObject(const pDO: IDataObject; out ppDORet: IDataObject): HRESULT; stdcall;
end; // IDocHostUIHandler
ICustomDoc = interface(IUnknown)
['{3050f3f0-98b5-11cf-bb82-00aa00bdce0b}']
function SetUIHandler(const pUIHandler: IDocHostUIHandler): HResult; stdcall;
end;
TDocHostUIHandler = class(TInterfacedObject, IDocHostUIHandler)
private
FWebBrowser: TWebBrowser;
protected
function EnableModeless(const fEnable: BOOL): HResult; stdcall;
function FilterDataObject(const pDO: IDataObject; out ppDORet: IDataObject): HResult; stdcall;
function GetDropTarget(const pDropTarget: IDropTarget; out ppDropTarget: IDropTarget): HResult; stdcall;
function GetExternal(out ppDispatch: IDispatch): HResult; stdcall;
function GetHostInfo(var pInfo: TDocHostUIInfo): HResult; stdcall;
function GetOptionKeyPath(var pchKey: POLESTR; const dw: DWORD): HResult; stdcall;
function HideUI: HResult; stdcall;
function OnDocWindowActivate(const fActivate: BOOL): HResult; stdcall;
function OnFrameWindowActivate(const fActivate: BOOL): HResult; stdcall;
function ResizeBorder(const prcBorder: PRECT; const pUIWindow: IOleInPlaceUIWindow;
const fFrameWindow: BOOL): HResult; stdcall;
function ShowContextMenu(const dwID: DWORD; const ppt: PPOINT;
const pcmdtReserved: IInterface; const pdispReserved: IDispatch): HResult; stdcall;
function ShowUI(const dwID: DWORD; const pActiveObject: IOleInPlaceActiveObject;
const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
const pDoc: IOleInPlaceUIWindow): HResult; stdcall;
function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID; const nCmdID: DWORD): HResult; stdcall;
function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR; var ppchURLOut: POLESTR): HResult; stdcall;
function UpdateUI: HResult; stdcall;
public
constructor Create(AWebBrowser: TWebBrowser);
property WebBrowser: TWebBrowser read FWebBrowser;
end;
{ TDocHostUIHandler }
function TDocHostUIHandler.EnableModeless(const fEnable: BOOL): HResult;
begin
Result := S_OK;
end;
function TDocHostUIHandler.FilterDataObject(const pDO: IDataObject; out ppDORet: IDataObject): HResult;
begin
ppDORet := nil;
Result := S_FALSE;
end;
function TDocHostUIHandler.GetDropTarget(const pDropTarget: IDropTarget; out ppDropTarget: IDropTarget): HResult;
begin
ppDropTarget := nil;
Result := E_FAIL;
end;
function TDocHostUIHandler.GetExternal(out ppDispatch: IDispatch): HResult;
begin
ppDispatch := nil;
Result := E_FAIL;
end;
function TDocHostUIHandler.GetHostInfo(var pInfo: TDocHostUIInfo): HResult;
begin
Result := S_OK;
end;
function TDocHostUIHandler.GetOptionKeyPath(var pchKey: POLESTR; const dw: DWORD): HResult;
begin
Result := E_FAIL;
end;
function TDocHostUIHandler.HideUI: HResult;
begin
Result := S_OK;
end;
function TDocHostUIHandler.OnDocWindowActivate(const fActivate: BOOL): HResult;
begin
Result := S_OK;
end;
function TDocHostUIHandler.OnFrameWindowActivate(const fActivate: BOOL): HResult;
begin
Result := S_OK;
end;
function TDocHostUIHandler.ResizeBorder(const prcBorder: PRECT; const pUIWindow: IOleInPlaceUIWindow; const fFrameWindow: BOOL): HResult;
begin
Result := S_FALSE;
end;
function TDocHostUIHandler.ShowContextMenu(const dwID: DWORD; const ppt: PPOINT; const pcmdtReserved: IInterface; const pdispReserved: IDispatch): HResult;
begin
Result := S_FALSE
end;
function TDocHostUIHandler.TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID; const nCmdID: DWORD): HResult;
begin
Result := S_FALSE;
end;
function TDocHostUIHandler.TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR; var ppchURLOut: POLESTR): HResult;
begin
Result := E_FAIL;
end;
function TDocHostUIHandler.UpdateUI: HResult;
begin
Result := S_OK;
end;
function TDocHostUIHandler.ShowUI(const dwID: DWORD; const pActiveObject: IOleInPlaceActiveObject; const pCommandTarget: IOleCommandTarget;
const pFrame: IOleInPlaceFrame; const pDoc: IOleInPlaceUIWindow): HResult;
begin
try
if WebBrowser.CanFocus then
WebBrowser.SetFocus; // tell the VCL that the web-browser is focused
except
on E: EInvalidOperation do
; // ignore "Cannot focus inactive or invisible control"
end;
Result := S_OK;
end;
// install the DocHostUIHandler into the WebBrowser
var
CustomDoc: ICustomDoc;
begin
if WebBrowser1.Document.QueryInterface(ICustomDoc, CustomDoc) = S_OK then
CustomDoc.SetUIHandler(TDocHostUIHandler.Create(WebBrowser1));
end;

Resources