Code: Select all
'Example by UEZ Using regex build 2018-08-04 beta / should work Now As x86 / x64
'You need To install the PCRE package from here: https://www.freebasic.net/forum/viewtopic.php?f=2&t=25070&p=224823&hilit=PCRE#p224823
#Include "windows.bi"
#Include "VBcompat.bi"
#Include "pcre.bi"
Declare Function StringRegEx(Byval sPattern As String, Byval sSubject As String) As String
Declare Function WndProc(hWnd As HWND, wMsg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
Declare Sub EditBox_SetText(Byval hWndEdit As HWND, Byval Text As String)
Declare Function EditBox_GetText(Byval hWndEdit As HWND) As String
Dim Shared As HFONT guiFont
Dim Shared As HWND hGUI, hButton_exit, hInputbox
' Create Window Class:
Dim As WNDCLASS wcls
#Ifdef unicode
Dim szClassName As Wstring * 64
Dim szCaption As Wstring * 64
#Else
Dim szClassName As Zstring * 64
Dim szCaption As Zstring * 64
#Endif
szClassName = "FB_GUI"
With wcls
.style = CS_HREDRAW Or CS_VREDRAW
.lpfnWndProc = Cast(WNDPROC, @WndProc)
.hInstance = GetModuleHandle(NULL)
.hIcon = LoadIcon(NULL, IDI_APPLICATION)
.hCursor = LoadCursor(NULL, IDC_ARROW)
.hbrBackground = GetSyscolorbrush(COLOR_3DFACE) 'GetStockObject(WHITE_BRUSH)
.lpszMenuName = NULL
.lpszClassName = Strptr(szClassName)
End With
If RegisterClass(@wcls) = False Then
MessageBox(NULL, "RegisterClass('WindowClass') FAIL!", "Error!", MB_OK Or MB_ICONERROR)
End
End If
Dim Shared As String sText_input
sText_input = "Enter here any number"
hGUI = CreateWindowEx(NULL, szClassName, "RegEx Test", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, CW_USEDEFAULT, CW_USEDEFAULT, 300, 200, NULL, NULL, NULL, NULL)
hButton_exit = CreateWindowEx(NULL, "Button", "Exit", WS_VISIBLE Or WS_CHILD, 180, 120, 90, 24, hGUI, NULL, NULL, NULL)
hInputbox = CreateWindowEx(NULL, "Edit", sText_input, WS_BORDER Or WS_VISIBLE Or WS_CHILD Or ES_AUTOHSCROLL, 10, 40, 200, 24, hGUI, NULL, NULL, NULL)
Dim As MSG uMsg
While GetMessage(@uMsg, NULL, NULL, NULL) <> False
TranslateMessage(@uMsg)
DispatchMessage(@uMsg)
Wend
End
Function StringRegEx(Byval sPattern As String, Byval sSubject As String) As String
Const OVECCOUNT = 300
Dim As Zstring Ptr error1_
Dim As Long error_offset, rc, i, ovector(OVECCOUNT - 1), result
Dim As pcre Ptr re
Dim As String aArr(), sResult
result = 0
re = pcre_compile(sPattern, 0, @error1_, @error_offset, 0)
If re = NULL Then
Return ""
End If
i = 0
Do
rc = pcre_exec(re, NULL, Strptr(sSubject), Len(sSubject), i, 0, @ovector(0), OVECCOUNT)
If rc > 0 Then
Redim Preserve aArr(Lbound(aArr) To Ubound(aArr) + 1)
aArr(Ubound(aArr)) = Mid(sSubject, ovector(0) + 1, ovector(1) - ovector(0))
result += 1
i = ovector(1)
End If
Loop While rc >= 0
For i As Integer = Lbound(aArr) To Ubound(aArr)
sResult &= Trim(aArr(i), Any Chr(10, 13, 32))
Next i
Return sResult
End Function
Function WndProc(hWnd As HWND, wMsg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
Select Case hWnd
Case hGUI
Select Case wMsg
Case WM_DESTROY
PostQuitMessage(NULL)
Return 0
Case WM_COMMAND
Select Case Hiword(wParam)
Case EN_CHANGE
Dim As String sText
sText = EditBox_GetText(hInputbox)
If sText <> "" Then
Dim As String sFilter = StringRegEx("^[\d-]?\d*(?:\.\d*)?$", sText) 'check For correct Input
If sFilter = "" Then
EditBox_SetText(hInputbox, Rtrim(sText, Right(sText, 1)))
SendMessage(hInputbox, EM_SETSEL, wParam, lParam) 'set the cursor To the End
Endif
Endif
Case EN_SETFOCUS
If EditBox_GetText(hInputbox) = sText_input Then EditBox_SetText(hInputbox, "")
Case EN_KILLFOCUS
If EditBox_GetText(hInputbox) = "" Then
EditBox_SetText(hInputbox, sText_input)
SendMessage(hInputbox, EM_SETSEL, wParam, lParam)
Endif
End Select
Select Case lParam
Case hButton_exit
DestroyWindow(hGUI)
Return 0
End Select
Case WM_KEYDOWN
If wParam = VK_ESCAPE Then
DestroyWindow(hGUI)
Return 0
Endif
End Select
End Select
Return DefWindowProc(hWnd, wMsg, wParam, lParam)
End Function
Sub EditBox_SetText(Byval hWndEdit As HWND, Byval Text As String)
'Set text into an editbox Or an editor. Parameters:
'- hWndEdit = handle of the edit box
'- Text = text
SetWindowText(hWndEdit, Text)
End Sub
Function EditBox_GetText(Byval hWndEdit As HWND) As String
'Returns the text from an editbox Or an editor. Parameter:
'- hWndEdit = handle of the edit box
Dim BufferSize As Long
Dim Buffer As String
BufferSize = GetWindowTextLength(hWndEdit)
Buffer = Space(BufferSize)
GetWindowText(hWndEdit, Buffer, BufferSize + 1)
Return Rtrim(Buffer, Chr(0))
End Function
Compiled version can be downloaded here: http://www.mediafire.com/file/nlujtz7mx ... x.zip/file