wrdbasic.pas

Delphi写的Microsoft Word模板程序,可以在Word中加入选单。用法：将编译好的testwll.dll改名为test.wll

unit Wrdbasic;

interface

{ pascal equivalents for wordbasic statements }

uses wordApi, wordDecs, Sysutils;

const wNoChange = -1;

Function wbSetDocumentVar(key,value:shortstring):boolean;
Function wbGetDocumentVar(key:shortstring):shortstring;
function wbFileName:shortstring;
FUNCTION wbEditGoTo(dest: shortstring) : Boolean;
FUNCTION wbInsert(txt : shortstring) : Boolean;
FUNCTION wbSelection: shortstring;
FUNCTION wbInt(n : Double; VAR rslt : Integer) : Boolean;
Function wbFileOpen(Fname:shortstring; ConfirmConversions,readonly,AddtoMru,revert:boolean;
         passworddoc, passworddot, writepasswordDoc, WritePasswordDot:shortstring):boolean;
function wbsetDocumentDirty(isdirty:boolean):boolean;
function wbEditPaste:boolean;
function wbFileSave:boolean;
function wbFileSaveAs(fname:shortstring; format:integer; lockAnnot,AddtoMru,RecReadonly,
           EmbedFonts,NatPicFmt:boolean; Password,writePassword:shortstring):boolean;
function wbFileClose(saveoption:integer):boolean;
function wbFileCloseAll(Saveoption:integer):boolean;
function wbFileNew(template:shortstring; isdoc:boolean):boolean;
function wbGetSelPos(var s,e:longint):boolean;
function wbSelectCurWord:boolean;
function wbSetSelRange(s,e:longint):boolean;
function wbDoubleUnderline:boolean;
function wbUnderline:boolean ;
function wbCharLeft(i:integer; s:boolean):boolean;
function wbCharRight(i:integer; s:boolean):boolean;
function wbHidden:boolean;
function wbAtEndOfDocument:boolean;
function wbAtStartOfDocument:boolean;
function wbGetSelStartPos:longint;
function wbGetSelEndPos:longint;
function wbCountWindows:integer;
function wbEditClear(i:integer; o:boolean):boolean;
function wbFormatFontsim(points,underline,bold,italic,hidden:integer;
              font:shortstring):boolean;
function wbShowall(c:boolean):boolean;
function wbFileTemplates(Template:shortstring; LinkStyles:integer):boolean;

implementation

function wbGetSelPos;
begin
 s :=  wbGetSelStartPos;
 e :=  wbGetSelEndPos;
end;

function wbSelectCurWord;
var wcb:TWordCommand;
begin
  wcb.create(wdSelectCurWord, t_none, nil, 0);
  result := ExecuteCommand(wcb);
  wcb.done;
end;

function wbSetSelRange;
var wcb:TWordCommand;
begin
  wcb.create(wdSetSelRange, t_none, nil, 0);
  wcb.addLongParam(s);
  wcb.addLongParam(e);
  result := ExecuteCommand(wcb);
  wcb.done;
end;

function wbDoubleUnderline:boolean;
VAR wcb : TWordCommand;
    temp: integer;
BEGIN
  wcb.Create(wdDoubleUnderline, T_SHORT, @temp, SizeOf(temp));
  ExecuteCommand(wcb);
  result := (Temp = 1);
  wcb.Done;
END;

function wbUnderline:boolean;
VAR wcb : TWordCommand;
    temp: integer;
BEGIN
  wcb.Create(wdUnderline, T_SHORT, @temp, SizeOf(temp));
  ExecuteCommand(wcb);
  result := (Temp = 1);
  wcb.Done;
END;

function wbCharLeft;
var wcb:TWordCommand;
begin
  wcb.create(wdCharLeft, t_none, nil, 0);
  if i <> 1 then wcb.addshortParam(i);
  if s then wcb.addshortParam(1);
  result := ExecuteCommand(wcb);
  wcb.done;
end;

function wbCharRight;
var wcb:TWordCommand;
begin
  wcb.create(wdCharRight, t_none, nil, 0);
  if i <> 1 then wcb.addshortParam(i);
  if s then wcb.addshortParam(1);
  result := ExecuteCommand(wcb);
  wcb.done;
end;

function wbHidden;
VAR wcb : TWordCommand;
    temp: integer;
BEGIN
  wcb.Create(wdHidden, T_SHORT, @temp, SizeOf(temp));
  ExecuteCommand(wcb);
  result := (Temp = 1);
  wcb.Done;
END;

function wbAtEndOfDocument;
VAR wcb : TWordCommand;
    temp: integer;
BEGIN
  wcb.Create(wdAtEndOfDocument, T_SHORT, @temp, SizeOf(temp));
  ExecuteCommand(wcb);
  result := (Temp = 1);
  wcb.Done;
END;

function wbAtStartOfDocument;
VAR wcb : TWordCommand;
    temp: integer;
BEGIN
  wcb.Create(wdAtStartOfDocument, T_SHORT, @temp, SizeOf(temp));
  ExecuteCommand(wcb);
  result := (Temp = 1);
  wcb.Done;
END;

function wbGetSelStartPos;
VAR wcb : TWordCommand;
    temp: longint;
BEGIN
  wcb.Create(wdGetSelStartPos, T_long, @temp, SizeOf(temp));
  ExecuteCommand(wcb);
  result := Temp;
  wcb.Done;
END;

function wbCountWindows;
var wcb:TWordCommand;
    temp: integer;
begin
  wcb.Create(wdCountWindows, t_short, @temp, sizeof(temp));
  ExecuteCommand(wcb);
  result := temp;
  wcb.done;
end;

function wbGetSelendPos;
VAR wcb : TWordCommand;
    temp: longint;
BEGIN
  wcb.Create(wdGetSelendPos, T_long, @temp, SizeOf(temp));
  ExecuteCommand(wcb);
  result := Temp;
  wcb.Done;
END;

function wbEditClear;
var wcb:TWordCommand;
begin
  wcb.create(wdEditClear, t_none, nil, 0);
  if not o then wcb.addshortParam(i);
  result := ExecuteCommand(wcb);
  wcb.done;
end;

function wbFileSave;
var wcb:TWordCommand;
begin
  wcb.create(wdFileSave, t_none, nil, 0);
  result := ExecuteCommand(wcb);
  wcb.done;
end;

function wbFormatFontsim;
(* short font method *)
VAR wcb : TWordDlgCommand;
    p1:array [0..50] of char;
BEGIN
  wcb.Create(wdFormatFont, T_NONE, NIL, 0, CMD_ACTION, [DLG_SET_DATA]);
  if font <> '' then
   begin
    strpcopy(p1,font);
    wcb.AddStringDlgField(fidFont, p1, StrLen(p1)+1);
   end;
  if points >= 0 then wcb.addShortdlgField(fidPoints,points);
  if underline >= 0 then wcb.addShortdlgField(fidunderline,underline);
  if bold >= 0 then wcb.addShortdlgField(fidbold,bold);
  if italic >= 0 then wcb.addShortdlgField(fiditalic,italic);
  if hidden >= 0 then wcb.addShortdlgField(fidhidden,hidden);
  result := ExecuteCommand(wcb);
  wcb.Done;
END;

function wbShowall;
var wcb:TWordCommand;
begin
  wcb.create(wdShowAll, t_none, nil, 0);
  if c then wcb.addshortParam(1) else wcb.addshortParam(0);
  result := ExecuteCommand(wcb);
  wcb.done;
end;

FUNCTION wbEditGoTo;
{ example of a dialog command }
VAR wcb : TWordDlgCommand;
    p1:array [0..50] of char;
