Post by wexhammer on Jan 7, 2020 12:46:52 GMT -5
I have embedded a date picker within my program. When i select a date i can click the add button next to the picker and it will display the date in my date textfield. When i press save, the date gets saved.
What i am trying to figure out is how can i get that saved date to show within the date picker when clicking on one of the saved dates. The [getdaterecord] routine is were the error is. Any ideas anyone?
What i am trying to figure out is how can i get that saved date to show within the date picker when clicking on one of the saved dates. The [getdaterecord] routine is were the error is. Any ideas anyone?
[Initialize]
DTS.UPDOWN = 1 'shows updown arrows, no calendar
DTS.RIGHTALIGN = 32 'aligns calendar with right side of control
DTS.SHORTDATEFORMAT = 0 'default short date format: 9/22/02
DTS.LONGDATEFORMAT = 4 'long date format: Sunday, September 22, 2002
DTS.SHORTDATECENTURYFORMAT = 12 ' 9/22/2002
DTS.APPCANPARSE = 16 'double-clicking highlights entire date
'default-click highlights only one part of date
DTM.GETSYSTEMTIME = 4097'message flag to retrieve date/time chosen
DTM.FIRST = 4096 'first date/time message reserved number
DTM.SETMCCOLOR=4102 'message flag to set calendar background color
DTM.SETMCCOLOR=DTM.FIRST+6 'numbers are often expressed this way
DTM.SETSYSTEMTIME = 4098'message flag to set date/time displayed on control
MCSC.BACKGROUND = 0 'Set the background color displayed between months.
MCSC.TEXT = 1 'Set the color used to display Text within a month.
MCSC.TITLEBK = 2 'Set the background color displayed in the calendar's title.
MCSC.TITLETEXT = 3 'Set the color used to display Text within the calendar's title.
MCSC.MONTHBK=4 'Set the background color displayed within the month.
MCSC.TRAILINGTEXT = 5 'Set the color used to display header day and trailing day text.
'Header and trailing days are the days from the previous and
'following months that appear on the current month calendar.
Struct SYSTEMTIME, _'struct to hold date time info to interact with control
wYear As word, _
wMonth As word, _
wDayOfWeek As word, _ '0 = Sunday, 1 = Monday, etc.
wDay As word, _
wHour As word, _
wMinute As word, _
wSecond As word, _
wMilliseconds As word
Global hMain, hFind, dupNum, dupo, addName, recordIndex, contactCount
Global filterCount, oldStage$
Nomainwin
Dim saveddate$(1000), nameSearch$(1000), stage$(20), type$(20)
Dim builder$(1000, 13), existInfo$(10,10), hContents$(20)
dupo=0
addName=1
Call loadNames
[GUI]
struct icex, _
dwSize As ulong, _
dwICC As ulong
icex.dwSize.struct = Len(icex.struct)
icex.dwICC.struct = Hexdec("100") 'ICC_DATE_CLASSES
CallDLL #comctl32, "InitCommonControlsEx", _
icex As struct, r As long
Stylebits #main, 0,_WS_MAXIMIZEBOX,0,0
WindowWidth = 495 '595 695 795
WindowHeight = 460
UpperLeftX=Int((DisplayWidth-WindowWidth)/2)
UpperLeftY=Int((DisplayHeight-WindowHeight)/2)
Statictext #main, "Dates", 10, 10, 60, 20
Listbox #main.contacts, saveddate$(, modifyRecord, 10, 35, 140, 120
Statictext #main, "Date", 195, 10, 50, 20
Textbox #main.date, 250, 10, 160, 25
Statictext #main.3, "Spare", 195, 40, 50, 20
Textbox #main.spare, 250, 40, 160, 25
button #main.adddate, "Add Date", [adddate], UL, 400, 80, 60, 20
Button #main.new, "&New", addRecord, UL, 10, 360
Listbox #main.datel, dup$(, pick, 490, 10, 190, 395
Button #main.OK, "Save", acceptEntry, UL, 370, 360
Open "Test" For Window As #main
Print #main, "Trapclose endProgram"
Print #main.contacts, "SingleClickSelect"
Print #main.datel, "SingleClickSelect"
hMain=hwnd(#main)
h1 = hWnd(#main)
hInst=InstanceHandle(h1)
hwndDTP=CreateDateControl(h1,hInst,250,80,140,20)
'r=SetDate(hwndDTP,2003,2,14)
'r=SetDate(hwndDTP,2003,2,14)
[Code]
Print #main.contacts, "Setfocus"
[inputLoop]
Wait
[adddate]
thedate$=GetWindowText$(hwndDTP)
thedate$=GetDate$(hwndDTP)
print #main.date, thedate$
wait
[acceptEntry]
Call acceptEntry handle$
Wait
[addRecord]
Call addRecord handle$
Wait
[endProgram]
Call endProgram handle$
Wait
Sub endProgram handle$
close #main
end
End Sub
Sub loadNames
If exists("contact4old.bak") Then
Kill "contact4old.bak"
End If
If exists("contact4.bak") Then
Name "contact4.bak" As "contact4old.bak"
End If
Open "contact4.dat" For Random As #contacts Len = 710
Field #contacts, 335 As saveddate$, 335 As number$, 20 As stage$, 20 As type$
Open "contact4.bak" For Random As #contactsCopy Len = 710
Field #contactsCopy, 335 As saveddate$, 335 As number$, 20 As stage$, 20 As type$
If Eof(#contacts) <> 0 Then
Close #contacts
Close #contactsCopy
Call initializeNames
Goto [skipIt]
End If
Get #contacts, 1
Put #contactsCopy, 1
contactCount = Val(saveddate$)
If contactCount = 0 Then
Close #contacts
Close #contactsCopy
Goto [skipIt]
End If
For index = 2 To contactCount + 1
Gettrim #contacts, index
Put #contactsCopy, index
saveddate$(index - 1) = str$(index-1)+") "+saveddate$
Next index
Close #contacts
Close #contactsCopy
[skipIt]
End Sub
Sub initializeNames
Open "contact4.dat" For Random As #contacts Len = 710
Field #contacts, 335 As saveddate$, 335 As number$, 20 As stage$, 20 As type$
saveddate$ = "0"
Put #contacts, 1
Close #contacts
End Sub
[moveOn]
Sub modifyRecord handle$
addName = 0
Print #main.contacts, "Selection? selection$"
If selection$ = "" Then [noName]
Print #main.contacts, "SelectionIndex? index"
If index = 0 Then [noName] 'This should never need to happen
recordIndex=val(selection$)
[getDateRecord]
getIndex=recordIndex+1
Open "contact4.dat" For Random As #contacts Len = 710
Field #contacts, 335 As saveddate$, 335 As number$, 20 As stage$, 20 As type$
Gettrim #contacts, getIndex
Close #contacts
Print #main.date, saveddate$
Print #main.spare, number$
r=SetDate(hwndDTP,savedate$)
oldStage$=stage$
[noName]
End Sub
Sub addRecord handle$
addName = 1
Print #main.contacts, "SelectIndex 0"
Print #main.date, ""
Print #main.spare, ""
Print #main.date, "!SetFocus"
End Sub
Sub acceptEntry handle$
Print #main.date, "!contents? saveddate$";
If saveddate$<>"" Then
Print #main.spare, "!contents? number$";
If addName = 1 Then
contactCount = contactCount + 1
recordIndex = contactCount
End If
saveddate$(recordIndex) = Str$(recordIndex)+") "+saveddate$
Print #main.contacts, "Reload"
date$=Date$()
If oldStage$="Opening Mailer" And stage$="Follow Up Call" then
mailDate$=Date$()
End If
[saveContactRecord]
Open "contact4.dat" For Random As #contacts Len = 710
Field #contacts, 335 As saveddate$, 335 As number$, 20 As stage$, 20 As type$
Put #contacts, recordIndex + 1
Close #contacts
If addName = 0 Then [goBack]
Open "contact4.dat" For Random As #contacts Len = 710
Field #contacts, 35 As count$, 675 As fill$
count$ = Str$(contactCount)
Put #contacts, 1
Close #contacts
addName = 0
[goBack]
Print #main.contacts, "SelectIndex ";recordIndex
Call addRecord handle$
Else
Notice "NO BUSINESS NAME"+Chr$(13)+"The business name must be entered, "_
+Chr$(13)+"before a record can be saved. "
End If
End Sub
Sub populateList
Open "contact4.dat" For random As #contacts3 Len = 710
Field #contacts3, 335 As saveddate$, 335 As number$, 20 As stage$, 20 As type$
Open "contact.dat" For Random As #contacts Len = 710
Field #contacts, 335 As saveddate$, 335 As number$, 20 As stage$, 20 As type$
Get #contacts3, 1
contactCount = Val(saveddate$)
Put #contacts, 1
For index2 = 2 To contactCount + 1
Gettrim #contacts3, index2
For column=1 To 4
Select Case column
Case 1
builder$(index2, column)=saveddate$
Case 2
builder$(index2, column)=number$
Case 3
builder$(index2, column)=stage$
Case 4
builder$(index2, column)=type$
End Select
Next column
Next index2
End Sub
Sub saveList
For index2 = 2 To contactCount + 1
For column=1 To 4
Select Case column
Case 1
saveddate$=builder$(index2, column)
Case 2
number$=builder$(index2, column)
Case 3
stage$=builder$(index2, column)
Case 4
type$=builder$(index2, column)
End Select
Next column
Put #contacts, index2
Next index2
Close #contacts3
Close #contacts
If exists("contact4recoverold.bak") Then
Kill "contact4recoverold.bak"
End If
If exists("contact4recover.bak") Then
Name "contact4recover.bak" As "contact4recoverold.bak"
End If
Name "contact4.dat" As "contact4recover.bak"
Name "contact.dat" As "contact4.dat"
End Sub
Function exists(a$)
Files DefaultDir$, a$, existInfo$()
exists=val(existInfo$(0,0))
End Function
Sub removeEntry
Print #main.filtertype, "selection? filter$"
If addName=0 Then
Confirm "YOU ARE ABOUT TO DELETE THIS RECORD"+Chr$(13)+" "+Chr$(13)+Chr$(34)_
+saveddate$(recordIndex)+Chr$(34)+Chr$(13)+" "+Chr$(13)+"Do you want to proceed?";delAns$
If Lower$(delAns$)="no" Then [noDelete]
WindowWidth=150
WindowHeight=75
StaticText #patience, "PLEASE WAIT...", 10, 15, 100, 25
Open "DELETING...", For Dialog_Modal As #patience
Open "contact4.dat" For Random As #contacts Len = 710
Field #contacts, 335 As saveddate$, 335 As number$, 20 As stage$, 20 As type$
For moveRecords=recordIndex+1 To contactCount
Get #contacts, moveRecords+1
Put #contacts, moveRecords
Next moveRecords
Get #contacts, 1
saveddate$(Val(saveddate$))=""
saveddate$=Str$(Val(saveddate$)-1)
Put #contacts, 1
Close #contacts
Close #patience
Call loadNames
Notice "RECORD DELETED"+Chr$(13)+"Names reloaded"
Else
Notice "NO RECORD SELECTED!"+Chr$(13)+"Please select a record," _
+Chr$(13)+"then select delete from the menu."
End If
[noDelete]
End Sub
Function InstanceHandle(hW)
CallDLL #user32, "GetWindowLongA", _
hW As ulong, _GWL_HINSTANCE As long, _
InstanceHandle As long
End Function
Function CreateDateControl(hW,hInstance,x,y,w,h)
DTS.SHORTDATECENTURYFORMAT = 12
style = _WS_VISIBLE Or _WS_CHILD Or DTS.SHORTDATECENTURYFORMAT
CallDLL #user32, "CreateWindowExA", _
0 As long,_ 'extended style
"SysDateTimePick32" As ptr, _ 'class
"DateTime" As ptr, _ 'name
style As long,_ 'window style flags
x As long, y As long,_ 'upper left x,y
w As long, h As long,_ 'width and height
hW As ulong,_ 'parent window handle
0 As long,_ 'menu handle
hInstance As long,_ 'instance handle of parent
0 As long, _ 'not used here - extra data
CreateDateControl As ulong 'handle of created control
End Function
Function GetWindowText$(hW)
a=GetWindowTextLength(hW)
Title$=Space$(a)+Chr$(0)
l=Len(Title$)
CallDLL #user32, "GetWindowTextA", hW As ulong,_
Title$ As ptr, l As long, result As long
GetWindowText$=Trim$(Title$)
End Function
Function GetWindowTextLength(hW)
CallDLL #user32, "GetWindowTextLengthA",_
hW As ulong, GetWindowTextLength As long
End Function
Sub SetBGColor hW, col
DTM.SETMCCOLOR=4102 'message flag to set calendar color
MCSC.MONTHBK=4 'color to change=month background
CallDLL #user32, "SendMessageA",_
hW As ulong, _ 'handle of control
DTM.SETMCCOLOR As long,_ 'set color message
MCSC.MONTHBK As long,_ 'part of control to set color on
col As long,_ 'color desired
re As long
End Sub
Function GetDate$(hW)
DTM.GETSYSTEMTIME = 4097
CallDLL #user32, "SendMessageA", _
hW As ulong, _ 'handle of control
DTM.GETSYSTEMTIME As long,_ 'flag to get chosen date/time
0 As long, _ 'wparam=0
SYSTEMTIME As struct,_ 'name of struct
ret As long
GetDate$=SYSTEMTIME.wMonth.struct;"/";_
SYSTEMTIME.wDay.struct;"/";_
SYSTEMTIME.wYear.struct
End Function
Function GetMonth$(hW)
DTM.GETSYSTEMTIME = 4097
CallDLL #user32, "SendMessageA", _
hW As ulong, _ 'handle of control
DTM.GETSYSTEMTIME As long,_ 'flag to get chosen date/time
0 As long, _ 'wparam=0
SYSTEMTIME As struct,_ 'name of struct
ret As long
mon=SYSTEMTIME.wMonth.struct
m$="JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC"
GetMonth$=word$(m$,mon)
End Function
Function SetDate(hW,year,month,day)
DTM.SETSYSTEMTIME = 4098
SYSTEMTIME.wMonth.struct=month
SYSTEMTIME.wDay.struct=day
SYSTEMTIME.wYear.struct=year
CallDLL #user32, "SendMessageA", _
hW As ulong, _ 'handle of control
DTM.SETSYSTEMTIME As long,_ 'flag to set chosen date/time
0 As long, _ 'wparam=0
SYSTEMTIME As struct,_ 'name of struct
SetDate As long
End Function