RE Stream

Date: 03-28-2012

Return to Index

 
'Compiler Comments:
'This code is written to compile with PBWin10. To compile with PBWin9,
'add these lines:
#Include "CommCtrl.inc"
 
'Compilable Example:
#Compiler PBWin 10
#Compile EXE
#Dim All
#Include "win32api.inc" 
#Include "RichEdit.inc"
 
Global hDlg, hRichEdit As Dword
Global sRTF As String, ES As EditStream
 
%ID_RichEdit = 500
 
Function PBMain() As Long
   Dialog New Pixels, 0, "Test Code",300,300,400,300, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, 100,"Get", 30,5,140,20
   Control Add Button, hDlg, 101,"Put", 180,5,140,20
   CreateRichEditControl
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Select Case Cb.Msg
      Case %WM_Command
         Select Case Cb.Ctl
            Case 100:
               sRTF =  ""
               sRTF = RE_Get   'Get RTF from RE
               ? sRTF
            Case 101
               sRTF = GetRTF
               RE_Put(sRTF)    'Put RTF into RE
               sRTF = ""
         End Select
   End Select
End Function
 
Function RE_Get() As String
   es.dwCookie    = VarPtr(sRTF)              '<--- pointer to buffer
   es.pfnCallback = CodePtr(RE_Get_Callback)  '<--- pointer to callback function
   SendMessage(hRichEdit, %EM_STREAMOUT, %SF_RTF, VarPtr(es))
   Function = sRTF
End Function
 
   'ByVal dwCookie - Dword_PTR
   'ByVal pbBuff   - Byte Pointer - pointer to buffer to read from/write to
   'ByVal cb       - Long         - # of bytes to read or write
   'ByRef pcb      - Long Pointer - pointer to variable that callback function sets - bytes actually read or written
 
   'Return value   - zero is success, non-zero is failure
   'Callback returns zero
   '               -
 
Function RE_Get_Callback( ByVal dwCookie As Dword, ByVal pbbuff As Byte Ptr, ByVal cb As Long, ByRef pcb As Long ) As Long
   Local psBuffer As String Ptr
   psBuffer = dwCookie
   If cb < 1 Then Exit Function
   @psBuffer = @psBuffer & Peek$( pbbuff, cb )
   pcb = cb
End Function
 
Function RE_Put(sRTF As String ) As Long
   Local ES As EDITSTREAM
   es.dwCookie = VarPtr(sRTF)
   es.pfnCallback = CodePtr(RE_Put_Callback)
   Function = SendMessage( hRichEdit, %EM_STREAMIN, %SF_RTF, VarPtr(es))
End Function
 
Function RE_Put_Callback( ByVal dwCookie As Dword, ByVal pbbuff As Byte Ptr, ByVal cb As Long, ByRef pcb As Long ) As Long
   Local psBuffer As String Ptr
   psBuffer = dwCookie
   pcb = Min( Len( @psBuffer ), cb )
   If pcb > 0 Then
      Poke$ pbBuff, Left$( @psBuffer, pcb )
      @psBuffer = Mid$( @psBuffer, pcb + 1 )
   End If
End Function
 
Sub CreateRichEditControl
   Local style&, temp$
   temp$ = "We are not to forget all that has happened here!" + $crlf + _
      "But there are those who would forget." + $crlf + _
      "So let us forget them!"
   style& = %WS_Child Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll Or %ES_AutoHScroll _
      Or %WS_HScroll Or %ES_AutoVScroll Or %ES_WantReturn Or %ES_NoHideSel Or %WS_TabStop
   LoadLibrary("riched32.dll") : InitCommonControls
   Control Add "RichEdit", hDlg, %ID_RichEdit, temp$, 10, 30, 380, 260, style&, %WS_Ex_ClientEdge
   Control Handle hDlg, %ID_RichEdit To hRichEdit
   SendMessage hRichEdit, %EM_SETEVENTMASK, 0, %ENM_SELCHANGE Or %ENM_CHANGE Or %ENM_LINK
   SendMessage hRichEdit, %EM_SETLIMITTEXT, &H100000&, 0
End Sub
 
Function GetRTF() As String
   Function = "{\rtf1\ansi\ansicpg1252\deff0\deftab720{\fonttbl{\f0\fswiss MS Sans Serif;}" & _
      "{\f1\froman\fcharset2 Symbol;}{\f2\froman Times New Roman;}" & _
      "{\f3\froman Times New Roman;}{\f4\froman\fprq2 Times New Roman;}}" & $CrLf & _
      "{\colortbl\red0\green0\blue0;\red255\green0\blue0;}" & $CrLf & _
      "\deflang1033\horzdoc{\*\fchars }{\*\lchars }\pard\plain\f4\fs40\b Truth?" & $CrLf & _
      "\par You can't handle the \plain\f4\fs40\cf1\b truth!\plain\f2\fs20" & $CrLf & _
      "\par }"""
End Function
 
'gbs_01070
'Date: 03-10-2012

created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm