... Type content here!
#compile exe
#dim all
%UNICODE = 1
%test_dialog = -1
#if %test_dialog
#resource icon, 101, "./bBaseW32.ico"
#resource icon, 103, "./../Question48.ico"
#include once "Win32API.inc"
#include "./bBaseW_Text_IDs.inc"
global gpGetLText, gpGetFieldTypeList, ghFixedFont as dword
function pbmain () as long
local hLangText, hStdFont as dword
local init as quad
import addr "GetCtlText","xBaseW_EN.dll" to gpGetLText, hLangText
import addr "GetFieldTypeList", "xBaseW_EN.dll" to gpGetFieldTypeList
dialog default font "Microsoft Sans Serif", 12, 0, 1
font new "Lucida Console", 12, 0, 1 to ghFixedFont
AutoIncInit(0, init)
? dec$(init)
import close hLangText
end function
#endif
'=========================================================================
declare function GetLText (byval W_ID as long) as wstring
declare sub GetFieldTypeList(byref List() as wstring)
%dym_pQd = %wm_user + 500
%ID_AutoIncInitLbl = 1001
%ID_ExitBtn = 1002
%ID_AcceptBtn = 1003
%ID_AbandonBtn = 1000
'CB active
%ID_AutoIncInitLbl2 = 1004
%ID_AutoIncInitTxtBx = 1005
%ID_AutoIncInitLbl1 = 1006
callback function AtoIncInitDlgCB() as long
local TmpStr, TmpStr2 as wstring
local TmpLng as long
static pQd as quad pointer
if cb.msg = %wm_command then
select case as long cb.ctl
case %ID_ExitBtn
dialog end cb.hndl
case %ID_AcceptBtn
control get text cb.hndl, %ID_AutoIncInitTxtBx to TmpStr
TmpLng = verify(TmpStr, "-0123456789"$$)
if TmpLng then
call dword gpGetLText using GetLText(%BadCharMBmsg) to TmpStr
call dword gpGetLText using GetLText(%ErrorMBTtl) to TmpStr2
beep
TmpStr += dec$(TmpLng, 0, 1, 0) + "."
msgbox TmpStr, %mb_ok or %mb_iconerror or %mb_taskmodal, TmpStr2
exit function
end if
control get text cb.hndl, %ID_AutoIncInitTxtBx to TmpStr
@pQd = val(TmpStr)
dialog end cb.hndl
'set quad
case %ID_AbandonBtn
dialog end cb.hndl
end select
elseif cb.msg = %dym_pQd then ' once at show of this dialog
pQd = cb.wparam ' is pointer to result quad
end if
end function
'-----------------------------------------------------------------------------
'Get Auto-Increment Initial (starting) number
function AutoIncInit(byval hParent as dword, _
byref AutoIncInitVal as quad) as long
local hAutoIncInitDlg as dword
local CtlText as wstring
local Parent_X, Parent_Y as long
'
dialog get loc hParent to Parent_X, Parent_Y
call dword gpGetLText using GetLText(%AutoIncInitTtl) to CtlText
dialog new hParent, CtlText, Parent_X + 10, Parent_Y + 10, 160, 124 _
to hAutoIncInitDlg
' - instruction label - - - - - - - - - - - - - - - - - - -
call dword gpGetLText using GetLText(%AutoIncInitLbl) to CtlText
control add label, hAutoIncInitDlg, %ID_AutoIncInitLbl, CtlText, 5, 5, 150, 58
' - number characters only label - - - - - - - - - - - - - - -
call dword gpGetLText using GetLText(%AutoIncInitLbl1) to CtlText
control add label, hAutoIncInitDlg, %ID_AutoIncInitLbl1, CtlText, 5, 63, 150, 10
' - label for nunber textbox - - - - - - - - - - - - - - - - -
call dword gpGetLText using GetLText(%AutoIncInitLbl2) to CtlText
control add label, hAutoIncInitDlg, %ID_AutoIncInitLbl2, CtlText, 5, 78, 100, 10
' - number textbox - - - - - - - - - - - - - - - - - - - -
control add textbox, hAutoIncInitDlg, %ID_AutoIncInitTxtBx, "1", 5 ,88, 85, 11, _
%es_autohscroll or %es_right or %ws_tabstop or %es_multiline, _
%ws_ex_clientedge or %ws_ex_left
' - accept button - - - - - - - - - - - - - - - - - - - -
call dword gpGetLText using GetLText(%AcceptBtnTop) to CtlText
control add button, hAutoIncInitDlg, %ID_AcceptBtn, CtlText, 11 ,104, 60, 15
control set focus hAutoIncInitDlg, %ID_AcceptBtn
' - abandon button - - - - - - - - - - - - - - - - - - - -
call dword gpGetLText using GetLText(%AbandonBtnTop) to CtlText
control add button, hAutoIncInitDlg, %ID_AbandonBtn, CtlText, 92, 104, 58, 11
' - pointer for result to callback and show the dialog - - - - - - - - - -
dialog post hAutoIncInitDlg,%dym_pQd, varptr(AutoIncInitVal), 0
dialog show modal hAutoIncInitDlg call AtoIncInitDlgCB
end function
'
Created on August 29, 2023