PureBasic Forums - English

Posted: **Fri Mar 08, 2019 5:15 pm**

Nice

Oh... I saw you have a calendar and you work with Date. So... How do you solve the "before 1970" problem?

I use this:

DeclareModule DateQ
	Declare.q DateQ(Year = 0, Month = 1, Day = 1, Hour = 0, Minute = 0, Second = 0)
	Declare.q TodayQ()
	Declare.q OnlyDateQ(date.q)
	Declare YearQ(DateQ.q)
	Declare ThisYearQ()
	Declare MonthQ(DateQ.q)
	Declare DayQ(DateQ.q)
	Declare HourQ(DateQ.q)
	Declare MinuteQ(DateQ.q)
	Declare SecondQ(DateQ.q)
	Declare DayOfYearQ(DateQ.q)
	Declare DayOfWeekQ(DateQ.q)
	Declare.s FormatDateQ(Mask.s, DateQ.q)
	Declare.s FormatDateQFromString(FromMask.s,ToMask.s, string.s)
	Declare.q ParseDateQ(Mask.s, Date.s)
	Declare ISOWeekQ(dats.q)
	Declare.q AddDateQ(Date.q, Field.b, Offset.q)
	Declare.s getNN(index)
	Declare pDayInMonth(year, month)
	Declare.b sameDate(date1.q,date2.q)
	Declare.q getGadgetStateQ(gadget)
	Declare setGadgetStateQ(gadget,date.q)
	Declare.q getGadgetStateOnlyQ(gadget)
	Declare setGadgetStateOnlyQ(gadget,date.q)
	
	Declare mergeDateQ(date.q,time.q)
	Declare mergeDate2Q(date.q,time.q)
	
	Declare.d toDouble(date.q)
	
	#DATEQ_FORMAT_TIMESTAMP="%yyyy-%mm-%dd %hh:%ii:%ss"
	#DATEQ_FORMAT_DATETIME="%dd.%mm.%yyyy %hh:%ii:%ss"
	#DATEQ_FORMAT_DATE="%dd.%mm.%yyyy"
	#DATEQ_FORMAT_SQLDATE="%yyyy-%mm-%dd"
	#DATEQ_FORMAT_TIME="%hh:%ii:%ss"
	#DATEQ_FORMAT_SHORT_TIME="%hh:%ii"
	#DATEQ_FORMAT_SHORT_DATETIME="%dd.%mm.%yyyy %hh:%ii"
	
	Declare.s makeDateTime(date.q)
	
EndDeclareModule

Module DateQ
	EnableExplicit
	
	#CONST_MLT	=	28
	#CONST_TEN	= 10
	#CONST_ST		= #CONST_MLT * 2 + ( #CONST_MLT / 2 )
	#CONST_DAY	=	24 * 60 * 60
	#CONST_LJAHR=	#CONST_DAY * #CONST_MLT * 365 + ( #CONST_DAY * #CONST_MLT / 4 )
	#CONST_JAHR	=	#CONST_LJAHR * #CONST_TEN
	
	Procedure.s makeDateTime(date.q)
		ProcedureReturn FormatDateQ(#DATEQ_FORMAT_DATETIME,date)
	EndProcedure
	
	Procedure.d toDouble(date.q)
		Protected result.d=0
		If date
			result=HourQ(date)
			result+MinuteQ(date)/60
			result+(DayOfYearQ(date)-1)*24
		EndIf
		ProcedureReturn result
	EndProcedure
	
	Procedure mergeDateQ(date.q,time.q)
		ProcedureReturn DateQ(YearQ(date),MonthQ(date),DayQ(date),Hourq(time),Minuteq(time),SecondQ(time))
	EndProcedure
	
	Procedure mergeDate2Q(date.q,time.q)
		ProcedureReturn DateQ(YearQ(date),MonthQ(date),DayQ(date),Hourq(time),Minuteq(time),0)
	EndProcedure
	
	Procedure.q OnlyDateQ(date.q)
		If date
			ProcedureReturn DateQ(YearQ(date),MonthQ(date),DayQ(date))
		Else
			ProcedureReturn date
		EndIf
	EndProcedure
	
	Procedure.b sameDate(date1.q,date2.q)
		ProcedureReturn Bool(YearQ(date1)=YearQ(date2) And MonthQ(date1)=MonthQ(date2) And DayQ(date1)=DayQ(date2))
	EndProcedure
	
	Procedure.q DateQ(Year = 0, Month = 1, Day = 1, Hour = 0, Minute = 0, Second = 0)
		Protected result.q
		Select Year
			Case 0
				result = Date()
			Case 1970 To 2099
				result=Date(year,month,day,hour,Minute,Second)
			Case 1 To 1970,2099 To 3000
				result = (Year - #CONST_TEN) / #CONST_MLT - #CONST_ST
				result = Date(Year - result * #CONST_MLT, Month, Day, Hour, Minute, Second) + result * #CONST_LJAHR
			Default
				result = -1
		EndSelect
		ProcedureReturn result
	EndProcedure
	
	Procedure.q TodayQ()
		ProcedureReturn OnlyDateQ(DateQ())
	EndProcedure
	
	Procedure YearQ(DateQ.q)
		Protected Year.q = DateQ + #CONST_JAHR
		DateQ = Year % #CONST_LJAHR
		ProcedureReturn Year(DateQ) + (Year / #CONST_LJAHR) * #CONST_MLT - ( #CONST_MLT * #CONST_TEN )
	EndProcedure
	
	Procedure ThisYearQ()
		ProcedureReturn YearQ(DateQ())
	EndProcedure
	
	Procedure MonthQ(DateQ.q)
		ProcedureReturn Month((DateQ + #CONST_JAHR) % #CONST_LJAHR)
	EndProcedure
	
	Procedure DayQ(DateQ.q)
		ProcedureReturn Day((DateQ + #CONST_JAHR) % #CONST_LJAHR)
	EndProcedure 
	
	Procedure HourQ(DateQ.q)
		ProcedureReturn Hour((DateQ + #CONST_JAHR) % #CONST_LJAHR)
	EndProcedure 
	
	Procedure MinuteQ(DateQ.q)
		ProcedureReturn Minute((DateQ + #CONST_JAHR) % #CONST_LJAHR)
	EndProcedure
	
	Procedure SecondQ(DateQ.q)
		ProcedureReturn Second((DateQ + #CONST_JAHR) % #CONST_LJAHR)
	EndProcedure
	
	Procedure DayOfWeekQ(DateQ.q)
		ProcedureReturn DayOfWeek((DateQ + #CONST_JAHR) % #CONST_LJAHR)
	EndProcedure
	
	Procedure DayOfYearQ(DateQ.q)
		ProcedureReturn DayOfYear((DateQ + #CONST_JAHR) % #CONST_LJAHR)
	EndProcedure
	
	
	Procedure.q ParseDateQ(Mask.s,Date.s)
		Protected d.q= 0
		
		Protected t.s=Mask
		
		
		Protected iyear=0
		Protected imonth=0
		Protected iday=0
		Protected ihour=0
		Protected iminute=0
		Protected isecond=0
		
		Protected idx=FindString(t,"%")
		While idx
			Select Mid(t,idx,3)
				Case "%yy"
					iyear=Val(Mid(date,idx,4))
					t=ReplaceString(t,"%yyyy","yyyy")
				Case "%mm"
					imonth=Val(Mid(date,idx,2))
					t=ReplaceString(t,"%mm","mm")
				Case "%dd"
					iday=Val(Mid(date,idx,2))
					t=ReplaceString(t,"%dd","dd")
				Case "%hh"
					ihour=Val(Mid(date,idx,2))
					t=ReplaceString(t,"%hh","hh")
				Case "%ii"
					iminute=Val(Mid(date,idx,2))
					t=ReplaceString(t,"%ii","ii")
				Case "%ss"
					isecond=Val(Mid(date,idx,2))
					t=ReplaceString(t,"%ss","ss")
				Default
					Break
			EndSelect
			idx=FindString(t,"%")
		Wend
		
		If iyear Or imonth Or iday Or ihour Or iminute Or isecond
			d=DateQ(iyear,imonth,iday,ihour,iminute,isecond)
		EndIf
		
		
		
		ProcedureReturn d
	EndProcedure
	
	Procedure.s FormatDateQ(Mask.s, DateQ.q)
		If DateQ And dateq<>-1
			
			Protected Year.q = DateQ + #CONST_JAHR
			DateQ = Year % #CONST_LJAHR
			Year.q = Year(DateQ) + (Year / #CONST_LJAHR) * #CONST_MLT - ( #CONST_MLT * #CONST_TEN )
			Mask = ReplaceString(Mask, "%yyyy", Str(Year), #PB_String_NoCase)
			Mask = ReplaceString(Mask, "%yy", Right(Str(Year), 2), #PB_String_NoCase)
			Protected i
			Dim tt.s(6)
			Dim wt.s(6)
			
			Dim nn.s(12)
			Dim wn.s(12)
			Restore tt
			For i=1 To 7
				Read.s tt(i-1)
			Next
			Restore wt
			For i=1 To 7
				Read.s wt(i-1)
			Next
			Restore nn
			For i=1 To 12
				Read.s nn(i)
			Next
			Restore wn
			For i=1 To 12
				Read.s wn(i)
			Next
			Mask = ReplaceString(Mask, "%TT", tt(DayOfWeekQ(dateq)), #PB_String_NoCase)
			Mask = ReplaceString(Mask, "%WT", wt(DayOfWeekQ(dateq)), #PB_String_NoCase)
			Mask = ReplaceString(Mask, "%NN", nn(Monthq(dateq)), #PB_String_NoCase)
			Mask = ReplaceString(Mask, "%WN", wn(Monthq(dateq)), #PB_String_NoCase)
			ProcedureReturn FormatDate(Mask, DateQ)
		Else
			ProcedureReturn ""
		EndIf
	EndProcedure
	
	Procedure.s FormatDateQFromString(FromMask.s,ToMask.s, string.s)
		Protected date.q=ParseDateQ(FromMask,string)
		
		ProcedureReturn FormatDateQ(ToMask,date)
	EndProcedure
	
	Procedure.s getNN(index)
		Dim nn.s(12)
		Protected i
		Restore nn
		For i=1 To 12
			Read.s nn(i)
		Next
		ProcedureReturn nn(index)
	EndProcedure
	
	CompilerIf #PB_Compiler_Processor=#PB_Processor_JavaScript Or #PB_Compiler_OS <> #PB_OS_Windows
		Procedure setGadgetStateQ(dategadget.i,datum.q)
			SetGadgetState(dategadget,datum)
		EndProcedure
		Procedure.q getGadgetStateQ(dategadget.i)
			ProcedureReturn GetGadgetState(dategadget)
		EndProcedure
	CompilerElse
		Procedure setGadgetStateQ(dategadget.i,datum.q)
			If datum And datum<>-1
				Protected *NewDate.SYSTEMTIME=AllocateStructure(SYSTEMTIME)
				
				With *NewDate
					\wYear=YearQ(datum)
					\wMonth=MonthQ(datum)
					\wDay=DayQ(datum)
					\wHour=HourQ(datum)
					\wMinute=MinuteQ(datum)
					\wSecond=SecondQ(datum)
				EndWith
				
				SendMessage_(GadgetID(dategadget), #DTM_SETSYSTEMTIME, #GDT_VALID, *NewDate)
				FreeStructure(*NewDate)
			Else
				SetGadgetState(dategadget,0)
			EndIf
		EndProcedure
		
		Procedure.q getGadgetStateQ(dategadget.i)
			Protected t.s=GetGadgetText(dategadget)
			If t<>""
				
				Protected *NewDate.SYSTEMTIME=AllocateStructure(SYSTEMTIME)
				
				SendMessage_(GadgetID(dategadget), #DTM_GETSYSTEMTIME, 0, *NewDate)
				Protected result.q=DateQ(*NewDate\wYear,*NewDate\wMonth,*NewDate\wDay,*NewDate\wHour,*NewDate\wMinute,*NewDate\wSecond)
				FreeStructure(*NewDate)
				ProcedureReturn result
			EndIf
		EndProcedure
	CompilerEndIf
	
	Procedure setGadgetStateOnlyQ(dategadget.i,datum.q)
		SetGadgetStateQ(dategadget,OnlyDateQ(datum))
	EndProcedure
	
	Procedure.q getGadgetStateOnlyQ(dategadget.i)
		Protected dat.q=GetGadgetStateQ(dategadget)
		ProcedureReturn OnlyDateQ(dat)
	EndProcedure
	
	Procedure ISOWeekQ(dats.q)
		Protected date.q=dats/#CONST_DAY+3
		ProcedureReturn (date-(DateQ(YearQ((date-date%7)*#CONST_DAY),1,date%7+5,0,0,0)/#CONST_DAY-11))/7
	EndProcedure
	
	
	Procedure pLeapyear(year.w)
		If ((year % 4) = 0)
			If (year % 100) Or ((year % 400) = 0)
				ProcedureReturn 1
			EndIf
		EndIf
	EndProcedure
	
	
	Procedure pDayInMonth(year, month)
		Select month
			Case 1,3,5,7,8,10,12
				ProcedureReturn 31
			Case 4,6,9,11
				ProcedureReturn 30
			Default
				ProcedureReturn #CONST_MLT + pLeapyear(year)
		EndSelect
	EndProcedure
	
	Procedure.q AddDateQ(Date.q, Field.b, Offset.q)
		Protected month.b, year.w,day.b
		If (Date = 0 Or Date=-1)
			ProcedureReturn Date
		EndIf
		If (Field = #PB_Date_Second)
			Date + Offset
		ElseIf (Field = #PB_Date_Minute)
			Date + Offset * 60
		ElseIf (Field = #PB_Date_Hour)
			Date + Offset * 60 * 60
		ElseIf (Field = #PB_Date_Day)
			Date + Offset * #CONST_DAY
		ElseIf (Field = #PB_Date_Week)
			Date + Offset * 7 * #CONST_DAY
		ElseIf (Field = #PB_Date_Month)
			month = MonthQ(Date)+Offset*1
			year = YearQ(Date)
			day = DayQ(Date)
			While (month < 1)
				month + 12
				year - 1
			Wend
			While (month > 12)
				month - 12
				year + 1
			Wend
			If pDayInMonth(year,month)<day
				Date = DateQ(year, month, pDayInMonth(year,month), HourQ(Date), MinuteQ(Date), Secondq(Date))
			Else
				Date = DateQ(year, month, day, HourQ(Date), MinuteQ(Date), Secondq(Date))
			EndIf
		ElseIf (Field = #PB_Date_Year)
			year = YearQ(Date) + Offset * 1
			Date = DateQ(year, MonthQ(Date), DayQ(Date), HourQ(Date), MinuteQ(Date), Secondq(Date))
		EndIf
		ProcedureReturn Date
	EndProcedure
	
	DataSection
		tt:
		Data.s "So","Mo","Di","Mi","Do","Fr","Sa","So"
		wt:
		Data.s "Sonntag","Montag","Dienstag","Mittwoche","Donnerstag","Freitag","Samstag","Sonntag"
		nn:
		Data.s "Jan","Feb","Mrz","Apr","Mai","Jun","Jul","Aug","Sep","Okt","Nov","Dez"
		wn:
		Data.s "Januar","Februar","März","April","Mai","Juni","Juli","August","September","Oktober","November","Dezember"
	EndDataSection
	
EndModule

Posted: **Sun Mar 10, 2019 1:42 pm**

Changed: now sends normal gadget events (#PB_Event_Gadget)

Posted: **Thu Mar 14, 2019 2:28 pm**

Removed: SetColumnFlags() [ => AddItem() ]
Changed: AddItem() ignores column 0 if flag #NumberedColumn or #CheckBoxes is set
Added: Validity check for editable columns (#Number/#Integer/#Float/#Cash/#Grades/#Time)
Added: ChangeCountrySettings()

Posted: **Fri Mar 15, 2019 1:07 pm**

Added: Mark column contents according to defined criteria (color/fonts)

NEGATIVE / POSITIVE
EQUAL{3.95} / EQUAL{"string"}
LIKE{*end} / LIKE{start*} / LIKE{*part*}
COMPARE{<|12} => [?] < 12
BETWEEN{10|20} => 10 < [?] < 20
BEYOND{3|4} => 3 > [?] OR [?] > 4
CHOICE{m|f}[C4] => mark current column if column 4 = 'm' (color1) or 'f' (color2)

Posted: **Fri Mar 15, 2019 3:03 pm**

very powerful

Can you put it on github?
The download address is not accessible in some areas

Posted: **Fri Mar 15, 2019 3:27 pm**

@Thorsten1867:
Thank you very much for the many modules you have published and for licensing them under the MIT license.

In your package there is an image file "Test.png". Did you create this image yourself? Your MIT license in the code only covers the code. How may the image be used? For a suitable license for files that do not contain code, you can have a look here: https://choosealicense.com/non-software/

diskay wrote:Can you put it on github?

On the weekend, I will have a look at the many new modules that have been published in the PB forums. Some of them will probably be added to the CodeArchiv (see my signature).

Posted: **Fri Mar 15, 2019 4:57 pm**

@Sicro

The easiest way is to remove the image and comment out the following lines.

Code: Select all

; If LoadImage(#Image, "Test.png")
;  ListEx::SetItemImage(#List, 0, 1, 16, 16, ImageID(#Image))
;  ListEx::SetItemImage(#List, 1, 5, 16, 16, ImageID(#Image), ListEx::#Center)
; EndIf

Posted: **Sun Mar 17, 2019 8:10 pm**

Changed: AddItem() returns now current ListIndex()
Changed: SetItemState() / GetItemState(): #Selected / #Checked / #Inbetween
Added: Flag: #ThreeState (CheckBox) / #MultiSelect (Rows)

Posted: **Mon Apr 01, 2019 12:35 pm**

Update:

system colors
SetColorTheme()

Posted: **Fri Apr 26, 2019 4:01 pm**

I have an issue with switching color themes using the supplied test code at the bottom of the module.

Switching themes via the buttons works well for me. Switching to another theme via the context menu leaves me with a big black rectangle in the empty part of the grid underneath the rows, which is then persistent and no amount of theme switching via both ways will make it go back to white/window color.

I could also fairly easily break the sync between the scrollbar and the data; i.e. move the sb position without the data following.

Also noticed that it doesn't respond to navigation keys like the listicon does: Home/End, PgUp/PgDn, Cursor Up & Down

Posted: **Sat Apr 27, 2019 8:57 pm**

Thorsten,

thanks for sharing your hard and excellent work!
One more nice-to-have feature would be alternating row colours - no grid gadget should be without it!

Cheers!

Posted: **Sat Apr 27, 2019 9:30 pm**

Great work so far. Big thanks!

And yes, alternating colours would be a nice improvement...

Posted: **Sun Apr 28, 2019 10:35 am**

Added: alternated row color (#AlternateRowColor)

Posted: **Mon Apr 29, 2019 9:10 am**

I changed a little bit.

Code: Select all

If Flags & #UseExistingCanvas ;{ Use an existing CanvasGadget (without guaranty!)
      If IsGadget(GNum)
        Result = #True
        OpenGadgetList(GNum)
      Else
        ProcedureReturn #False
      EndIf
      ;}
    Else
      Result = CanvasGadget(GNum, X, Y, Width, Height, #PB_Canvas_Keyboard|#PB_Canvas_Container)
    EndIf

Btw... How do I get the actual row, like GetGadgetState?

Posted: **Mon Apr 29, 2019 12:52 pm**

Added: ListEx::GetState()

PureBasic Forums - English

[Modules] ListEx (all OS / DPI)

Re: [Modules] Editable and sortable ListGadget (all OS)

Re: [Modules] Editable and sortable ListGadget (all OS)

Re: [Modules] Editable and sortable ListGadget (all OS / DPI

Re: [Modules] Editable and sortable ListGadget (all OS / DPI

Re: [Modules] Editable and sortable ListGadget (all OS / DPI

Re: [Modules] Editable and sortable ListGadget (all OS / DPI

Re: [Modules] Editable and sortable ListGadget (all OS / DPI

Re: [Modules] Editable and sortable ListGadget (all OS / DPI

Re: [Modules] Editable and sortable ListGadget (all OS / DPI

Re: [Modules] Editable and sortable ListGadget (all OS / DPI

Re: [Modules] Editable and sortable ListGadget (all OS / DPI

Re: [Modules] Editable and sortable ListGadget (all OS / DPI

Re: [Modules] Editable and sortable ListGadget (all OS / DPI

Re: [Modules] Editable and sortable ListGadget (all OS / DPI

Re: [Modules] Editable and sortable ListGadget (all OS / DPI