1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75:
| function RtfOut(cchBuff, nPercent: integer) : integer; var p : PChar; begin Result := 0; // assume success p := GlobalLock(ghBuff); if p = nil then Result := fceNoMemory else begin try try mStream.Write(p, cchBuff); except Result := fceNoMemory; // what to return??? end finally GlobalUnlock(ghBuff); end end end; { RtfOut }
function GlobalAllocString(s: AnsiString): HGLOBAL; var hgsz : HGLOBAL; p : PChar; begin // allocate a block of storage large enough for string hgsz := GlobalAlloc(GMEM_MOVEABLE, Length(s) + 1); if hgsz = 0 then Result := 0;
// lock the storage and copy the string into it p := PChar(GlobalLock(hgsz)); if p = nil then begin GlobalFree(hgsz); Result := 0 end; lstrcpy(p, PChar(s));
// unlock the storage and return the global handle GlobalUnlock(hgsz); Result := hgsz; end; { GlobalAllocString }
function ForeignToRtf(filepath, formatClass: AnsiString): integer; var ghszFile, ghszClass, ghszSubset : HGLOBAL; begin // create a temporary stream to hold incoming RTF try mStream := TMemoryStream.Create; except Result := fceNoMemory; end; // create global handles for ghszFile, ghszClass, & ghszSubset and // allocate a working buffer ghszFile := GlobalAllocString(filepath); ghszClass := GlobalAllocString(formatClass); ghszSubset := GlobalAllocString(''); ghBuff := GlobalAlloc(GHND, BUFFSIZE); if (ghszFile = 0) or (ghszClass = 0) or (ghszSubset = 0) or (ghBuff = 0) then begin if Boolean(ghszFile) then GlobalFree(ghszFile); if Boolean(ghszClass) then GlobalFree(ghszClass); if Boolean(ghszSubset) then GlobalFree(ghszSubset); if Boolean(ghBuff) then GlobalFree(ghBuff); ghBuff := 0; Result := fceNoMemory; end;
// import RTF mHandle := LoadLibrary('Word2.dll'); if mHandle <> 0 then begin @ForeignToRtf32 := GetProcAddress(mHandle, 'ForeignToRtf32'); try if @ForeignToRtf32 <> nil then FCE := ForeignToRtf32(ghszFile, nil, ghBuff, ghszClass, ghszSubSet, Integer(@RtfOut)); |