Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compiler PBWin 10
#Compile Exe
#Dim All
%Unicode=1
#Include "win32api.inc"
Global hDlg As Dword, hRichEdit As Dword
%IDC_RichEdit = 500
%IDC_On = 501
%IDC_Off = 502
%IDC_HexDump = 503
$Template = "000000 : xx xx xx xx xx xx xx xx : ........" + $CrLf
Function PBMain() As Long
Local style&, buf$
buf$ = "This is sample" + $CrLf + "text for the" + $CrLf + "edit control."
style& = %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
style& = %WS_Child Or %WS_ClipSiblings Or %WS_Visible Or %ES_MultiLine Or %ES_AutoHScroll Or %ES_WantReturn Or %ES_NoHideSel Or %WS_TabStop
Dialog Default Font "Tahoma", 12, 1
Dialog New Pixels, 0, "Test Code",300,300,400,600, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, %IDC_On,"On", 30,10,60,25
Control Add Button, hDlg, %IDC_Off,"Off", 120,10,60,25
Control Add Button, hDlg, %IDC_HexDump,"Hex Dump", 210,10,90,25
LoadLibrary("msftedit.dll") : InitCommonControls
Control Add "RichEdit50W", hDlg, %IDC_RichEdit, buf$,20,40,400,600, style&, %WS_Ex_ClientEdge
Control Handle hDlg, %IDC_RichEdit To hRichEdit
' SendMessage(hRichEdit, %EM_SETTYPOGRAPHYOPTIONS, %TO_ADVANCEDTYPOGRAPHY Or %TO_SIMPLELINEBREAK, %TO_ADVANCEDTYPOGRAPHY Or %TO_SIMPLELINEBREAK) 'Needed for horizontal spacing
SendMessage(hRichEdit, %EM_SETTARGETDEVICE, 0, 0) 'Enable wordwrap
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local ParaFormt2 As PARAFORMAT2, sRtfText As String
Select Case Cb.Msg
Case %WM_InitDialog
Case %WM_Command
Select Case Cb.Ctl
Case %IDC_On
Control Get Text hDlg, %IDC_RichEdit To sRtfText
sRtfText = "{\rtf1\expndtw360\expnd72 " & sRtfText & "\expnd0\expndtw0}" 'Insert expand instruction.
reRichEditFromStringReplace(hRichEdit, sRtfText) 'Send rtf String to a RichEdit control.
Case %IDC_Off
Control Get Text hDlg, %IDC_RichEdit To sRtfText
sRtfText = "{\rtf1 \expndtw0\expnd0 " & sRtfText & "\expnd0\expndtw0}" 'Insert unExpand instruction with zero value.
reRichEditFromStringReplace(hRichEdit, sRtfText) 'Send rtf String to a RichEdit control.
Case %IDC_HexDump
Control Get Text hDlg, %IDC_RichEdit To sRtfText
? HexDump(sRtfText)
End Select
End Select
End Function
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.pfnCallback = CodePtr(reRichEditFromStringCallBack)
Function = SendMessage(hRichEdit, %EM_STREAMIN, %SF_RTF Or %SFF_PLAINRTF, VarPtr(EditStreamInfo))
If EditStreamInfo.dwError Then WinBeep(1500, 100) : WinBeep(1500, 100)
End Function
Function HexDump(ByVal sBuf As String) As String
Local i, ln, lPos, lPos2, lPos3, lPos4 As Long
Local sAdr, sHex, sTxt As String
ln = Ceil(Len(sBuf) / 8) ' line count
' pre-allocate memory for best speed
sAdr = Space$(ln*8) ' for adress string block
sHex = Space$(ln*24) ' for Hex characters block
sTxt = Space$(ln*47) ' each row is 47 bytes long
lPos = 1
For i = 1 To ln ' build adress block
Mid$(sAdr, lPos) = Hex$(lPos-1, 8)
lPos = lPos + 8
Next
lPos = 1
For i = 1 To Len(sBuf) ' build Hex char block
Mid$(sHex, lPos) = Hex$(Asc(sBuf, i), 2)
lPos = lPos + 3
Next
' replace "non-visible" stuff with a dot in right pane.
Replace Any Chr$(0 To 31) With Repeat$(32, ".") In sBuf
lPos = 1 : lPos2 = 1 : lPos3 = 1 : lPos4 = 1
For i = 1 To ln ' put it all together
Mid$(sTxt, lPos) = Mid$(sAdr, lPos2, 8)
lPos = lPos + 11 : lPos2 = lPos2 + 8
Mid$(sTxt, lPos) = Mid$(sHex, lPos3, 24)
lPos = lPos + 26 : lPos3 = lPos3 + 24
Mid$(sTxt, lPos) = Mid$(sBuf, lPos4, 8)
lPos = lPos + 8 : lPos4 = lPos4 + 8
Mid$(sTxt, lPos) = $CrLf
lPos = lPos + 2
Next
Function = sTxt
End Function
http://www.garybeene.com/sw/gbsnippets.htm