BEGIN
  wcb.Create(wdEditGoTo, T_NONE, NIL, 0, CMD_ACTION, [DLG_SET_DATA]);
  strpcopy(p1,dest);
  wcb.AddStringDlgField(fidDestination, p1, StrLen(p1)+1);
  result := ExecuteCommand(wcb);
  wcb.Done;
END;

Function wbFileOpen;
var wcb:TWordDlgCommand;
    p1,p2,p3,p4,p5:array [0..100] of char;
begin
  wcb.Create(wdFileOpen, t_none, nil, 0, cmd_action, [Dlg_set_data]);
  strpcopy(p1,fname);
  wcb.AddStringDlgField(fidName, p1, Strlen(p1) + 1);
  if confirmconversions then wcb.AddShortDlgField(fidConfirmConversions, 1)
   else wcb.AddShortDlgField(fidConfirmConversions, 0);
  if readonly then wcb.AddShortDlgField(fidReadOnly, 1)
   else wcb.AddShortDlgField(fidReadOnly, 0);
  if AddtoMru then wcb.AddShortDlgField(fidAddToMru, 1)
   else wcb.AddShortDlgField(fidAddToMru, 0);
  if revert then wcb.AddShortDlgField(fidRevert, 1)
   else wcb.AddShortDlgField(fidRevert, 0);
  if passworddoc <> '' then
   begin
    strpcopy(p2,passworddoc);
    wcb.AddStringDlgField(fidName, p2, Strlen(p2) + 1);
   end;
  if passworddot <> '' then
   begin
    strpcopy(p3,passworddot);
    wcb.AddStringDlgField(fidName, p3, Strlen(p3) + 1);
   end;
  if writepasswordDoc <> '' then
   begin
    strpcopy(p4,writepasswordDoc);
    wcb.AddStringDlgField(fidName, p4, Strlen(p4) + 1);
   end;
  if WritePasswordDot <> '' then
   begin
    strpcopy(p5,WritePasswordDot);
    wcb.AddStringDlgField(fidName, p5, Strlen(p5) + 1);
   end;
  result := ExecuteCommand(wcb);
  wcb.Done;
end;

function wbFileTemplates;
var wcb:TWordDlgCommand;
    p1:array[0..100] of char;
begin
  wcb.create(wdFileTemplates, t_none, nil, 0, cmd_action, [Dlg_set_data]);
  strpcopy(p1, Template);
  wcb.AddStringdlgField(fidTemplate, p1, strlen(p1) + 1);
  wcb.addShortDlgField(fidLinkStyles,linkstyles);
  result := ExecuteCommand(wcb);
  wcb.Done;
end;

function wbFileSaveAs;
var wcb:TWordDlgCommand;
    p1,p2,p3:array [0..100] of char;
begin
  wcb.Create(wdFileSaveAs, t_none, nil, 0, cmd_action, [Dlg_set_data]);
  strpcopy(p1,fname);
  wcb.AddStringDlgField(fidName, p1, Strlen(p1) + 1);
  wcb.AddShortDlgField(fidFormat,format);
  if lockAnnot then wcb.AddShortDlgField(fidLockAnnot, 1) else wcb.AddShortDlgField(fidLockAnnot, 0);
  if AddtoMru then wcb.AddShortDlgField(fidAddToMru, 1) else wcb.AddShortDlgField(fidAddToMru, 0);
  if RecReadonly then wcb.AddShortDlgField(fidRecommendReadOnly, 1) else wcb.AddShortDlgField(fidRecommendReadOnly, 0);
  if EmbedFonts then wcb.AddShortDlgField(fidEmbedFonts, 1) else wcb.AddShortDlgField(fidEmbedFonts, 0);
  if NatPicFmt then wcb.AddShortDlgField(fidNativePictureFormat, 1) else wcb.AddShortDlgField(fidNativePictureFormat, 0);
  if password <> '' then begin
    strpcopy(p2,password);
    wcb.AddStringDlgField(fidPassword, p2, Strlen(p2) + 1);
   end;
  if writepassword <> '' then begin
    strpcopy(p3,writepassword);
    wcb.AddStringDlgField(fidWritePassword, p3, Strlen(p3) + 1);
   end;
  result := ExecuteCommand(wcb);
  wcb.Done;
