File "ClipboardHtml.inc"
Path: /HotKeyMgr/inc/ClipboardHtml.inc
File size: 8.31 KB
MIME-type:
Charset: utf-8
'------------------------------------------------------------------------------------------
' 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, "<!--StartFragment-->") + LEN("<!--StartFragment-->")
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, "<!--EndFragment-->")
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, "<!--StartFragment-->") + LEN("<!--StartFragment-->")
j = INSTR(sClipHtml, "<!--EndFragment-->")
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 = "<FONT COLOR=""#FF1010"">" & $CRLF & _
''' "<b>This is a test</b><hr>" & $CRLF & _
''' "</FONT>" & $CRLF & _
''' "<li>Entry 1" & $CRLF & _
''' "<li>Entry 2" & $CRLF & _
''' "<li>Time " & TIME$ & "<p>" & $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 & _
"<html><body>" & $CRLF & _
"<!--StartFragment-->" & $CRLF & _
sBuffer & $CRLF & _
"<!--EndFragment-->" & $CRLF & _
"</body>" & $CRLF & _
"</html>"
' 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
'------------------------------------------------------------------------------------------