Date: 02-16-2022
Return to Index
created by gbSnippets
'Compiler Comments:
'This code is written to compile with PBWin10. To compile with PBWin9,
'add this line:
#Include "CommCtrl.inc"
'Compilable Example: (Jose Includes)
'In this example, subclassing is used to capture the KeyUp event, which is not
'normally available in the dialog Callback for a RichEdit control.
#Compiler PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "win32api.inc"
#Include "RichEdit.inc"
#Resource "gbsnippets.pbr"
%IDC_RichEdit = 500 : %IDM_Find = 600
Global hDlg as Dword, hRichEdit as Dword, OldProc&
Global hSearch as Dword, hMenu as Dword, hMenuEdit as Dword
Global SearchTerm$, ReplaceTerm$, SearchStart&, fDlgShown As Long
Function PBMain() As Long
Local style&, buf$
buf$ = "This is sample" + $CrLf + "text for the" + $CrLf + "edit control."
style& = %WS_Child Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll Or %ES_AutoHScroll _
Or %WS_HScroll Or %ES_AutoVScroll Or %ES_WantReturn Or %ES_NoHideSel Or %WS_TabStop
Dialog New Pixels, 0, "Test Code",300,300,200,150, %WS_OverlappedWindow To hDlg
LoadLibrary("riched32.dll") : InitCommonControls
Control Add "RichEdit", hDlg, %IDC_RichEdit, buf$,10,10,180,130, style&
Control Handle hDlg, %IDC_RichEdit To hRichEdit
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Select Case CB.Msg
Case %WM_InitDialog
BuildAcceleratorTable
OldProc& = SetWindowLong(GetDlgItem(hDlg, %IDC_RichEdit), %GWL_WndProc, Codeptr(NewProc)) 'subclass
Case %WM_Destroy
SetWindowLong hRichEdit, %GWL_WNDPROC, OldProc& 'un-subclass
Case %WM_Size
Control Set Size hDlg, %IDC_RichEdit, Lo(Word,cb.lparam)-20, Hi(Word,cb.lparam)-20
Case %WM_Command
If Cb.Ctl = %IDM_Find Then DisplayFindDialog
If CB.Ctl = %IDC_RichEdit AND CB.Ctlmsg = %EN_SetFocus Then Control Post CB.Hndl, CB.Ctl, %EM_SETSEL, 0, 0
End Select
End Function
Function NewProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case Msg
Case %WM_GETDLGCODE 'establish control by the RichEdit
Function = %DlgC_WantAllKeys
Exit Function
' Case %WM_Char
' If wParam = &H16 Then
' If UseProcList Then BuildProcedureList
' FullSyntax 'pasted with CTL-V ?
' End If
End Select
Function = CallWindowProc(OldProc&, hWnd, Msg, wParam, lParam)
End Function
Sub DisplayFindDialog()
Local h As Long, w As Long
Dialog Get Client hDlg To h,w
Dialog New Pixels, hDlg, "Find & Replace", 100, 100, 330, 70, %WS_SysMenu Or %WS_Caption Or %WS_ClipChildren To hSearch
Dialog Set Icon hSearch, "aainfo"
Control Add Label, hSearch, 1050, "Find This:", 5, 10, 60, 20
Control Add TextBox, hSearch, 1100, SearchTerm$, 80, 10, 185, 20
Control Add Label, hSearch, 1060, "Replace With:", 5, 40, 70, 20
Control Add TextBox, hSearch, 1125, ReplaceTerm$, 80, 40, 185, 20
Control Add Button, hSearch, 1070, "Replace", 270, 40, 55, 20
Control Add ImgButton, hSearch, 1110, "downhand", 270, 10, 25, 25
Control Add ImgButton, hSearch, 1120, "uphand", 300, 10, 25, 25
' Control Add Button, hSearch, %IdOk, "Ok", 200, 230, 20, 20
' Control Add Button, hSearch, %IdCancel, "Cancel", 230, 230, 20, 20
' Control Show State hSearch, %IdOk, %SW_Hide
' Control Show State hSearch, %IdCancel, %SW_Hide
fDlgShown = 1
Dialog Show Modeless hSearch Call SearchProc()
Do 'because we want to be able
Dialog DoEvents 'to edit main text while
Loop Until fDlgShown = 0
End Sub
CallBack Function SearchProc() As Long
Local iCheck&, x As Long, y As Long
Select Case CB.Msg
Case %WM_SYSCOMMAND
If (CB.wParam AND &HFFF0) = %SC_Close Then 'trap Alt-F4 and X Button
Control Set Focus hDlg, %IDC_RichEdit
End If
Case %IDCancel
fDlgShown = 0
Dialog End hSearch
Case %WM_Destroy
fDlgShown = 0
Case %WM_Command
Select Case CB.Ctl
Case %IdCancel
Dialog End hSearch
Case 1070 'replace selected text
Control Send hDlg, %IDC_RichEdit, %EM_GETSEL, VarPTR(x), VarPTR(y)
If x <> y Then 'apply only to a selection
Control Get Text hSearch, 1125 To ReplaceTerm$
If Len(ReplaceTerm$) Then
Control Send hDlg, %IDC_RichEdit, %EM_ReplaceSel, %True, StrPTR(ReplaceTerm$)
Control Get Text hSearch, 1100 To SearchTerm$
Control Get Check hSearch, 1130 To iCheck&
FindTextInRichEdit iCheck&, 1 '1 means forward search
End If
End If
Case 1110, %IdOk 'search forward
Control Get Text hSearch, 1100 To SearchTerm$
Control Get Check hSearch, 1130 To iCheck&
FindTextInRichEdit iCheck&, 1 '1 means forward search
Case 1120 'search backward
Control Get Text hSearch, 1100 To SearchTerm$
Control Get Check hSearch, 1130 To iCheck&
FindTextInRichEdit iCheck&, 0 '0 means backward search
End Select
End Select
End Function
Sub FindTextinRichEdit(CaseSensitive&, iDirection&) 'SearchTerm$, SearchStart& are global
Local temp$, P As CharRange, sTerm$
Control Get Text hDlg, %IDC_RichEdit To temp$ 'get text from RichEdit
Control Send hDlg, %IDC_RichEdit, %EM_ExGetSel, 0, VarPTR(P) 'get caret/selection boundaries
If CaseSensitive& Then
sTerm$ = SearchTerm$
Else
sTerm$ = LCase$(SearchTerm$)
temp$ = LCase$(temp$)
End If
If iDirection& Then
SearchStart& = Instr(P.cpMax+1, temp$, sTerm$)
Else
SearchStart& = Instr(-1*(Len(temp$)-P.cpMin), temp$, sTerm$)
End If
If SearchStart& Then
P.cpMin = SearchStart& - 1
P.cpMax = SearchStart& + Len(sTerm$) - 1
If iDirection& Then
Control Send hDlg, %IDC_RichEdit, %EM_ExSetSel, 0, VarPTR(P)
Else
Control Send hDlg, %IDC_RichEdit, %EM_ExSetSel, 0, VarPTR(P)
End If
Else
Beep
End If
End Sub
Sub BuildAcceleratorTable
Local c As Long, ac() As ACCELAPI, hAccelerator As Dword ' for keyboard accelator table values
Dim ac(1)
ac(c).fvirt = %FVIRTKEY Or %FCONTROL : ac(c).key = %VK_F : ac(c).cmd = %IDM_FIND : Incr c
ac(c).fvirt = %FVIRTKEY : ac(c).key = %VK_F3 : ac(c).cmd = %IDM_FIND : Incr c
Accel Attach hDlg, AC() To hAccelerator
End Sub
'gbs_01063
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm