Date: 02-16-2022
Return to Index
created by gbSnippets
'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 Pointer, ByVal pRichEditBuffer As Dword, _
ByVal cb As Long, ByRef pcb As Long) As 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 Dword, ByVal sRtfText As String) As 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 Pointer, ByVal pRichEditBuffer As Dword, _
ByVal cb As Long, ByRef pcb As Long) As 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 Dword) As 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(Word, CbLParam)
ClientHeight = Hi(Word, CbLParam)
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
'_____________________________________________________________________________
'
http://www.garybeene.com/sw/gbsnippets.htm