end;

function wbFileClose(saveoption:integer):boolean;
var wcb:TWordCommand;
begin
  wcb.create(wdFileClose, t_none, nil, 0);
  wcb.addshortParam(saveoption);
  result := ExecuteCommand(wcb);
  wcb.done;
end;

function wbFileCloseAll(saveoption:integer):boolean;
var wcb:TWordCommand;
begin
  wcb.create(wdFileCloseAll, t_none, nil, 0);
  wcb.addshortParam(saveoption);
  result := ExecuteCommand(wcb);
  wcb.done;
end;

function wbFileNew;
var wcb:TWordDlgCommand;
    p1:Array [0..100] of char;
begin
  wcb.Create(wdFileNew, t_none, nil, 0, cmd_action, [Dlg_set_data]);
  strpcopy(p1,template);
  wcb.addstringdlgField(fidTemplate,p1, strlen(p1) + 1);
  if isdoc then wcb.addshortdlgField(fidNewTemplate,1) else wcb.addshortdlgField(fidNewTemplate,0);
  result := ExecuteCommand(wcb);
  wcb.done;
end;

FUNCTION wbInsert;
{ example of a non-dialog command }
VAR wcb : TWordCommand;
    p1:array [0..50] of char;
BEGIN
  wcb.create(wdInsert, T_NONE, NIL, 0);
  strpcopy(p1,txt);
  wcb.AddStringParam(p1);
  Result := ExecuteCommand(wcb);
  wcb.Done;
END;

function wbEditPaste:boolean;
var wcb:TWordCommand;
begin
  wcb.create(wdEditPaste, t_none, nil, 0);
  result := ExecuteCommand(wcb);
  wcb.done;
end;

function wbSetDocumentDirty;
var wcb:TwordCommand;
begin
  wcb.create(wdSetDocumentDirty, T_none, nil, 0);
  if isdirty then wcb.AddShortParam(1) else wcb.AddShortParam(0);
  result := ExecuteCommand(wcb);
  wcb.done;
end;

FUNCTION wbSelection;
{ example of a function returning a shortstring }
VAR wcb : TWordCommand;
    p : array [0..255] of char;
BEGIN
  wcb.Create(wdSelectionStr, T_STRING, p, 255);
  ExecuteCommand(wcb);
  result := strpas(p);
  wcb.Done;
END;

FUNCTION wbInt;
{ example of a function returning an Integer }
VAR wcb : TWordCommand;
BEGIN
  wcb.Create(wdInt, T_SHORT, @rslt, SizeOf(rslt));
  wcb.AddDoubleParam(n);
  result := ExecuteCommand(wcb);  {wrong - check typing!}
  wcb.Done;
END;

Function wbSetDocumentVar;
Var wcb:TWordCommand;
    p1,p2:Array [0..40] of char;
begin
  wcb.create(wdSetDocumentVar, T_Short, nil, 0);
  strpcopy(p1,key);
  wcb.AddStringParam(p1);
  strpcopy(p2,value);
  wcb.addstringparam(p2);
  result := ExecuteCommand(wcb);
  wcb.done;
end;

function wbGetDocumentVar;
Var wcb:TWordCommand;
    p1,p2:Array [0..40] of char;
begin
  wcb.create(wdGetDocumentVarStr, T_String, p2, 41);
  strpcopy(p1,key);
  wcb.AddStringParam(p1);
  ExecuteCommand(wcb);
  result := strpas(p2);
  wcb.done;
end;

function wbFileName;
var wcb:TwordCommand;
  p1:array [0..100] of char;
begin
  wcb.create(wdFilenamestr, t_string, p1, 101);
  executecommand(wcb);
  result := strpas(p1);
  wcb.done;
end;

end.