MODULE ComTools;
(**

   project   = "BlackBox"
   organization   = "www.oberon.ch"
   contributors   = "Oberon microsystems"
   version   = "System/Rsrc/About"
   copyright   = "System/Rsrc/About"
   license   = "Docu/BB-License"
   changes   = ""
   issues   = ""

**)

   IMPORT SYSTEM, COM, WinApi, WinOle;


   
   
   (* ole string handling *)
   
   PROCEDURE NewString* (IN str: ARRAY [untagged] OF CHAR): WinApi.PtrWSTR;
      VAR p: WinApi.PtrWSTR; n: INTEGER;
   BEGIN
      n := 0; WHILE str[n] # 0X DO INC(n) END;
      p := SYSTEM.VAL(WinApi.PtrWSTR, WinOle.CoTaskMemAlloc(SIZE(CHAR) * (n + 1)));
      p^ := str$;
      RETURN p
   END NewString;
   
   PROCEDURE NewEmptyString* (length: INTEGER): WinApi.PtrWSTR;
   BEGIN
      RETURN SYSTEM.VAL(WinApi.PtrWSTR, WinOle.CoTaskMemAlloc(SIZE(CHAR) * length))
   END NewEmptyString;
   
   PROCEDURE FreeString* (VAR p: WinApi.PtrWSTR);
   BEGIN
      WinOle.CoTaskMemFree(SYSTEM.VAL(WinApi.PtrVoid, p));
      p := NIL
   END FreeString;
   
   PROCEDURE NewSString* (IN str: ARRAY [untagged] OF SHORTCHAR): WinApi.PtrSTR;
      VAR p: WinApi.PtrSTR; n: INTEGER;
   BEGIN
      n := 0; WHILE str[n] # 0X DO INC(n) END;
      p := SYSTEM.VAL(WinApi.PtrSTR, WinOle.CoTaskMemAlloc(SIZE(SHORTCHAR) * (n + 1)));
      p^ := str$;
      RETURN p
   END NewSString;
   
   PROCEDURE NewEmptySString* (length: INTEGER): WinApi.PtrSTR;
   BEGIN
      RETURN SYSTEM.VAL(WinApi.PtrSTR, WinOle.CoTaskMemAlloc(SIZE(CHAR) * length))
   END NewEmptySString;
   
   PROCEDURE FreeSString* (VAR p: WinApi.PtrSTR);
   BEGIN
      WinOle.CoTaskMemFree(SYSTEM.VAL(WinApi.PtrVoid, p));
      p := NIL
   END FreeSString;
   

   (* FORMATETC generation *)
   
   PROCEDURE GenFormatEtc* (format: SHORTINT; aspect: SET; tymed: SET; OUT f: WinOle.FORMATETC);
   BEGIN
      f.cfFormat := format;
      f.ptd := NIL;
      f.dwAspect := aspect;
      f.lindex := -1;
      f.tymed := tymed
   END GenFormatEtc;
   
   
   (* STGMEDIUM generation *)
   PROCEDURE GenBitmapMedium* (

      bitmap: WinApi.HBITMAP; unk: COM.IUnknown; VAR sm: WinOle.STGMEDIUM);
   BEGIN
      IF sm.tymed # WinOle.TYMED_NULL THEN WinOle.ReleaseStgMedium(sm) END;
      sm.tymed := WinOle.TYMED_GDI;
      sm.u.hBitmap := bitmap;
      sm.pUnkForRelease := unk
   END GenBitmapMedium;
   
   PROCEDURE GenMetafileMedium* (
      mf: WinApi.HMETAFILEPICT; unk: COM.IUnknown; VAR sm: WinOle.STGMEDIUM);
   BEGIN
      IF sm.tymed # WinOle.TYMED_NULL THEN WinOle.ReleaseStgMedium(sm) END;
      sm.tymed := WinOle.TYMED_MFPICT;
      sm.u.hMetaFilePict := mf;
      sm.pUnkForRelease := unk
   END GenMetafileMedium;
   
   PROCEDURE GenEMetafileMedium* (
      emf: WinApi.HENHMETAFILE; unk: COM.IUnknown; VAR sm: WinOle.STGMEDIUM);
   BEGIN
      IF sm.tymed # WinOle.TYMED_NULL THEN WinOle.ReleaseStgMedium(sm) END;
      sm.tymed := WinOle.TYMED_ENHMF;
      sm.u.hEnhMetaFile := emf;
      sm.pUnkForRelease := unk
   END GenEMetafileMedium;
   
   PROCEDURE GenGlobalMedium* (hg: WinApi.HGLOBAL; unk: COM.IUnknown; VAR sm: WinOle.STGMEDIUM);
   BEGIN
      IF sm.tymed # WinOle.TYMED_NULL THEN WinOle.ReleaseStgMedium(sm) END;
      sm.tymed := WinOle.TYMED_HGLOBAL;
      sm.u.hGlobal := hg;
      sm.pUnkForRelease := unk
   END GenGlobalMedium;
   
   PROCEDURE GenFileMedium* (name: ARRAY OF CHAR; unk: COM.IUnknown; VAR sm: WinOle.STGMEDIUM);
   BEGIN
      IF sm.tymed # WinOle.TYMED_NULL THEN WinOle.ReleaseStgMedium(sm) END;
      sm.tymed := WinOle.TYMED_FILE;
      sm.u.lpszFileName := NewString(name);
      sm.pUnkForRelease := unk
   END GenFileMedium;
   
   PROCEDURE GenStreamMedium* (stm: WinOle.IStream; unk: COM.IUnknown; VAR sm: WinOle.STGMEDIUM);
   BEGIN
      IF sm.tymed # WinOle.TYMED_NULL THEN WinOle.ReleaseStgMedium(sm) END;
      sm.tymed := WinOle.TYMED_ISTREAM;
      sm.u.pstm := stm;
      sm.pUnkForRelease := unk
   END GenStreamMedium;
   
   PROCEDURE GenStorageMedium* (stg: WinOle.IStorage; unk: COM.IUnknown; VAR sm: WinOle.STGMEDIUM);
   BEGIN
      IF sm.tymed # WinOle.TYMED_NULL THEN WinOle.ReleaseStgMedium(sm) END;
      sm.tymed := WinOle.TYMED_ISTORAGE;
      sm.u.pstg := stg;
      sm.pUnkForRelease := unk
   END GenStorageMedium;
   
   
   (* STGMEDIUM access *)
   
   PROCEDURE MediumBitmap* (IN sm: WinOle.STGMEDIUM): WinApi.HBITMAP;
   BEGIN
      ASSERT(sm.tymed = WinOle.TYMED_GDI, 20);
      RETURN sm.u.hBitmap
   END MediumBitmap;
   
   PROCEDURE MediumMetafile* (IN sm: WinOle.STGMEDIUM): WinApi.HMETAFILEPICT;
   BEGIN
      ASSERT(sm.tymed = WinOle.TYMED_MFPICT, 20);
      RETURN sm.u.hMetaFilePict
   END MediumMetafile;
   
   PROCEDURE MediumEnhMetafile* (IN sm: WinOle.STGMEDIUM): WinApi.HENHMETAFILE;
   BEGIN
      ASSERT(sm.tymed = WinOle.TYMED_ENHMF, 20);
      RETURN sm.u.hEnhMetaFile
   END MediumEnhMetafile;
   
   PROCEDURE MediumGlobal* (IN sm: WinOle.STGMEDIUM): WinApi.HGLOBAL;
   BEGIN
      ASSERT(sm.tymed = WinOle.TYMED_HGLOBAL, 20);
      RETURN sm.u.hGlobal
   END MediumGlobal;
   
   PROCEDURE MediumFile* (IN sm: WinOle.STGMEDIUM): WinApi.PtrWSTR;
   BEGIN
      ASSERT(sm.tymed = WinOle.TYMED_FILE, 20);
      RETURN sm.u.lpszFileName
   END MediumFile;
   
   PROCEDURE MediumStream* (IN sm: WinOle.STGMEDIUM): WinOle.IStream;
   BEGIN
      ASSERT(sm.tymed = WinOle.TYMED_ISTREAM, 20);
      RETURN sm.u.pstm
   END MediumStream;
   
   PROCEDURE MediumStorage* (IN sm: WinOle.STGMEDIUM): WinOle.IStorage;
   BEGIN
      ASSERT(sm.tymed = WinOle.TYMED_ISTORAGE, 20);
      RETURN sm.u.pstg
   END MediumStorage;
   
END ComTools.