| Welcome, Guest |
You have to register before you can post on our site.
|
| Latest Threads |
Next Gen Visual Designer ...
Forum: Programming
Last Post: Jules Marchildon
3 hours ago
» Replies: 2
» Views: 35
|
Claude
Forum: PowerBASIC for Windows
Last Post: Graham McPhee
7 hours ago
» Replies: 15
» Views: 542
|
Promoting PowerBASIC docu...
Forum: PowerBASIC Documentation
Last Post: Graham McPhee
7 hours ago
» Replies: 5
» Views: 6,487
|
PowerBASIC Users...
Forum: This and that - friendly chat
Last Post: Marc Giao
11.10.2026, 04:04
» Replies: 2
» Views: 98
|
font size
Forum: Suggestions and discussion about PUMP
Last Post: Jules Marchildon
10.10.2026, 04:18
» Replies: 4
» Views: 142
|
center line not working w...
Forum: PowerBASIC for Windows
Last Post: Dale Yarker
19.09.2026, 13:29
» Replies: 6
» Views: 754
|
Euclidean division; quoti...
Forum: Source Code Library
Last Post: Dale Yarker
31.08.2026, 06:25
» Replies: 0
» Views: 228
|
Does PB progs run well in...
Forum: PowerBASIC for Windows
Last Post: Stanley Durham
06.08.2026, 12:42
» Replies: 6
» Views: 1,331
|
Where is pbusers.org?
Forum: This and that - friendly chat
Last Post: Kurt Kuzba
05.08.2026, 12:32
» Replies: 3
» Views: 893
|
FFTW - Attn Dan Soper
Forum: Programming
Last Post: Dan Soper
20.05.2026, 12:31
» Replies: 1
» Views: 1,024
|
|
|
| Claude |
|
Posted by: Owen_English - 05.10.2026, 22:29 - Forum: PowerBASIC for Windows
- Replies (15)
|
 |
Has anyone subjected their code to Claude for an analysis? I recently pushed a 100k .bas file thru it and in return receiving a list of ~100 logic errors, some of which were valid, some were not.
I then asked Claude to write an alternative code and what it produced was incredibly close to the original in 25k - but it wasn't 100% compilable by PB. This stuff is going to make us old dinasours all totally redundant.
|
|
|
| center line not working with add label |
|
Posted by: Robert Alvarez - 02.09.2026, 23:54 - Forum: PowerBASIC for Windows
- Replies (6)
|
|
#COMPILE EXE
FUNCTION PBMAIN() AS LONG
LOCAL hDlg AS LONG
DIALOG NEW 0, "SET center Line Test",,,480,300, %WS_SYSMENU, 0 TO hDlg
LOCAL AA AS STRING
AA= STRING$(10, 151)
? AA 'PRINT LINES BELOW DOES NOT
CONTROL ADD LABEL, hDlg, 203,AA , 55, 70,75,450,
CONTROL ADD LABEL, hDlg, 203,STRING$(10, 151) , 55, 80,75,450,
DIALOG SHOW MODAL hDlg
END FUNCTION
|
|
|
|
| Euclidean division; quotient and remainder 1 call |
|
Posted by: Dale Yarker - 31.08.2026, 06:25 - Forum: Source Code Library
- No Replies
|
 |
