Wide Spacing

Date: 02-16-2022

Return to Index

 
'Compilable Example:  (Jose Includes)
#Compile Exe
#Dim All
%Unicode=1
#Include "win32api.inc"
#Resource Manifest, 1,      "xptheme.xml"
%MultiLineREStyle_Wrap    = %WS_Child Or %WS_ClipSiblings Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll Or %ES_AutoVScroll Or %ES_WantReturn Or %ES_NoHideSel Or %WS_TabStop Or %ES_SaveSel
%ID_RichEdit = 500
%ID_ButtonA  = 501
%ID_ButtonB  = 502
 
Global hDlg, hRichEdit As Dword, buf$
 
Function PBMain() As Long
   Dialog Default Font "Arial Black", 14,1
   Dialog New Pixels, 0, "Wide Spacing Test",300,300,400,350, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, %ID_ButtonA, "RTF Entry", 10,10,140,40
   Control Add Button, hDlg, %ID_ButtonB, "Text Entry", 170,10,140,40
 
   Local RTFExpandA As String
   RTFExpandA = "{\rtf1\expndtw360 "
 
   buf$ =  "This is sample" + $CrLf + "text for the" + $CrLf + "RichEdit control."
   buf$ = RTFExpandA + buf$
 
   CreateRichEditControl ""            'this displayed formatting
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local temp$
   Select Case Cb.Msg
      Case %WM_Command
         Select Case Cb.Ctl
            Case %ID_ButtonA
               temp$ = buf$
               Replace $CrLf With "\par " In temp$
               ReSetRTF(hRichEdit,temp$)                     'does display formatting
            Case %ID_ButtonB
               temp$ = buf$
               Replace $CrLf With "\par " In temp$
               'Control Set Text hDlg, %ID_RichEdit, temp$     'does not expand formatting
               SendMessage hRichEdit, %WM_SetText, 0, StrPtr(temp$)
         End Select
   End Select
End Function
 
Sub CreateRichEditControl(b$)
   LoadLibrary("msftedit.dll")
   Control Add "RichEdit50W", hDlg, %ID_RichEdit, b$, 10, 60, 380, 270, %MultiLineREStyle_Wrap, %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 RESetRTF(ByVal hWin As Dword, ByVal RtfText As String) As Long   'Send rtf String to a RichEdit
   Local EditStreamInfo As EDITSTREAM
   Dim dwArray(0 To 1)  As Dword
   dwArray(0)                 = StrPtr(RtfText)
   dwArray(1)                 = Len(RtfText)
   EditStreamInfo.dwCookie    = VarPtr(dwArray(0))
   EditStreamInfo.pfnCallback = CodePtr(RESetRTF_Callback)
   Function = SendMessage(hWin, %EM_STREAMIN, %SF_RTF Or %SFF_PLAINRTF, VarPtr(EditStreamInfo))
End Function
 
Function RESetRTF_Callback(ByVal pDwordArray As Dword Pointer, ByVal pRichEditBuffer As Dword, ByVal cb As Long, ByRef pcb As Long) As Long
   pcb = Min(@pDwordArray[1], cb)
   If pcb > 0 Then
      CopyMemory(pRichEditBuffer, @pDwordArray[0], pcb)
      @pDwordArray[0] = @pDwordArray[0] + pcb
      @pDwordArray[1] = @pDwordArray[1] - pcb
   End If
End Function 

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