Page 1 of 1

Get/Put HTML Clipboard (UTF-8,Win)

Posted: Mon Jan 17, 2005 12:19 pm
by oryaaaaa
Code updated For 5.20+

viewtopic.php?p=78307

Code: Select all

    Global m_cfHTMLClipFormat , EOL$
    EOL$ = Chr(13)+Chr(10) 
    #CP_UTF8=65001

    Procedure RegisterCF()
      If m_cfHTMLClipFormat=0
        m_cfHTMLClipFormat=RegisterClipboardFormat_("HTML Format")
      EndIf
      ProcedureReturn m_cfHTMLClipFormat
    EndProcedure

    Procedure PutHTMLClipboard(sHtmlFragment.s)
      If RegisterCF()=0
        ProcedureReturn
      EndIf
      *out = AllocateMemory(Len(sHtmlFragment)*5+2)
      l = MultiByteToWideChar_(#CP_ACP,0,@sHtmlFragment,-1,0,0)
      l = MultiByteToWideChar_(#CP_ACP,0,@sHtmlFragment,-1,*out,l)
      l = WideCharToMultiByte_(#CP_UTF8,0,*out,-1,0,0,0,0)
      out2.s = Space(l)
      l = WideCharToMultiByte_(#CP_UTF8,0,*out,-1,@out2,l,0,0)
      sHtmlFragment.s=out2
      m_sDescription.s = "Version:1.0"+EOL$+"StartHTML:aaaaaaaaaa"+EOL$+"EndHTML:bbbbbbbbbb"+EOL$+"StartFragment:cccccccccc"+EOL$+"EndFragment:dddddddddd"+EOL$
      sContextStart.s="<HTML><BODY>"+"<!--StartFragment -->"
      sContextEnd.s="<!--EndFragment -->"+"</BODY></HTML>"
      sData.s = m_sDescription.s + sContextStart + sHtmlFragment + sContextEnd
      sData.s = ReplaceString(sData, "aaaaaaaaaa", RSet(StrU(Len(m_sDescription),#PB_Long), 10, "0"))
      sData.s = ReplaceString(sData, "bbbbbbbbbb", RSet(StrU(Len(sData),#PB_Long), 10, "0"))
      sData.s = ReplaceString(sData, "cccccccccc", RSet(StrU(Len(m_sDescription+sContextStart),#PB_Long), 10, "0"))
      sData.s = ReplaceString(sData, "dddddddddd",RSet(StrU(Len(m_sDescription+sContextStart+sHtmlFragment),#PB_Long), 10, "0"))
      OpenClipboard_(0)
      *hMemHandle = GlobalAlloc_(0, Len(sData) + 10)
      If *hMemHandle
        *lpData = GlobalLock_(*hMemHandle)
        If *lpData<>0
          PokeS(*lpData, sData, Len(sData))
          GlobalUnlock_(*hMemHandle)
          EmptyClipboard_()
          SetClipboardData_(m_cfHTMLClipFormat, *hMemHandle)
        EndIf
      EndIf
      FreeMemory(*out)
      CloseClipboard_()
    EndProcedure

    Procedure.s GetHTMLClipboard()
      If RegisterCF()=0
        ProcedureReturn ""
      EndIf
      OpenClipboard_(0)
      hData=GetClipboardData_(m_cfHTMLClipFormat)
      If hData
        *pData=GlobalLock_(hData)
        If PeekB(hData)
          dwSize=MultiByteToWideChar_(65001,0,*pData,-1,0,0)
          Buf.s=Space(dwSize*2)
          MultiByteToWideChar_(65001,0,*pData,-1,@Buf,dwSize)
          dwSize=WideCharToMultiByte_(0,0,@Buf,-1,0,0,0,0)
          Buf2.s=Space(dwSize)
          WideCharToMultiByte_(0,0,@Buf,-1,@Buf2,dwSize,0,0)
          Debug Buf2
          Ret1=FindString(Buf2,"<!--StartFragment",0)
          Ret1=FindString(Buf2,">",Ret1)+1
          If PeekB(@Buf2+Ret1-1)=$0D
            Ret1=Ret1+2
          EndIf
          Ret2=FindString(Buf2,"<!--EndFragment",Ret1)
          GetHTMLClipboardS.s=Mid(Buf2,Ret1,Ret2-Ret1)
        EndIf
        GlobalUnlock_(hData)
      Else
        GetHTMLClipboardS.s=""
      EndIf
      CloseClipboard_()
      ProcedureReturn GetHTMLClipboardS.s
    EndProcedure

    A$=GetHTMLClipboard()
    Delay(1000)
    PutHTMLClipboard(A$)
    Delay(2000)
    End


Posted: Sun Jan 23, 2005 10:41 am
by oryaaaaa
I changed from .9 to 10 by mistake.

Code: Select all

 sData.s = m_sDescription.s + sContextStart + sHtmlFragment + sContextEnd
  sData.s = ReplaceString(sData, "aaaaaaaaaa", RSet(StrU(Len(m_sDescription),#Long), 10, "0"))
  sData.s = ReplaceString(sData, "bbbbbbbbbb", RSet(StrU(Len(sData),#Long), 10, "0"))
  sData.s = ReplaceString(sData, "cccccccccc", RSet(StrU(Len(m_sDescription+sContextStart),#Long), 10, "0"))
  sData.s = ReplaceString(sData, "dddddddddd",RSet(StrU(Len(m_sDescription+sContextStart+sHtmlFragment),#Long), 10, "0"))

Posted: Wed Jun 07, 2006 8:30 pm
by rsts
Was struggling through clipboard formats in HTML and came across this.

Very useful :D

Thanks oryaaaaa.

cheers