RE Stream

Date: 02-16-2022

Return to Index

 
'Compilable Example:  (Jose Includes)
#Compiler PBWin 10
#Compile Exe
#Dim All
%Unicode=1
#Include "win32api.inc"
#Include "RichEdit.inc"
 
%IDC_ShowRTF = 500
%IDC_SaveRTF = 501
%IDC_LoadRTF = 502
%IDC_RichEdit= 503
%IDC_Clear   = 504
Global hDlg, hRichEdit As Dword
Global sRTF As String, ES As EditStream
 
Function PBMain() As Long
   Dialog New Pixels, 0, "Test Code",300,300,400,300, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, %IDC_ShowRTF,"Show RTF", 10,5,80,20
   Control Add Button, hDlg, %IDC_SaveRTF,"Save", 110,5,50,20
   Control Add Button, hDlg, %IDC_LoadRTF,"Load", 170,5,50,20
   Control Add Button, hDlg, %IDC_Clear,"Clear", 240,5,40,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 %IDC_Clear
               Control Set Text hDlg, %IDC_RichEdit, ""
            Case %IDC_ShowRTF
               sRTF =  ""
               sRTF = RE_Get   'Get RTF from RE
               Clipboard Reset
               Clipboard Set Text sRTF
               ? sRTF
            Case %IDC_SaveRTF
               Open "tempRTF.txt" For Output As #1
               sRTF = "" : sRTF = RE_Get
               Print #1, sRTF
               Close #1
            Case %IDC_LoadRTF
               sRTF = ""
               Open "tempRTF.txt" For Binary As #1
               Get$ #1, Lof(1), sRTF
               RE_Put(sRTF)    'Put RTF into RE
         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
 
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&
   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, %IDC_RichEdit, "", 10, 30, 380, 260, style&, %WS_Ex_ClientEdge
   Control Handle hDlg, %IDC_RichEdit To hRichEdit
   SendMessage hRichEdit, %EM_SETEVENTMASK, 0, %ENM_SELCHANGE Or %ENM_CHANGE Or %ENM_LINK
   SendMessage hRichEdit, %EM_SETLIMITTEXT, &H100000&, 0
   RE_Put(GetRTF)
End Sub
 
Function GetRTF() As String
   Function = "{\rtf1\ansi\ansicpg1252\deff0\deflang1033{\fonttbl{\f0\fnil\fcharset0 MS Sans Serif;}}" + _
      "{\colortbl ;\red0\green176\blue80;\red255\green0\blue0;}" + _
      "\viewkind4\uc1\pard\cf1\b\f0\fs20 We are not to forget all that has happened here!\cf2\b0" + _
      "\par But there are those who would forget." + _
      "\par \pard So let us forget them!\cf0\fs17" + _
      "\par }"
 
End Function
 
'gbs_01070
'Date: 03-10-2012
 
'gbs_01070
'Date: 03-10-2012

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