Post by wexhammer on Jan 11, 2020 9:46:49 GMT -5
Hello again... How would i hide the date control in my code, im getting syntax error.
[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$, AllGrandTotal,h1
Nomainwin
Dim name$(1000), nameSearch$(1000), stage$(20), type$(20)
Dim builder$(1000, 13), existInfo$(10,10), hContents$(20)
If Not(exists("filter.lst")) Then
Open "filter.lst" For Output As #filter
Print #filter, 4
Print #filter, "All"
Print #filter, "JAN"
Print #filter, "FEB"
Print #filter, "MARCH"
Close #filter
End If
Open "filter.lst" For Input As #filter
Input #filter, filterCount
For filterIndex=0 to filterCount-1
Input #filter, filterName$
stage$(filterIndex)=filterName$
Next filterIndex
Close #filter
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, "Names", 10, 10, 60, 20
Listbox #main.contacts, name$(, modifyRecord, 10, 35, 160, 120
Statictext #main, "Filter stage", 10, 170, 160, 20
Combobox #main.filterstage, stage$(, loadNamesFiltered, 10, 190, 160, 120
'Statictext #main, "Filter type", 10, 220, 160, 20
'Combobox #main.filtertype, type$(, loadNamesFiltered, 10, 240, 160, 120
Statictext #main, "Name", 195, 10, 50, 20
Textbox #main.name, 250, 10, 225, 25
Statictext #main, "Number", 195, 40, 50, 20
Textbox #main.number, 250, 40, 225, 25
Statictext #main, "Stage", 195, 70, 50, 20
Combobox #main.stage, stage$(, [inputLoop], 250, 70, 225, 110
'Statictext #main, "Type", 195, 100, 50, 20
' Combobox #main.type, type$(, [inputLoop], 250, 100, 225, 110
statictext #main, "Total of numbers:", 10, 215,90, 15
statictext #main, "JAN", 10, 235,90, 15
statictext #main, "FEB", 10, 265,90, 15
statictext #main, "MARCH", 10, 305,90, 15
Textbox #main.jantotal, 100, 235, 170, 25
Textbox #main.febtotal, 100, 265, 170, 25
Textbox #main.marchtotal, 100, 305, 170, 25
Button #main.new, "Calc", [calculate], UL, 270, 235, 40, 20
Button #main.adddate, "+", [adddate], UL, 400, 95, 40, 20
Button #main.new, "&New", addRecord, UL, 365, 120
Listbox #main.namel, dup$(, pick, 490, 10, 190, 395
Button #main.OK, "Save", acceptEntry, UL, 420, 120
Open "Test" For Window As #main
Print #main, "Trapclose endProgram"
'Print #main.filtertype, "Select All";
Print #main.filterstage, "Select All";
Print #main.contacts, "SingleClickSelect"
Print #main.namel, "SingleClickSelect"
hMain=hwnd(#main)
h1 = hWnd(#main)
hInst=InstanceHandle(h1)
hwndDTP=CreateDateControl(h1,hInst,250,95,21,20)
hwndDTP=CreateDateControl("!hide")
[Code]
Print #main.contacts, "Setfocus"
[inputLoop]
Wait
[acceptEntry]
Call acceptEntry handle$
Wait
[addRecord]
Call addRecord handle$
Wait
[adddate]
'thedate$=GetWindowText$(hwndDTP)
thedate$=GetMonth$(hwndDTP)
print #main.stage, "!";thedate$;""
Print #main.stage, "select "; thedate$
wait
[calculate]
filterName$ = "JAN"
filterName2$ = "FEB"
'Print #main.filterstage, "selection? filterName$"
GrandTotal=0 : AllGrandTotal=0
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
'gettrim #contacts, number
For index = 2 To contactCount + 1
Gettrim #contacts, index
' SELECT CASE filterName$
' case "All","JAN","FEB","MARCH"
if filterName$ = stage$ then
GrandTotal=GrandTotal+VAL(number$)
end if
' case else
'end select
AllGrandTotal=AllGrandTotal+VAL(number$)
next
If filterName$ <> "All" then
print #main.marchtotal, "grand Total for "; filterName$ ;" is : ";GrandTotal
end if
For index = 2 To contactCount + 1
Gettrim #contacts, index
' SELECT CASE filterName$
' case "All","JAN","FEB","MARCH"
if filterName2$ = stage$ then
GrandTotal2=GrandTotal2+VAL(number$)
end if
' case else
'end select
AllGrandTotal2=AllGrandTotal2+VAL(number$)
next
If filterName2$ <> "All" then
print #main.febtotal, "grand Total for "; filterName2$ ;" is : ";GrandTotal2
end if
close #contacts
'(4) we got the total, show it
'print #main.totalofall, GrandTotal
'that's all, really
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 = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Open "contact4.bak" For Random As #contactsCopy Len = 110
Field #contactsCopy, 35 As name$, 35 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(name$)
If contactCount = 0 Then
Close #contacts
Close #contactsCopy
Goto [skipIt]
End If
For index = 2 To contactCount + 1
Gettrim #contacts, index
Put #contactsCopy, index
name$(index - 1) = str$(index-1)+") "+name$
Next index
Close #contacts
Close #contactsCopy
[skipIt]
End Sub
Sub initializeNames
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
name$ = "0"
Put #contacts, 1
Close #contacts
End Sub
Sub loadNamesFiltered handle$
redim name$(1000)
'show records matching filter
Call addRecord handle$
Print #main.filterstage, "selection? filter$"
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Get #contacts, 1
contactCount = Val(name$)
If contactCount = 0 Then
Close #contacts
Goto [moveOn]
End If
'compare stage to filter
For index = 2 To contactCount + 1
Gettrim #contacts, index
If filter$ = stage$ or filter$ = "All" Then
'If filter2$ = type$ or filter2$ = "All" Then
name$(index - 1) = str$(index-1)+") "+name$
Else
name$(index - 1) = ""
end if
Next index
Close #contacts
Print #main.contacts, "Reload"
[moveOn]
End Sub
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$)
[getContactRecord]
getIndex=recordIndex+1
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Gettrim #contacts, getIndex
Close #contacts
Print #main.name, name$
Print #main.number, number$
Print #main.stage, "SelectIndex 20"
'Print #main.type, "SelectIndex 20"
For stageIndex = 0 To filterCount-1
If stage$(stageIndex) = stage$ Then
Print #main.stage, "SelectIndex "; stageIndex + 1
end if
Next stageIndex
oldStage$=stage$
[noName]
End Sub
Sub addRecord handle$
addName = 1
Print #main.contacts, "SelectIndex 0"
Print #main.name, ""
Print #main.number, ""
Print #main.stage, "SelectIndex 20"
' Print #main.type, "SelectIndex 20"
Print #main.name, "!SetFocus"
End Sub
Sub acceptEntry handle$
Print #main.name, "!contents? name$";
If name$<>"" Then
Print #main.name, "!contents? number$";
Print #main.number, "!contents? number$";
'Print #main.type, "Selection? type$";
Print #main.stage, "Selection? stage$";
If addName = 1 Then
contactCount = contactCount + 1
recordIndex = contactCount
End If
name$(recordIndex) = Str$(recordIndex)+") "+name$
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 = 110
Field #contacts, 35 As name$, 35 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 = 110
Field #contacts, 35 As count$, 75 As fill$
count$ = Str$(contactCount)
Put #contacts, 1
Close #contacts
addName = 0
Call loadNamesFiltered " "
[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 = 110
Field #contacts3, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Open "contact.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Get #contacts3, 1
contactCount = Val(name$)
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)=name$
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
name$=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)_
+name$(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 = 110
Field #contacts, 35 As name$, 35 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
name$(Val(name$))=""
name$=Str$(Val(name$)-1)
Put #contacts, 1
Close #contacts
Close #patience
Call loadNames
Call loadNamesFiltered handle$
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.wDay.struct=day
SYSTEMTIME.wMonth.struct=month
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