Euclidean division results for negative dividends are different from regular integer divide and MOD which are 2 operations.
These functions each return both quotient and remainder in BYREF variables.
The function for LONGs is assembly. For now the QUADs is BASIC; assembly will take more work.
This is also at https://www.yarker-dsyc.info/Programs/Mi...idDiv.html with a few more words.
To make a set tuncate functions are at https://www.yarker-dsyc.info/Programs/Mi...teDiv.html
Code: ''The remainder/modulo operation performed by Intel math coprocessors (FPREM
''and FPREM1 instructions) is not Euclidean, Intel's idiv assembly instruction
''is not Euclidean division. They are both IEEE Standard 754.
''In Euclidean division the remainder is never negative. For negative dividends
''the quotient is 1 different than expected.
''From Google- "An example use of Euclidean division with a negative dividend
''is finding a repeating time or calendar offset, such as calculating what hour
''of the day it was a certain number of hours ago.
#compile exe
#dim all
#if %def(%pb_cc32) 'if PBCC
#console off 'don't create a console window
#endif
'========================== Euclidean Division Of LONGs ========================
function EuclidDivide (byval Dividend as long, _
byval Divisor as long, _
byref Quotient as long, _
byref Remainder as long) as long
'
! mov ebx, Divisor
! cmp ebx, 0
! jne DoDivide
! mov function, %err_divisionbyzero
! jmp Done
DoDivide:
! mov esi, Quotient 'Quotient and Remainder pointers to registers
! mov edi, Remainder
'
! mov eax, Dividend 'load the dividend
! cdq 'sign-extend EAX into EDX:EAX
! idiv ebx 'EDX:EAX / ECX
'
'adjust to Euclidean results
! cmp edx, 0 'remainder < 0
! jl RmndrLT0
! jmp Results
RmndrLT0:
! cmp ebx, 0 'divisor > 0
! jg DvsrGT0
! add eax, 1
! sub edx, ebx
! jmp Results
DvsrGT0:
! sub eax, 1
! add edx, ebx
'
'set result variables
Results:
! mov [esi], eax
! mov [edi], edx
Done:
end function
'
'========================== Euclidean Division Of QUADs ========================
'For QUAD the only change is the type of the parameters.
function EuclidDivideQuad (byval Dividend as quad, _
byval Divisor as quad, _
byref Quotient as quad, _
byref Remainder as quad) as long
'------------------------
if Divisor = 0 then
Quotient = 0
Remainder = 0
function = %err_divisionbyzero
exit function
end if
'
Quotient = Dividend \ Divisor
Remainder = Dividend mod Divisor
'
if Remainder < 0 then
if Divisor > 0 then
Quotient -= 1
Remainder += Divisor
else
Quotient += 1
Remainder -= Divisor
end if
end if
end function
'
'/\/\/\/\/\/\/\/\/\/\/\ Demonstrate Euclidian Division /\/\/\/\/\/\/\/\/\/\/\/\
function pbmain () as long
local hTWin as dword
local QuotientQ, RemainderQ as quad
local Quotient, Remainder, ErrNum as long
local FmtLg, FmtQd as string
txt.window("Euclidian Division Demonstration", 200, 200, 18, 64) to hTWin
'
FmtLg = " #;-#; 0"
FmtQd = " ###########;-###########; 0"
'================================== Long =====================================
txt.print "type LONG"
ErrNum = EuclidDivide(9, 0, Quotient, Remainder)
txt.print " 9 / 0 = " + format$(Quotient, FmtLg) + " R" + _
format$(Remainder, FmtLg) + " error code = " + dec$(ErrNum, 2)
'
ErrNum = EuclidDivide(9, 4, Quotient, Remainder)
txt.print " 9 / 4 = " + format$(Quotient, FmtLg) + " R" + _
format$(Remainder, FmtLg) + " error code = " + dec$(ErrNum, 2)
'
ErrNum = EuclidDivide(9, -4, Quotient, Remainder)
txt.print " 9 / -4 = " + format$(Quotient, FmtLg) + " R" + _
format$(Remainder, FmtLg) + " error code = " + dec$(ErrNum, 2)
'
ErrNum = EuclidDivide(-9, 4, Quotient, Remainder)
txt.print "-9 / 4 = " + format$(Quotient, FmtLg) + " R" + _
format$(Remainder, FmtLg) + " error code = " + dec$(ErrNum, 2)
'
ErrNum = EuclidDivide(-9, -4, Quotient, Remainder)
txt.print "-9 / -4 = " + format$(Quotient, FmtLg) + " R" + _
format$(Remainder, FmtLg) + " error code = " + dec$(ErrNum, 2)
'
'================================== Quad =====================================
txt.print
txt.print "type QUAD"
ErrNum = EuclidDivideQuad(90000000000, 0, QuotientQ, RemainderQ)
txt.print " 90000000000 / 0 = " + _
format$(QuotientQ, FmtQd) + " R" + format$(RemainderQ, FmtQd) + _
" error code " + dec$(ErrNum, 2)
'
ErrNum = EuclidDivideQuad(90000000000, 40000000000, QuotientQ, RemainderQ)
txt.print " 90000000000 / 40000000000 = " + _
format$(QuotientQ, FmtQd) + " R" + format$(RemainderQ, FmtQd) + _
" error code " + dec$(ErrNum, 2)
'
ErrNum = EuclidDivideQuad(90000000000, -40000000000, QuotientQ, RemainderQ)
txt.print " 90000000000 / -40000000000 = " + _
format$(QuotientQ, FmtQd) + " R" + format$(RemainderQ, FmtQd) + _
" error code " + dec$(ErrNum, 2)
'
ErrNum = EuclidDivideQuad(-90000000000, 40000000000, QuotientQ, RemainderQ)
txt.print "-90000000000 / 40000000000 = " + _
format$(QuotientQ, FmtQd) + " R" + format$(RemainderQ, FmtQd) + _
" error code " + dec$(ErrNum, 2)
'
ErrNum = EuclidDivideQuad(-90000000000, -40000000000, QuotientQ, RemainderQ)
txt.print "-90000000000 / -40000000000 = " + _
format$(QuotientQ, FmtQd) + " R" + format$(RemainderQ, FmtQd) + _
" error code " + dec$(ErrNum, 2)
'
txt.print
txt.print
txt.color = &h0000C000
txt.print "Any key to close."
txt.waitkey$
txt.end
end function
|
|
|
|
| FFTW - Attn Dan Soper |
|
Posted by: Ian Vincent - 19.05.2026, 14:57 - Forum: Programming
- Replies (1)
|
|
Dan, I saw your post on the pbusers.org site. I am not registered there.
I have played with FFTW in the past.
It was a long time ago though, so not sure if everything you need is here, but it might get you started.
I could never make sense of the licencing for FFTW so moved to the Intel IPP, now OneAPI lib.
It includes a lot of other useful functions, but it takes a while to get into it
Here are my Declares:
Code: %FFTW_FORWARD =-1
%FFTW_BACKWARD =1
%FFTW_ESTIMATE =64 '(1U << 6) in c(rap)/c(razy) notation. IE bit 6 is set
Enum R2RTransformKinds
HalfComplexDFT = 0
HalfComplexIDFT = 1
DHT = 2
DCT1 = 3
DCT2 = 5
DCT3 = 4
DCT4 = 6
DST1 = 7
DST2 = 9
DST3 = 8
DST4 = 10
End Enum
#If %DEF(%FFTW_Double)
Type complex
real As Double
Imag As Double
End Type
Declare Function fftw_plan_dft Lib "libfftw3-3.dll" CDecl Alias "fftw_plan_dft" (ByVal DimCount As Long, ByRef DimSizes As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Sign As Long, ByVal Flags As Long) As Long
Declare Function fftw_plan_dft_1d Lib "libfftw3-3.dll" CDecl Alias "fftw_plan_dft_1d" (ByVal Dim1Size As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Sign As Long, ByVal Flags As Long) As Long
Declare Function fftw_plan_dft_2d Lib "libfftw3-3.dll" CDecl Alias "fftw_plan_dft_2d" (ByVal Dim1Size As Long, ByVal Dim2Size As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Sign As Long, ByVal Flags As Long) As Long
Declare Function fftw_plan_dft_3d Lib "libfftw3-3.dll" CDecl Alias "fftw_plan_dft_3d" (ByVal Dim1Size As Long, ByVal Dim2Size As Long, ByVal Dim3Size As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Sign As Long, ByVal Flags As Long) As Long
Declare Function fftw_plan_dft_r2c Lib "libfftw3-3.dll" CDecl Alias "fftw_plan_dft_r2c" (ByVal DimCount As Long, ByRef DimSizes As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Flags As Long) As Long
Declare Function fftw_plan_dft_r2c_1d Lib "libfftw3-3.dll" CDecl Alias "fftw_plan_dft_r2c_1d" (ByVal Dim1Size As Long, ByRef Src As Double, ByRef Dest As complex, ByVal Flags As Long) As Long
Declare Function fftw_plan_dft_r2c_2d Lib "libfftw3-3.dll" CDecl Alias "fftw_plan_dft_r2c_2d" (ByVal Dim1Size As Long, ByVal Dim2Size As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Flags As Long) As Long
Declare Function fftw_plan_dft_r2c_3d Lib "libfftw3-3.dll" CDecl Alias "fftw_plan_dft_r2c_3d" (ByVal Dim1Size As Long, ByVal Dim2Size As Long, ByVal Dim3Size As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Flags As Long) As Long
Declare Function fftw_plan_dft_c2r Lib "libfftw3-3.dll" CDecl Alias "fftw_plan_dft_c2r" (ByVal DimCount As Long, ByRef DimSizes As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Flags As Long) As Long
Declare Function fftw_plan_dft_c2r_1d Lib "libfftw3-3.dll" CDecl Alias "fftw_plan_dft_c2r_1d" (ByVal Dim1Size As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Flags As Long) As Long
Declare Function fftw_plan_dft_c2r_2d Lib "libfftw3-3.dll" CDecl Alias "fftw_plan_dft_c2r_2d" (ByVal Dim1Size As Long, ByVal Dim2Size As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Flags As Long) As Long
Declare Function fftw_plan_dft_c2r_3d Lib "libfftw3-3.dll" CDecl Alias "fftw_plan_dft_c2r_3d" (ByVal Dim1Size As Long, ByVal Dim2Size As Long, ByVal Dim3Size As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Flags As Long) As Long
Declare Function fftw_plan_r2r Lib "libfftw3-3.dll" CDecl Alias "fftw_plan_r2r" (ByVal DimCount As Long, ByRef DimSizes As Long, ByRef Src As Double, ByRef Dest As Double, ByRef TransformKinds As Long, ByVal Flags As Long) As Long
Declare Function fftw_plan_r2r_1d Lib "libfftw3-3.dll" CDecl Alias "fftw_plan_r2r_1d" (ByVal Dim1Size As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Dim1TransformKind As Long, ByVal Flags As Long) As Long
Declare Function fftw_plan_r2r_2d Lib "libfftw3-3.dll" CDecl Alias "fftw_plan_r2r_2d" (ByVal Dim1Size As Long, ByVal Dim2Size As Long, ByRef Src As Double, ByRef Dest As Double, _
ByVal Dim1TransformKind As Long, ByVal Dim2TransformKind As Long, ByVal Flags As Long) As Long
Declare Function fftw_plan_r2r_3d Lib "libfftw3-3.dll" CDecl Alias "fftw_plan_r2r_3d" (ByVal Dim1Size As Long, ByVal Dim2Size As Long, ByVal Dim3Size As Long, ByRef Src As Double, _
ByRef Dest As Double, ByVal Dim1TransformKind As Long, ByVal Dim2TransformKind As Long, ByVal Dim3TransformKind As Long, ByVal Flags As Long) As Long
Declare Sub fftw_execute Lib "libfftw3-3.dll" CDecl Alias "fftw_execute" (ByVal Plan As Long)
Declare Sub fftw_execute_dft Lib "libfftw3-3.dll" CDecl Alias "fftw_execute_dft" (ByVal Plan As Long, ByRef Src As Double, ByRef Dest As Double)
Declare Sub fftw_execute_dft_r2c Lib "libfftw3-3.dll" CDecl Alias "fftw_execute_dft_r2c" (ByVal Plan As Long, ByRef Src As Double, ByRef Dest As Double)
Declare Sub fftw_execute_dft_c2r Lib "libfftw3-3.dll" CDecl Alias "fftw_execute_dft_c2r" (ByVal Plan As Long, ByRef Src As Double, ByRef Dest As Double)
Declare Sub fftw_execute_r2r Lib "libfftw3-3.dll" CDecl Alias "fftw_execute_r2r" (ByVal Plan As Long, ByRef Src As Double, ByRef Dest As Double)
Declare Sub fftw_destroy_plan Lib "libfftw3-3.dll" CDecl Alias "fftw_destroy_plan" (ByVal Plan As Long)
Declare Sub fftw_cleanup Lib "libfftw3-3.dll" CDecl Alias "fftw_cleanup" ()
#EndIf
#If %DEF(%FFTW_Single)
Type complex
real As Single
Imag As Single
End Type
Declare Function fftw_plan_dft Lib "libfftw3f-3.dll" CDecl Alias "fftwf_plan_dft" (ByVal DimCount As Long, ByRef DimSizes As Long, ByRef Src As Single, ByRef Dest As Single, ByVal Sign As Long, ByVal Flags As Long) As Long
Declare Function fftw_plan_dft_1d Lib "libfftw3f-3.dll" CDecl Alias "fftwf_plan_dft_1d" (ByVal Dim1Size As Long, ByRef Src As Single, ByRef Dest As Single, ByVal Sign As Long, ByVal Flags As Long) As Long
Declare Function fftw_plan_dft_2d Lib "libfftw3f-3.dll" CDecl Alias "fftwf_plan_dft_2d" (ByVal Dim1Size As Long, ByVal Dim2Size As Long, ByRef Src As Single, ByRef Dest As Single, ByVal Sign As Long, ByVal Flags As Long) As Long
Declare Function fftw_plan_dft_3d Lib "libfftw3f-3.dll" CDecl Alias "fftwf_plan_dft_3d" (ByVal Dim1Size As Long, ByVal Dim2Size As Long, ByVal Dim3Size As Long, ByRef Src As Single, ByRef Dest As Single, ByVal Sign As Long, ByVal Flags As Long) As Long
Declare Function fftw_plan_dft_r2c Lib "libfftw3f-3.dll" CDecl Alias "fftwf_plan_dft_r2c" (ByVal DimCount As Long, ByRef DimSizes As Long, ByRef Src As Single, ByRef Dest As Single, ByVal Flags As Long) As Long
Declare Function fftw_plan_dft_r2c_1d Lib "libfftw3f-3.dll" CDecl Alias "fftwf_plan_dft_r2c_1d" (ByVal Dim1Size As Long, ByRef Src As Single, ByRef Dest As complex, ByVal Flags As Long) As Long
Declare Function fftw_plan_dft_r2c_2d Lib "libfftw3f-3.dll" CDecl Alias "fftwf_plan_dft_r2c_2d" (ByVal Dim1Size As Long, ByVal Dim2Size As Long, ByRef Src As Single, ByRef Dest As Single, ByVal Flags As Long) As Long
Declare Function fftw_plan_dft_r2c_3d Lib "libfftw3f-3.dll" CDecl Alias "fftwf_plan_dft_r2c_3d" (ByVal Dim1Size As Long, ByVal Dim2Size As Long, ByVal Dim3Size As Long, ByRef Src As Single, ByRef Dest As Single, ByVal Flags As Long) As Long
Declare Function fftw_plan_dft_c2r Lib "libfftw3f-3.dll" CDecl Alias "fftwf_plan_dft_c2r" (ByVal DimCount As Long, ByRef DimSizes As Long, ByRef Src As Single, ByRef Dest As Single, ByVal Flags As Long) As Long
Declare Function fftw_plan_dft_c2r_1d Lib "libfftw3f-3.dll" CDecl Alias "fftwf_plan_dft_c2r_1d" (ByVal Dim1Size As Long, ByRef Src As Single, ByRef Dest As Single, ByVal Flags As Long) As Long
Declare Function fftw_plan_dft_c2r_2d Lib "libfftw3f-3.dll" CDecl Alias "fftwf_plan_dft_c2r_2d" (ByVal Dim1Size As Long, ByVal Dim2Size As Long, ByRef Src As Single, ByRef Dest As Single, ByVal Flags As Long) As Long
Declare Function fftw_plan_dft_c2r_3d Lib "libfftw3f-3.dll" CDecl Alias "fftwf_plan_dft_c2r_3d" (ByVal Dim1Size As Long, ByVal Dim2Size As Long, ByVal Dim3Size As Long, ByRef Src As Single, ByRef Dest As Single, ByVal Flags As Long) As Long
Declare Function fftw_plan_r2r Lib "libfftw3f-3.dll" CDecl Alias "fftwf_plan_r2r" (ByVal DimCount As Long, ByRef DimSizes As Long, ByRef Src As Single, ByRef Dest As Single, ByRef TransformKinds As Long, ByVal Flags As Long) As Long
Declare Function fftw_plan_r2r_1d Lib "libfftw3f-3.dll" CDecl Alias "fftwf_plan_r2r_1d" (ByVal Dim1Size As Long, ByRef Src As Single, ByRef Dest As Single, ByVal Dim1TransformKind As Long, ByVal Flags As Long) As Long
Declare Function fftw_plan_r2r_2d Lib "libfftw3f-3.dll" CDecl Alias "fftwf_plan_r2r_2d" (ByVal Dim1Size As Long, ByVal Dim2Size As Long, ByRef Src As Single, ByRef Dest As Single, _
ByVal Dim1TransformKind As Long, ByVal Dim2TransformKind As Long, ByVal Flags As Long) As Long
Declare Function fftw_plan_r2r_3d Lib "libfftw3f-3.dll" CDecl Alias "fftwf_plan_r2r_3d" (ByVal Dim1Size As Long, ByVal Dim2Size As Long, ByVal Dim3Size As Long, ByRef Src As Single, _
ByRef Dest As Single, ByVal Dim1TransformKind As Long, ByVal Dim2TransformKind As Long, ByVal Dim3TransformKind As Long, ByVal Flags As Long) As Long
Declare Sub fftw_execute Lib "libfftw3f-3.dll" CDecl Alias "fftwf_execute" (ByVal Plan As Long)
Declare Sub fftw_execute_dft Lib "libfftw3f-3.dll" CDecl Alias "fftwf_execute_dft" (ByVal Plan As Long, ByRef Src As Single, ByRef Dest As Single)
Declare Sub fftw_execute_dft_r2c Lib "libfftw3f-3.dll" CDecl Alias "fftwf_execute_dft_r2c" (ByVal Plan As Long, ByRef Src As Single, ByRef Dest As Single)
Declare Sub fftw_execute_dft_c2r Lib "libfftw3f-3.dll" CDecl Alias "fftwf_execute_dft_c2r" (ByVal Plan As Long, ByRef Src As Single, ByRef Dest As Single)
Declare Sub fftw_execute_r2r Lib "libfftw3f-3.dll" CDecl Alias "fftwf_execute_r2r" (ByVal Plan As Long, ByRef Src As Single, ByRef Dest As Single)
Declare Sub fftw_destroy_plan Lib "libfftw3f-3.dll" CDecl Alias "fftwf_destroy_plan" (ByVal Plan As Long)
Declare Sub fftw_cleanup Lib "libfftw3f-3.dll" CDecl Alias "fftwf_cleanup" ()
#EndIf
And this is how I used it (sinearray is as it suggests an array of samples containing a sinwave):
Local n,Plan As Dword
ReDim amplitudearray(UBound(sinearray))
n=UBound(sinearray)
Plan= fftw_plan_dft_r2c_1d(n, sinearray(0), amplitudearray(0), %FFTW_ESTIMATE )
fftw_execute (Plan)
fftw_destroy_plan(Plan)
fftw_cleanup()
|
|
|
|
| Enter PIN popup dialog in DLL. |
|
Posted by: Dale Yarker - 23.04.2026, 16:54 - Forum: Source Code Library
- No Replies
|
|
A popup for user to enter a PIN for return to your app. The number of digits is specified in the call, and checked by the function in the DLL.
Longer description
at https://www.yarker-dsyc.info/Programs/Mi...N_DLL.html
Source, compiled, icons and Help file in ZIP
at https://www.yarker-dsyc.info/Programs/Mi...er_PIN.zip
DLL source:
Code: #compile dll
#dim all
'================================================================
enum PIN_IDs singular
'%en_update group
ID_PINA1Txtbx = &h3000&
ID_PINA2Txtbx
ID_PINA3Txtbx
ID_PINA4Txtbx
ID_PINA5Txtbx
ID_PINA6Txtbx
ID_PINA7Txtbx
ID_PINA8Txtbx
ID_PINA9Txtbx
ID_PINB1Txtbx = &h3010
ID_PINB2Txtbx
ID_PINB3Txtbx
ID_PINB4Txtbx
ID_PINB5Txtbx
ID_PINB6Txtbx
ID_PINB7Txtbx
ID_PINB8Txtbx
ID_PINB9Txtbx
'%bn_clicked group
ID_PINAExposeBtn
ID_PINBExposeBtn
ID_PINSubmitSnglBtn
ID_PINSubmitDuplBtn
ID_PINHelp
ID_PINCanx
'not selected in callback
ID_PINInstruLbl
ID_PINALbl
ID_PINBLbl 'type rect '
end enum 'number up to &h3FF reserved
'
%EM_SETPASSWORDCHAR = &h00CC
%wm_syscommand = &h0112 '(not built into PBWin)
%DT_CalcRect = &h00000400
#resource icon, PIN16, ".\PIN16.ico"
#resource icon, ShowPWon24, ".\ShowPWon24.ico"
#resource icon, ShowPWoff24, ".\ShowPWoff24.ico"
#resource icon, PINSubmit, ".\PINSubmit48.ico"
#resource icon, PINHelp, ".\HelpQuesBtn48.ico"
#resource icon, PINCanx, ".\CancelPIN32.ico"
global gIsVariableDigits, gNumOfDigits as long '(is in PIN_Enter and callback)
global gEntryErrTitle as wstring
declare function ShellExecute lib "Shell32.dll" alias "ShellExecuteW" ( _
byval hwnd as dword, lpOperation as wstringz, lpFile as wstringz, _
lpParameters as wstringz, lpDirectory as wstringz, byval nShowCmd as long) _
as dword
'############################################################# the function ####
function PIN_Enter alias "PIN_Enter" (byval hParent as dword, _
byval DualPIN as long, _
byval NumOfDigits as long) export as dword
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
static Not1stCall, nFontMono14B as long
static gEntryErrTitle as wstring
static RatioX, RatioY as single
local hPIN_Dlg, PIN as dword
local TBY, TBX, ID_Dig, PosX as long
local InstruStr, DigCnt as wstring
'========================================================= initialization ====
'····························································· persistent ····
if Not1stCall = 0 then 'so it is first call
Not1stCall = -1
font new "Lucida Console", 14, 1, 1, 0, 0 to nFontMono14B
dialog default font "Segoe UI", 12, 0, 1
gEntryErrTitle = "PIN Entry Error"$$
end if
'······························································ each call ····
if (NumOfDigits < 0) or (NumOfDigits > 9) then 'check range
msgbox "The number of PIN digits can only be optionally"$$ + $$crlf + _
"not used, or 0 to 9 digits long."$$ + $$crlf + _
"Not used or 0 is for a variable length PIN of"$$ + $$crlf + _
"1 to 9 digigits. Otherwise the number of digits is"$$ + $$crlf + _
"fixed by the using program."$$, _
%mb_ok or %mb_iconerror or %mb_taskmodal, gEntryErrTitle
exit function
end if
if NumOfDigits = 0 then 'variable number
gIsVariableDigits = -1
gNumOfDigits = 9
else
gNumOfDigits = NumOfDigits
end if
'================================================================= dialog ====
dialog new hParent, "Enter PIN."$$, _
0, 10, 200, 120, _
%ds_3dlook or %ds_modalframe or %ds_nofailcreate or %ds_setfont or _
%ws_caption or %ws_clipsiblings or %ws_dlgframe or %ws_popup or _
%ws_sysmenu, %ws_ex_left or %ws_ex_ltrreading to hPIN_Dlg
dialog set icon hPIN_Dlg, "PIN16"
'------------------------------------------------------- unit/pixel ratio ----
#if %pb_revision = &h1004
dialog units hPIN_Dlg, 1000, 1000 to pixels TBY, TBX 'precycle longs
#else
dialog units hPIN_Dlg, 1000, 1000 to pixels TBX, TBY
#endif
RatioX = 1000 /TBX : RatioY = 1000 / TBY 'mult img px for button units
'------------------------------------------------------------- PIN instru ----
if DualPIN then
InstruStr = "The application requires dual entry for the requested "$$ + _
"task. "$$
end if
if NumOfDigits then
InstruStr +="Enter the "$$ + dec$(gNumOfDigits) + " digit PIN. "$$
else
InstruStr += "The number of digits is not fixed. The PIN may be 4 "$$ + _
"to 9 digits. Leave unused digits at right empty. "$$
end if
InstruStr += "The only characters allowed are ""0"" to ""9""."$$
control add label, hPIN_Dlg, %ID_PINInstruLbl, InstruStr, _
5, 4, 185, 34, %ss_left, %ws_ex_left
control set color hPIN_Dlg, %ID_PINInstruLbl, -1, &hFAFAFA
'---------------------------------------------------- "A" digit textboxes ----
control add label, hPIN_Dlg, %ID_PINALbl, "Enter PIN:"$$, _
4, 45, 42, 10, %ss_right, %ws_ex_left ''55
'
PosX = 49
for ID_Dig = %ID_PINA1Txtbx to %ID_PINA1Txtbx + gNumOfDigits - 1
control add textbox, hPIN_Dlg, ID_Dig, ""$$, _
PosX, 44, 12, 10, %es_center or %es_number or %ws_border or _
%ws_tabstop or %es_password, %ws_ex_clientedge or %ws_ex_left
control set font hPIN_Dlg, ID_Dig, nFontMono14B
PosX += 15
next
'
control add imgbutton, hPIN_Dlg, %ID_PINAExposeBtn, "ShowPWon24", _
181, 43, 28 * RatioX, 28 * RatioY
if DualPIN = 0 then
control add imgbutton, hPIN_Dlg, %ID_PINSubmitSnglBtn, "PINSubmit", _
49 - (52 * RatioX), 59, 52 * RatioX, 52 * RatioY
' dialog set size hPIN_Dlg, 200, 75 + (52 * RatioY)
else
'---------------------------------------------------- "B" digit textboxes ----
PosX = 49
control add label, hPIN_Dlg, %ID_PINBLbl, "Reenter PIN:"$$, _
4, 60, 42, 10, %ss_right, %ws_ex_left ''55
for ID_Dig = %ID_PINB1Txtbx to %ID_PINB1Txtbx + gNumOfDigits - 1
control add textbox, hPIN_Dlg, ID_Dig, ""$$, _
PosX, 60, 12, 10, %es_center or %es_number or %ws_border or _
%ws_tabstop or %es_password, %ws_ex_clientedge or %ws_ex_left
control set font hPIN_Dlg, ID_Dig, nFontMono14B
PosX += 15
next
'
control add imgbutton, hPIN_Dlg, %ID_PINBExposeBtn, "ShowPWon24", _
181, 59, 28 * RatioX, 28 * RatioY
control add imgbutton, hPIN_Dlg, %ID_PINSubmitDuplBtn, "PINSubmit", _
49 - (52 * RatioX), 75, 52 * RatioX, 52 * RatioY
end if
'----------------------------------------------------- "A" and "B" common ----
if DualPIN = 0 then
control add imgbutton, hPIN_Dlg, %ID_PINHelp, "PINHelp", _
191 - (99 * RatioX), 59, 52 * RatioX, 52 * RatioY
control add imgbutton, hPIN_Dlg, %ID_PINCanx, "PINCanx", _
191 - (36 * RatioX), 59 + (16 * RatioY), (36 * RatioX), (36 * RatioY)
dialog set size hPIN_Dlg, 200, 76 + (52 * RatioY)
else
control add imgbutton, hPIN_Dlg, %ID_PINHelp, "PINHelp", _
191 - (99 * RatioX), 75, 52 * RatioX, 52 * RatioY
dialog set size hPIN_Dlg, 200, 92 + (52 * RatioY)
control add imgbutton, hPIN_Dlg, %ID_PINCanx, "PINCanx", _
191 - (36 * RatioX), 75 + (16 * RatioY), (36 * RatioX), (36 * RatioY)
end if
'
dialog show modal hPIN_Dlg call PINDlgCB to PIN
function = PIN
end function
'================================================================= callback ====
callback function PINDlgCB() as long
static A_IsExposed, B_IsExposed as long
static PINStr as wstring
local TmpL as long
local TmpS as wstring
if cb.msg = %wm_command then
if cb.ctlmsg = %en_update then
if (cb.ctl >= %ID_PINA1Txtbx) and (cb.ctl <= %ID_PINB9Txtbx) then
if (gNumOfDigits - 1) > (&h00000F and cb.ctl) then
control set focus cb.hndl, cb.ctl + 1
else
control set focus cb.hndl, %ID_PINB1Txtbx
end if
end if
elseif cb.ctlmsg = %bn_clicked then
select case as const cb.ctl
case %ID_PINAExposeBtn
if A_IsExposed then 'unexpose
for TmpL = %ID_PINA1Txtbx to %ID_PINA9Txtbx
control send cb.hndl, TmpL, %EM_SETPASSWORDCHAR,_
&h2A, 0
next
control set imgbutton cb.hndl, %ID_PINAExposeBtn, "ShowPWon24"
A_IsExposed = 0
else 'expose
for TmpL = %ID_PINA1Txtbx to %ID_PINA9Txtbx
control send cb.hndl, TmpL, %EM_SETPASSWORDCHAR, 0, 0
next
control set imgbutton cb.hndl, %ID_PINAExposeBtn, "ShowPWoff24"
A_IsExposed = -1
end if
for TmpL = %ID_PINA1Txtbx to %ID_PINA9Txtbx
control redraw cb.hndl, TmpL
next
case %ID_PINBExposeBtn
if B_IsExposed then
for TmpL = %ID_PINB1Txtbx to %ID_PINB9Txtbx
control send cb.hndl, TmpL, %EM_SETPASSWORDCHAR,_
&h2A, 0
next
control set imgbutton cb.hndl, %ID_PINBExposeBtn, "ShowPWon24"
B_IsExposed = 0
else 'expose
for TmpL = %ID_PINB1Txtbx to %ID_PINB9Txtbx
control send cb.hndl, TmpL, %EM_SETPASSWORDCHAR, 0, 0
next
control set imgbutton cb.hndl, %ID_PINBExposeBtn, "ShowPWoff24"
B_IsExposed = -1
end if
for TmpL = %ID_PINB1Txtbx to %ID_PINB9Txtbx
control redraw cb.hndl, TmpL
next
'············································· submit single button ····
case %ID_PINSubmitSnglBtn, %ID_PINSubmitDuplBtn
control get text cb.hndl, %ID_PINA1Txtbx to TmpS
PINStr = TmpS
for TmpL = 1 to 8
control get text cb.hndl, %ID_PINA1Txtbx + TmpL to TmpS
PINStr += TmpS
next
TmpL = len(PINStr)
if gIsVariableDigits then
if Tmpl < 4 then
msgbox "Varible length PINs must be 4 to 9 digits "$$ + _
"and exactly the same as when it was created."$$, _
%mb_ok or %mb_iconerror or %mb_taskmodal, gEntryErrTitle
exit function
end if
else
if TmpL < gNumOfDigits then
msgbox "The program using this PIN requires "$$ + _
dec$(gNumOfDigits) + " digits."$$, _
%mb_ok or %mb_iconerror or %mb_taskmodal, gEntryErrTitle
exit function
end if
end if
if cb.ctl = %ID_PINSubmitDuplBtn then
for TmpL = 0 to 8
control get text cb.hndl, %ID_PINB1Txtbx + TmpL to TmpS
if TmpS = mid$(PINStr, TmpL + 1, 1) then
iterate for
else
msgbox "The and the repeat do not match."$$, _
%mb_ok or %mb_iconerror or %mb_taskmodal, _
gEntryErrTitle
exit function
end if
next
end if
if gIsVariableDigits then
TmpL = 9 - len(PINStr)
PINStr += string$$(TmpL, "0"$$)
end if
dialog end cb.hndl, val(PINStr)
case %ID_PINHelp
'' ShellExecute
ShellExecute (0, "open"$$, "PIN_Enter_Help.html", ""$$, ""$$, %sw_shownormal)
case %ID_PINCanx
goto NoPIN
end select
end if
elseif (lo(word, cb.wparam) = %sc_close) and (cb.msg = %wm_syscommand) then
goto NoPIN
end if
exit function
NoPIN:
TmpL = msgbox("""Yes"", to quit PIN entry."$$ + $$crlf + _
"""No"", to stay and enter a PIN."$$, _
%mb_yesno or %mb_iconquestion or %mb_defbutton2 or %mb_taskmodal, _
"Verify Quitting PIN Entry"$$)
if TmpL = %idno then
function = -1
else
dialog end cb.hndl
end if
end function
Code: 'File PIN_SLL_demo.bas
#compile exe
#dim all
#if %def(%pb_cc32)
#console off
#endif
declare function PIN_Enter lib "EnterPIN.dll" alias "PIN_Enter" _
(byval hParent as dword, _
byval DuplPIN as long, _
byval NumOfDigits as long) as dword
function pbmain () as long
local hTWin, PIN as dword
local Rspnc as wstring
txt.window("PIN Enter Popup Demonstration"$$, 400, 70, 20, 75) to hTWin
txt.color = %rgb_green
txt.print "At any wait use any key to continue. (like now :) )"$$
txt.waitkey$
'
txt.color = %rgb_blue
txt.print "A dual PIN entry with number of digits set to 4. "$$;
txt.color = %rgb_black
txt.print "Returned PIN is: "$$ + dec$(PIN_Enter(hTWin, 1, 4), 4)"."$$
txt.color = %rgb_green
txt.print
txt.print "Any key to continue."
txt.waitkey$
'
txt.color = %rgb_blue
txt.print "A single PIN entry with number of digits set to 4. "$$;
txt.color = %rgb_black
txt.print "Returned PIN is: "$$ + dec$(PIN_Enter(hTWin, 0, 4), 4)"."$$
txt.print
txt.color = %rgb_green
txt.print """ESC"" to end demo, any other key to continue with next."
Rspnc = txt.waitkey$
if Rspnc = $$esc then exit function
'
txt.color = %rgb_blue
txt.print "Number of PIN digits set to 9. "$$;
txt.color = %rgb_black
txt.print "Returned PIN is: "$$ + dec$(PIN_Enter(hTWin, 0, 9), 9)"."$$
txt.color = %rgb_blue
txt.print "You had to enter 9 digits, or ""Cancel PIN"" to get here."$$
txt.print
txt.color = %rgb_green
txt.print """ESC"" to end demo, any other key to continue with next."
Rspnc = txt.waitkey$
if Rspnc = $$esc then exit function
txt.color = %rgb_blue
txt.print "Number of PIN digits set to 0 (user preference). "$$
txt.print "Looks like previous, but 4 to 9 digits allowed."$$;
txt.print "Returned PIN is: "$$ + dec$(PIN_Enter(hTWin, 0, 0), 9)"."$$
'
'---------------------------------------------------------------------
txt.color = %rgb_green
txt.print
txt.print "Any key will close."$$
txt.waitkey$
end function
|
|
|
|
|
