We have a program that sends a paste command to an already opened document in OpenOffice's Writer program to paste in some clipboard text. The core functionality is here:
PROCEDURE PasteIntoWordProcessor ();
VAR
Server, desktop, dispatcher: variant;
FUNCTION variantArray(): Variant;
BEGIN
variantArray:= VarArrayCreate([0, -1], varVariant);
END;
BEGIN
Server := CreateOleObject('com.sun.star.ServiceManager');
desktop := Server.createInstance('com.sun.star.frame.Desktop');
dispatcher := Server.createInstance('com.sun.star.frame.DispatchHelper');
dispatcher.executeDispatch(desktop.CurrentFrame, '.uno:Paste', '', 0, variantArray());
dispatcher:= unassigned;
desktop:= unassigned;
Server:= unassigned;
END;
If we build a simple Forms-based application, this code works great to paste in text already in the Windows clipboard. Here is a sample app that works with a form with a single button on a form wired up to Button1Click:
unit Unit1;
//{$mode objfpc}{$H+}
{$mode macpas}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
Comobj, Variants;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var
Server, desktop, dispatcher: variant;
FUNCTION variantArray(): Variant;
BEGIN
variantArray:= VarArrayCreate([0, -1], varVariant);
END;
begin
Server := CreateOleObject('com.sun.star.ServiceManager');
desktop := Server.createInstance('com.sun.star.frame.Desktop');
dispatcher := Server.createInstance('com.sun.star.frame.DispatchHelper');
dispatcher.executeDispatch(desktop.CurrentFrame, '.uno:Paste', '', 0, variantArray());
dispatcher:= unassigned;
desktop:= unassigned;
Server:= unassigned;
end;
end.
This code pastes and does not crash.
But our app is a Win32 app. So we build a pretty bare-bones Win32 app with the same calls in PasteIntoWordProcessor:
program try2;
{$APPTYPE GUI}
USES
Interfaces, // this includes the LCL widgetset
Variants, ComObj, windows;
CONST
AppName = 'WinHello';
IDC_FILE_NEW = 3001;
IDC_FILE_EXIT = 3003;
VAR
mainMenu, fileMenu: HMENU;
m_Instance : HANDLE;
{$R mytry2.res}
PROCEDURE PasteIntoWordProcessor ();
VAR
Server, desktop, dispatcher: variant;
FUNCTION variantArray(): Variant;
BEGIN
variantArray:= VarArrayCreate([0, -1], varVariant);
END;
BEGIN
Server := CreateOleObject('com.sun.star.ServiceManager');
desktop := Server.createInstance('com.sun.star.frame.Desktop');
dispatcher := Server.createInstance('com.sun.star.frame.DispatchHelper');
dispatcher.executeDispatch(desktop.CurrentFrame, '.uno:Paste', '', 0, variantArray());
dispatcher:= unassigned;
desktop:= unassigned;
Server:= unassigned;
END;
FUNCTION WindowProc(Window: HWnd; AMessage: UINT; WParam : WPARAM; theLParam: LPARAM): LRESULT; stdcall; export;
VAR
ps : PAINTSTRUCT;
wmId : integer;
BEGIN
CASE AMessage OF
WM_COMMAND:
BEGIN
wmId := LOWORD(wParam);
IF wmId = IDC_FILE_NEW THEN
BEGIN
PasteIntoWordProcessor; // FAILS HERE, AFTER SUCCESSFUL PASTE!!!
END
ELSE
WindowProc := DefWindowProc(Window, AMessage, WParam, theLParam);
END;
WM_PAINT:
BEGIN
BeginPaint(Window, @ps);
EndPaint(Window, @ps);
END;
WM_DESTROY:
BEGIN
PostQuitMessage(0);
Exit;
END;
END;
WindowProc := DefWindowProc(Window, AMessage, WParam, theLParam);
END;
FUNCTION WinRegister(className: LPSTR): Boolean;
VAR
WindowClass: WndClass;
BEGIN
WindowClass.Style := cs_hRedraw OR cs_vRedraw;
WindowClass.lpfnWndProc := WndProc(@WindowProc);
WindowClass.cbClsExtra := 0;
WindowClass.cbWndExtra := 0;
WindowClass.hInstance := m_Instance;
WindowClass.hIcon := 0;
WindowClass.hCursor := WINDOWS.LoadCursor(0, MAKEINTRESOURCE(32512));
WindowClass.hbrBackground := GetStockObject(WHITE_BRUSH);
WindowClass.lpszMenuName := NIL;
WindowClass.lpszClassName := className;
IF RegisterClass(@WindowClass) = 0 THEN
WinRegister:= false;
WinRegister:= TRUE;
END;
PROCEDURE updateMenu();
VAR
mi: MENUINFO;
mii: MENUITEMINFO;
BEGIN
mainMenu := CreateMenu();
mi.cbSize:= sizeof(MENUINFO);
mi.fMask:= MIM_STYLE;
fileMenu := CreatePopupMenu();
AppendMenu(fileMenu, MF_STRING, IDC_FILE_NEW, '&New'+#9+'Shift+N');
AppendMenu(fileMenu, MF_STRING, IDC_FILE_EXIT, 'Exit');
mii.cbSize:= sizeof(MENUITEMINFO);
mii.fMask:= MIIM_STRING or MIIM_ID or MIIM_SUBMENU;
mii.fType:= MFT_STRING;
mii.wID:= 0;
SetMenuInfo(mainMenu, @mi);
mii.hSubMenu:= fileMenu;
mii.dwTypeData:= LPSTR('&File');
WINDOWS.InsertMenuItem(mainMenu, 0, FALSE, mii);
END;
FUNCTION InitInstance(hInstance: HANDLE; nCmdShow: Integer): BOOLEAN;
VAR
myHwnd: HWND;
BEGIN
myHwnd := CreateWindow(AppName, AppName, WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, 0, CW_USEDEFAULT, 0, 0, mainMenu, hInstance, NIL);
IF myHwnd = 0 THEN
return FALSE;
ShowWindow(myHwnd, nCmdShow);
UpdateWindow(myHwnd);
return TRUE;
END;
VAR
AMessage: Msg;
BEGIN
m_Instance := HINSTANCE();
IF NOT WinRegister(AppName) THEN
BEGIN
MessageBox(0, 'Register App Name failed', nil, mb_Ok);
Exit;
END;
updateMenu();
IF NOT InitInstance(m_Instance, SW_SHOWNORMAL) THEN
Exit;
WHILE GetMessage(@AMessage, 0, 0, 0) DO
BEGIN
IF (NOT TranslateMDISysAccel(AMessage.hwnd, AMessage)) THEN
BEGIN
TranslateMessage(AMessage);
DispatchMessage(AMessage);
END;
END;
Halt(AMessage.wParam);
END.
A bit more house-keeping, but the core function is the same. (Pick 'New' off the File menu to invoke the core call.)
With this Win32 code, the paste will actually occur, but then the Win32 app will crash.
Oddly, the automation we have set up for MS-Word works fine in our main Win32 program. Just OpenOffice Writer gives us this issue.
Can anyone explain why it would work so well with a Forms based app and not Win32? Or what we can do to make it work with Win32?
I hope I've provided enough code so that others can test these scenarios. It is a long post already, let me know if you need more details.