Case - upper/lower
Character Spacing - horizontal gap between characters
Line Spacing - vertical gap between lines
Paragraph Formatting - merge lines separated by a single $crlf into paragraphs
Underline - underline the currently selected line of text
Discussion here.
Code:
'Compilable Example: 'Jose Includes
#Compile Exe
#Dim All
%Unicode = 1
#Include "Win32API.inc"
%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
Global RTFExpandA As WStringZ * %Max_Path
Enum Equates Singular
IDC_RichEdit = 500
IDC_Case
IDC_Letters
IDC_Under
IDC_Lines
IDC_Paragraph
End Enum
Global hDlg,hRichEdit,OldREProc As Dword
Global UnderlineCurrentLine, WideSpacing, LIneSpacing, CaseType, FormatParagraph As Long
Global LastUnderLine, TurnOffResult As Long
Global OriginalText$
Function PBMain() As Long
Dialog Default Font "Arial Black", 24, 1
Dialog New Pixels, 0, "PowerBASIC",,,700,700, %WS_OverlappedWindow To hDlg
OriginalText$ = "This is a formatting" + $CrLf + "test to figure out the" + $CrLf + "formatting code I want!"
OriginalText$ += $CrLf + $CrLf + OriginalText$
LoadLibrary("msftedit.dll")
Control Add "RichEdit50W", hDlg, %IDC_RichEdit, OriginalText$,10, 60, 680, 630, %MultiLineREStyle_Wrap, %WS_Ex_ClientEdge
Control Handle hDlg, %IDC_RichEdit To hRichEdit
SendMessage hDlg, %EM_SetEventMask, 0, %ENM_SelChange
OldREProc = SetWindowLong(hRichEdit, %GWL_WNDPROC, CodePtr(REProc))
Control Add Button, hDlg, %IDC_Case,"Case", 10,10,120,35
Control Add Button, hDlg, %IDC_Letters,"Ltrs", 140,10,120,35
Control Add Button, hDlg, %IDC_Under,"Under", 270,10,120,35
Control Add Button, hDlg, %IDC_Lines,"Lines", 410,10,120,35
Control Add Button, hDlg, %IDC_Paragraph,"Para", 560,10,120,35
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Select Case Cb.Msg
Case %WM_InitDialog
RTFExpandA = "\expndtw720 "
Case %WM_Command
Select Case Cb.Ctl
Case %IDC_Case : Format_Case(hDlg,%IDC_RichEdit) 'hDlg/%IDC_RichEdit are Global, but in practice I might Format one of several RichEdit controls
Case %IDC_Letters : Format_WideSpacing(hDlg,%IDC_RichEdit)
Case %IDC_Lines : Format_LineSpacing(hDlg,%IDC_RichEdit)
Case %IDC_Paragraph : Format_Paragraph(hDlg,%IDC_RichEdit)
Case %IDC_Under : Format_Underline
End Select
End Select
End Function
Sub sBeep : WinBeep (250,300) : End Sub
Function REProc(ByVal hWnd As Dword, ByVal wMsg As Long, ByVal wParam As Dword, ByVal lParam As Long) As Long
Local CallSetCaret, i As Long, KeyState As Long
Select Case wMsg
Case %WM_KeyUp
If (hWnd = hRichEdit) And UnderLineCurrentLine Then RERemoveUnderLines(hRichEdit) : REUnderLineCurrentLine(hRichEdit)
Case %WM_LButtonUp
If (hWnd = hRichEdit) And UnderLineCurrentLine Then RERemoveUnderLines(hRichEdit) : REUnderLineCurrentLine(hRichEdit)
Case %WM_Destroy
SetWindowLong(hWnd, %GWL_WNDPROC, OldREProc)
End Select
Function = CallWindowProc(OldREProc, hWnd, wMsg, wParam, lParam)
End Function
Function RESelectedText(hControl As Dword) As String 'always get text from hRichEdit
Local rP As CharRange, temp$
SendMessage hControl, %EM_ExGetSel, 0, VarPtr(rP)
Control Get Text GetParent(hControl), %IDC_RichEdit To temp$
Replace $CrLf With $Lf In temp$
temp$ = Mid$(temp$, rP.cpmin+1 To rP.cpmax)
Replace $Lf With $CrLf In temp$
Function = temp$
End Function
Sub RERemoveUnderLines(hControl As Dword) 'remove underline from all words
Local cf As CharFormat2
RETurnOff hControl
cf.cbSize = SizeOf(cf)
SendMessage hControl, %EM_GetCharFormat, %SCF_All, VarPtr(cf)
cf.dwMask = %CFM_UnderLine
cf.dwEffects = cf.dwEffects Xor Not %CFM_Underline
SendMessage hControl, %EM_SetCharFormat, %SCF_All, VarPtr(cf)
RETurnON hControl
End Sub
Sub REUnderlineCurrentLine(hControl As Dword)
Local cf As CharFormat2, rP As CharRange
Local CurrentLine, LineLength As Long
RETurnOff(hControl)
CurrentLine = SendMessage(hControl, %EM_EXLineFromChar, 0,-1) 'current line# / 1st line of selection
LastUnderLine = CurrentLine
rP.cpMin = SendMessage(hControl, %EM_LineIndex, CurrentLine, 0) 'position of 1st char in line#
LineLength = SendMessage(hControl, %EM_LineLength, rP.cpMin, 0) 'length of line starting at that char position
rP.cpMax = rP.cpMin + LineLength
SendMessage(hControl, %EM_EXSetSel, 0, VarPtr(rP)) 'select specified text (rP.cpmin-rP.cpmax)
'remove existing underlines
cf.cbSize = SizeOf(cf)
SendMessage hControl, %EM_GetCharFormat, %SCF_All, VarPtr(cf)
cf.dwMask = %CFM_UnderLine
cf.dwEffects = cf.dwEffects Xor Not %CFM_Underline
SendMessage hControl, %EM_SetCharFormat, %SCF_All, VarPtr(cf)
'underline
cf.cbSize = SizeOf(cf)
SendMessage hControl, %EM_GetCharFormat, %SCF_Selection, VarPtr(cf)
cf.dwMask = %CFM_UnderLine
cf.dwEffects = cf.dwEffects Xor %CFM_Underline
SendMessage hControl, %EM_SetCharFormat, %SCF_Selection, VarPtr(cf)
SendMessage(hControl, %EM_SetSel, rP.cpMin, rP.cpMin)
RETurnOn(hControl)
End Sub
Sub RETurnOff(hControl As Dword)
TurnOffResult = SendMessage(hControl, %EM_GETEVENTMASK, 0, 0) 'get current event mask
SendMessage(hControl, %EM_SETEVENTMASK, 0, 0)
SendMessage(hControl, %WM_SETREDRAW, 0, 0)
End Sub
Sub RETurnOn(hControl As Dword)
SendMessage hControl, %WM_SETREDRAW, 1, 0
InvalidateRect hControl, ByVal %NULL, 0 : UpdateWindow hControl
If TurnOffResult Then SendMessage(hControl, %EM_SETEVENTMASK, 0, TurnOffResult) 'restore event mask
End Sub
Sub Format_Case(hParent As Dword, ControlID As Long)
CaseType Xor=1
RESetText_New hParent, ControlID
End Sub
Sub Format_WideSpacing(hParent As Dword, ControlID As Long)
Incr WideSpacing : If WideSpacing > 2 Then WideSpacing = 0
RESetText_New hParent, ControlID
End Sub
Sub Format_Underline
UnderLineCurrentLine Xor=1
RERemoveUnderLines(hRichEdit)
If UnderLineCurrentLine Then REUnderLineCurrentLine(hRichEdit)
End Sub
Sub Format_LineSpacing(hParent As Dword, ControlID As Long)
Incr LineSpacing : If LineSpacing > 2 Then LineSpacing = 0
RESetText_New hParent, ControlID
End Sub
Sub Format_Paragraph(hParent As Dword, ControlID As Long)
FormatParagraph Xor=1
RESetText_New hParent, ControlID
End Sub
Sub RESetText_New(hParent As Dword, ControlID As Long)
Local hControl As Dword, temp$, ParaFormt2 As PARAFORMAT2, RtfText As String
hControl = GetDlgItem(hParent,ControlID)
RETurnOff hControl
'Case
RtfText = IIf$(CaseType, UCase$(OriginalText$), OriginalText$)
Control Set Text hParent, ControlID, RtfText
'Paragraph Formatting
If FormatParagraph Then
Replace $CrLf + $CrLf With "::::;;;;::::" In RtfText 'get rid of paragraph separation
Replace $CrLf With $Spc In RtfText 'merge individual lines separated by a single $crlf
Replace "::::;;;;::::" With $CrLf + $CrLf In RtfText 'restore the paragraph separation
Control Set Text hParent, ControlID, RtfText
End If
'Character Spacing
If WideSpacing Then
RTFExpandA = Choose$(WideSpacing, "\expndtw360 ", "\expndtw720 ")
RtfText = "{\rtf1\ansi " + RTFExpandA + RtfText + "}" 'Insert expand instruction.
Replace $CrLf With "\par " In RtfText
'Replace "{\rtf1\ansi \expndtw360 {\rtf1\ansi \expndtw360" With "{\rtf1\ansi \expndtw360" In RtfText
SendMessage hControl, %WM_SetText, 0, StrPtr(RtfText) 'place in RichEdit as RTF text
End If
'Line Spacing
If LineSpacing Then
SendMessage hControl, %EM_SetSel, 0, -1
ParaFormt2.dwMask = %PFM_LINESPACING
ParaFormt2.dyLineSpacing = Choose(LineSpacing,30,40,50) '20 = one line height, 40 = 2, 10 = ½
ParaFormt2.bLineSpacingRule = 5 'Five mean that dyLineSpacing is in twentieth, see MSDN
ParaFormt2.cbSize = SizeOf(PARAFORMAT2)
SendMessage(hControl, %EM_SETPARAFORMAT, 0, VarPtr(ParaFormt2))
SendMessage hControl, %EM_SetSel, -1, 0
End If
RETurnON hControl
SendMessage hControl, %EM_SetSel, 0, 0 'could capture the starting postion and restore it here
Control Set Focus hParent, ControlID
End Sub