MODULE ComTools;
(**
	project	= "BlackBox"
	organization	= "www.oberon.ch"
	contributors	= "Oberon microsystems"
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "Docu/BB-License"
	changes	= "
	- YYYYMMDD, nn, ...
	"
	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.
