'------------------------------------------------------------------------------------------ ' ClipboardHtml.inc allows to get and set clipboard content in HTML format ' compatible with all MsOffice tools: Word, Excel, Outlook, OneNote... ' ' Prototypes: ' FUNCTION ClipBoardHtmlGet(BYVAL hDlg AS DWORD) AS STRING ' SUB ClipBoardHtmlSet(BYVAL hDlg AS DWORD, BYVAL sBuffer AS STRING) ' SUB ClipBoardHtmlUpdateHeader(BYREF sClipHtml AS STRING) ' SUB SUB ClipBoardHtmlSetRaw(BYVAL hDlg AS DWORD, BYVAL sClipHtml AS STRING) '------------------------------------------------------------------------------------------ '------------------------------------------------------------------------------------------ FUNCTION ClipBoardHtmlGet(BYVAL hDlg AS DWORD) AS STRING STATIC CF_HTML AS DWORD LOCAL pData AS ASCIIZ POINTER LOCAL hClipboard AS DWORD IF CF_HTML = 0 THEN CF_HTML = RegisterClipboardFormat("HTML Format") 'Word and Excel knows this format END IF IF CF_HTML THEN 'If an application calls OpenClipboard with hwnd set to NULL, 'EmptyClipboard sets the clipboard owner to NULL; this causes SetClipboardData to fail. IF OpenClipboard(hDlg) THEN hClipboard = GetClipboardData(CF_HTML) 'Return a handle of a clipboard object IF hClipboard THEN pData = GlobalLock(hClipboard) IF pData THEN FUNCTION = @pData GlobalUnlock(hClipboard) END IF END IF CloseClipboard END IF END IF END FUNCTION '------------------------------------------------------------------------------------------ '------------------------------------------------------------------------------------------ SUB ClipBoardHtmlUpdateHeader(BYREF sClipHtml AS STRING) 'From a valid HTML clipboard, do the changes directly in the string to have 'a correct header (i.e. correct starting and ending point of HTML and Fragment) LOCAL CharPos AS DWORD LOCAL StartHTML AS DWORD LOCAL EndHTML AS DWORD LOCAL StartFragment AS DWORD LOCAL EndFragment AS DWORD ' local r as string ' r = sClipHtml+$CRLF+$CRLF 'debug 'Set starting and ending point of HTML and Fragment... CharPos = INSTR(sClipHtml, "StartHTML:") + LEN("StartHTML:") StartHTML = INSTR(sClipHtml, "EndFragment:") StartHTML = INSTR(StartHTML, sClipHtml, $CRLF) MID$(sClipHtml, CharPos, 10) = FORMAT$(StartHTML, "0000000000") ' r += "StartHml:"+FORMAT$(StartHTML, "0000000000")+" @"+FORMAT$(CharPos, "0")+$crlf 'debug CharPos = INSTR(sClipHtml, "StartFragment:") + LEN("StartFragment:") StartFragment = INSTR(sClipHtml, "") + LEN("") MID$(sClipHtml, CharPos, 10) = FORMAT$(StartFragment, "0000000000") ' r += "StartFragment:"+FORMAT$(StartFragment, "0000000000")+" @"+FORMAT$(CharPos, "0")+$CRLF 'debug CharPos = INSTR(sClipHtml, "EndFragment:") + LEN("EndFragment:") EndFragment = INSTR(sClipHtml, "") MID$(sClipHtml, CharPos, 10) = FORMAT$(EndFragment, "0000000000") ' r += "EndFragment:"+FORMAT$(EndFragment, "0000000000")+" @"+FORMAT$(CharPos, "0")+$CRLF 'debug CharPos = INSTR(sClipHtml, "EndHTML:") + LEN("EndHTML:") EndHTML = LEN(sClipHtml) MID$(sClipHtml, CharPos, 10) = FORMAT$(EndHTML, "0000000000") ' r += "EndHTML:"+FORMAT$(EndHTML, "0000000000")+" @"+FORMAT$(CharPos, "0")+$CRLF 'debug ' ?r,,exe.name$ END SUB '------------------------------------------------------------------------------------------ '------------------------------------------------------------------------------------------ SUB ClipBoardHtmlSetRaw(BYVAL hDlg AS DWORD, BYVAL sClipHtml AS STRING) 'sClipHtml is a valid HTML clipboard with header, as generated by ClipBoardHtmlSet() STATIC CF_HTML AS DWORD LOCAL hClipboard AS DWORD LOCAL hClipboard2 AS DWORD LOCAL pData AS ASCIIZ POINTER LOCAL pData2 AS ASCIIZ POINTER LOCAL sBuffer2 AS STRING LOCAL CF_Enable AS LONG LOCAL i, j AS LONG 'Register HTML clipboard IF CF_HTML = 0 THEN CF_HTML = RegisterClipboardFormat("HTML Format") 'Word and Excel knows this format END IF 'Write to clipboard IF CF_HTML THEN 'If an application calls OpenClipboard with hwnd set to NULL, 'EmptyClipboard sets the clipboard owner to NULL; this causes SetClipboardData to fail. IF OpenClipboard(hDlg) THEN EmptyClipboard() hClipboard = GlobalAlloc(%GMEM_MOVEABLE, LEN(sClipHtml) + 1) IF hClipboard THEN pData = GlobalLock(hClipboard) @pData = sClipHtml & $NUL GlobalUnlock(hClipboard) SetClipboardData(CF_HTML, hClipboard) 'For Word or Excel '*********************************************************************** 'SetClipboardData(%CF_TEXT , hClipboard) IF CF_Enable THEN '*********************************************************************** 'When writing to %CF_TEXT on my system, Windows will automatiquely 'set the %CF_LOCALE, %CF_OEMTEXT and %CF_UNICODETEXT clipboard. 'SetClipboardData(%CF_TEXT, hMem) 'Set HTML data to %CF_TEXT '*********************************************************************** ' or... '*********************************************************************** 'Set modified data to known format or create your own RegisterClipboardFormat 'Here we will set %CF_TEXT with the same text but no HTML tags. i = INSTR(sClipHtml, "") + LEN("") j = INSTR(sClipHtml, "") sBuffer2 = MID$(sClipHtml, i, j-i) sBuffer2 = RemoveHtmlTag(sBuffer2) hClipboard2 = GlobalAlloc(%GHND, LEN(sBuffer2) + 1) IF hClipboard2 THEN pData2 = GlobalLock(hClipboard2) IF pData2 THEN @pData2 = sBuffer2 & $NUL GlobalUnlock(hClipboard2) SetClipboardData(%CF_TEXT, hClipboard2) 'Text: Paste in Notepad 'SetClipboardData(RegisterClipboardFormat("Some clipboard format"), hClipboard2) END IF END IF END IF '*********************************************************************** END IF CloseClipboard END IF END IF END SUB '------------------------------------------------------------------------------------------ '------------------------------------------------------------------------------------------ SUB ClipBoardHtmlSet(BYVAL hDlg AS DWORD, BYVAL sBuffer AS STRING) '''sBuffer is the HTML code we want to paste, example: '''sBuffer = "" & $CRLF & _ ''' "This is a test
" & $CRLF & _ ''' "" & $CRLF & _ ''' "
  • Entry 1" & $CRLF & _ ''' "
  • Entry 2" & $CRLF & _ ''' "
  • Time " & TIME$ & "

    " & $CRLF '& _ LOCAL sClipHtml AS STRING IF LEN(sBuffer) = 0 THEN EXIT SUB 'sClipHtml is the code we need to add for a valid HTML clipboard sClipHtml = "Version:1.0" & $CRLF & _ "StartHTML:SH00000000" & $CRLF & _ "EndHTML:EH00000000" & $CRLF & _ "StartFragment:SF00000000" & $CRLF & _ "EndFragment:EF00000000" & $CRLF & _ "" & $CRLF & _ "" & $CRLF & _ sBuffer & $CRLF & _ "" & $CRLF & _ "" & $CRLF & _ "" ' Update HTML clipboard header ClipBoardHtmlUpdateHeader sClipHtml 'Write to clipboard ClipBoardHtmlSetRaw hDlg, sClipHtml END SUB '------------------------------------------------------------------------------------------ '------------------------------------------------------------------------------------------ FUNCTION RemoveHtmlTag(BYVAL sBuffer AS STRING) AS STRING LOCAL CharPos1 AS LONG LOCAL CharPos2 AS LONG 'For this demo only, this function is by no mean ok 'for removing tag from real html data DO CharPos1 = INSTR(sBuffer, "<") IF CharPos1 THEN CharPos2 = INSTR(CharPos1 + 1, sBuffer, ">") IF CharPos2 THEN sBuffer = LEFT$(sBuffer, CharPos1 - 1) & MID$(sBuffer, CharPos2 + 1) END IF ELSE EXIT DO END IF LOOP FUNCTION = sBuffer END FUNCTION '------------------------------------------------------------------------------------------