Character Spacing

Category: Controls - RichEdit

Date: 02-16-2022

Return to Index


 
'Compilable Example:  (Jose Includes)
#Compile Exe '#Win 9.07#
#Dim All
#Include "Win32Api.inc"
#Include "RichEdit.inc"
'#RESOURCE "AddResource.pbr"
 
%RichEdit01                 = 101
%ButtonEditHorizontalExpand = 201
%ButtonEditHorizontalNormal = 202
%ButtonEditVerticalExpand   = 203
%ButtonEditVerticalNormal   = 204
 
Global hDlg        As Dword
Global hRichEdit01 As Dword
'_____________________________________________________________________________
 
Function reRichEditFromStringCallBack(ByVal pDwordArray As Dword PointerByVal pRichEditBuffer As Dword, _
                                      ByVal cb As LongByRef pcb As LongAs Long
 'pDwordArray     = Address of a two dword array used by application to send a string pointer and a string lenght
 'pRichEditBuffer = Address of the rich edit buffer who will receive the string data
 'cb              = Maximum byte count that the richEdit control could accept
 'pcb             = Bytes count of the buffer that was pushed successfully at pRichEditBuffer by the application
 
 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
'_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ __
 
Function reRichEditFromStringReplace(ByVal hRichEdit As DwordByVal sRtfText As StringAs Long 'Send rtf String to a RichEdit
 Local EditStreamInfo As EDITSTREAM
 Dim dwArray(0 To 1)  As Dword
 
 dwArray(0)                 = StrPtr(sRtfText)
 dwArray(1)                 = Len(sRtfText)
 EditStreamInfo.dwCookie    = VarPtr(dwArray(0))
 EditStreamInfo.dwError     = 0
 EditStreamInfo.pfnCallback = CodePtr(reRichEditFromStringCallBack) 'horizonta-spacing
 Function = SendMessage(hRichEdit, %EM_STREAMIN, %SF_RTF Or %SFF_PLAINRTF Or %SFF_SELECTION, VarPtr(EditStreamInfo)) 'horizonta-spacing
 If EditStreamInfo.dwError Then WinBeep(1500, 100)
 
End Function
'_____________________________________________________________________________
 
Function reRichEditToStringCallBack(ByVal pString As String PointerByVal pRichEditBuffer As Dword, _
                                    ByVal cb As LongByRef pcb As LongAs Long
 'pString         Application dynamic string pointer
 'pRichEditBuffer Address of the rich edit buffer who will give the string data
 'cb              Number of bytes written at pRichEditBuffer
 'pcb             Bytes count of the buffer that was pushed successfully at pRichEditBuffer by the application
 
 Local StringPreviousLen As Dword
 
 StringPreviousLen = Len(@pString)
 @pString          = @pString & Nul$(cb)
 CopyMemory(StrPtr(@pString) + StringPreviousLen, pRichEditBuffer, cb)
 
End Function
'_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ __
 
Function reRichEditToString(ByVal hRichEdit As DwordAs String 'Get selected text string from a RichEdit
 Local EditStreamInfo As EDITSTREAM
 Local sBuffer        As String
 
 EditStreamInfo.dwCookie    = VarPtr(sBuffer)
 EditStreamInfo.pfnCallback = CodePtr(reRichEditToStringCallBack)
 SendMessage(hRichEdit, %EM_STREAMOUT, %SF_TEXT Or %SFF_SELECTION, VarPtr(EditStreamInfo))
 Function = sBuffer
 
End Function
'______________________________________________________________________________
 
CallBack Function DlgProc() As Long
 Local ParaFormt2   As PARAFORMAT2
 Local sRtfText     As String
 Local ClientHeight As Long
 Local ClientWidth  As Long
 
 Select Case CbMsg
 
   Case %WM_Command
     Select Case CbCtl
 
       Case %ButtonEditHorizontalExpand
         If CbCtlMsg = %BN_Clicked Or CbCtlMsg = 1 Then
           sRtfText = reRichEditToString(hRichEdit01)
           Replace $CrLf With "\par In sRtfText
           sRtfText = "{\rtf1\expndtw360 " & sRtfText & "\expndtw0}'Use negative number to compress
           reRichEditFromStringReplace(hRichEdit01, sRtfText)        'Send rtf String to a RichEdit
         End If
 
       Case %ButtonEditHorizontalNormal
         If CbCtlMsg = %BN_Clicked Or CbCtlMsg = 1 Then
           sRtfText = reRichEditToString(hRichEdit01)
           Replace $CrLf With "\par In sRtfText
           sRtfText = "{\rtf1 \expndtw0 " & sRtfText & "\expndtw0}'Use negative number to compress
           reRichEditFromStringReplace(hRichEdit01, sRtfText)       'Send rtf String to a RichEdit
         End If
 
       Case %ButtonEditVerticalExpand
         If CbCtlMsg = %BN_Clicked Or CbCtlMsg = 1 Then
           ParaFormt2.dwMask           = %PFM_LINESPACING
           ParaFormt2.dyLineSpacing    = 30 '20 = one line height, 40 = 2, 10 = 
           ParaFormt2.bLineSpacingRule = 5  'Five mean that dyLineSpacing is in twentieth, see MSDN
           ParaFormt2.cbSize           = SizeOf(PARAFORMAT2)
           SendMessage(hRichEdit01, %EM_SETPARAFORMAT, 0, VarPtr(ParaFormt2))
         End If
 
       Case %ButtonEditVerticalNormal
         If CbCtlMsg = %BN_Clicked Or CbCtlMsg = 1 Then
           ParaFormt2.dwMask           = %PFM_LINESPACING
           ParaFormt2.dyLineSpacing    = 20 '20 = one line height, 40 = 2, 10 = 
           ParaFormt2.bLineSpacingRule = 5  'Five mean that dyLineSpacing is in twentieth, see MSDN
           ParaFormt2.cbSize           = SizeOf(PARAFORMAT2)
           SendMessage(hRichEdit01, %EM_SETPARAFORMAT, 0, VarPtr(ParaFormt2))
         End If
 
   End Select
 
   Case %WM_Size
     If CbWParam <> %SIZE_MINIMIZED Then
       ClientWidth  = Lo(WordCbLParam)
       ClientHeight = Hi(WordCbLParam)
       MoveWindow(hRichEdit01, 5, 35, ClientWidth - 10 , ClientHeight - 40, %TRUE)
       InvalidateRect(hRichEdit01, ByVal %NULL, %TRUE) : UpdateWindow(hRichEdit01)
     End If
 
 End Select
 
End Function
'_____________________________________________________________________________
 
Function PBMain () As Long
 Local sText As String
 Local hIcon As Dword
 Local hLib  As Dword
 Local hFont As Dword
 
 sText = "This code show how to increment the horizontal lenght " & $CrLf & _
         "of every characters in a RichEdit50W control "          & $CrLf & _
         "via EM_STREAMIN / EM_STREAMOUT / expndtw."              & $CrLf & _
         ""                                                       & $CrLf & _
         "Vertical spacing can also be done "                     & $CrLf & _
         "via PARAFORMAT."                                        & $CrLf
 
 hFont = CreateFont(36, 0, _       'Height, Width usually 0,
                    00, 0, _       'Escapement(angle), Orientation
                    00, 0, 0, 0, _ 'Bold, Italic, Underline, Strikethru
                    00, %OUT_TT_PRECIS, %CLIP_DEFAULT_PRECIS, _
                    %DEFAULT_QUALITY, %FF_DONTCARE,  "Tahoma")
 
 hIcon = ExtractIcon(GetModuleHandle(""), "Shell32.dll", 294) 'o
 
 Dialog Font "Segoe UI", 9
 Dialog New %HWND_Desktop, "RichEdit characters expansion", , , 453, 220, _
 %WS_Caption Or %WS_MinimizeBox Or %WS_MaximizeBox  Or %WS_ThickFrame Or %WS_SysMenu, 0 To hDlg
 
 Control Add Button, hDlg, %ButtonEditHorizontalExpand, "Expand selected text horizontally",     3, 4, 110, 13
 
 Control Add Button, hDlg, %ButtonEditHorizontalNormal, "UnExpand selected text horizontally", 115, 4, 110, 13
 
 Control Add Button, hDlg, %ButtonEditVerticalExpand,   "Expand selected text vertically",     227, 4, 110, 13
 
 Control Add Button, hDlg, %ButtonEditVerticalNormal,   "UnExpand selected text vertically",   340, 4, 110, 13
 
 hLib = LoadLibrary("MsftEdit.dll")
 Control Add "RichEdit50W", hDlg, %RichEdit01, sText, 4, 15, 450, 150, _
            %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, %WS_Ex_ClientEdge
 
' %WS_CHILD OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %WS_HSCROLL OR %WS_VSCROLL OR %ES_MULTILINE OR _
' %ES_AUTOHSCROLL OR %ES_AUTOVSCROLL OR %ES_NOHIDESEL OR %ES_SAVESEL OR %ES_WANTRETURN, %WS_EX_CLIENTEDGE
 
 hRichEdit01 = GetDlgItem(hDlg, %RichEdit01)
 SendMessage(hRichEdit01, %EM_SETTYPOGRAPHYOPTIONS, %TO_ADVANCEDTYPOGRAPHY Or %TO_SIMPLELINEBREAK, %TO_ADVANCEDTYPOGRAPHY Or %TO_SIMPLELINEBREAK) 'Needed for horizonta-spacing
 SendMessage(hRichEdit01, %WM_SETFONT, hFont, 0)
 
 SetClassLong(hDlg, %GCL_HICONSM, hIcon)
 SetClassLong(hDlg, %GCL_HICON,   hIcon)
 
 Dialog Show Modal hDlg Call DlgProc
 
 FreeLibrary(hLib)
 DestroyIcon(hIcon)
 DeleteObject(hFont)
 
End Function
'_____________________________________________________________________________
'
 


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