[Modules] ListEx (all OS / DPI)

Applications, Games, Tools, User libs and useful stuff coded in PureBasic
Post Reply
Cyllceaux
Enthusiast
Enthusiast
Posts: 514
Joined: Mon Jun 23, 2014 1:18 pm

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

Post by Cyllceaux »

Nice :)

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

Code: Select all

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
Top
User avatar
Thorsten1867
Addict
Addict
Posts: 1372
Joined: Wed Aug 24, 2005 4:02 pm
Location: Germany

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

Post by Thorsten1867 »

Changed: now sends normal gadget events (#PB_Event_Gadget)
Translated with http://www.DeepL.com/Translator

Download of PureBasic - Modules
Download of PureBasic - Programs

[Windows 11 x64] [PB V5.7x]
Top
User avatar
Thorsten1867
Addict
Addict
Posts: 1372
Joined: Wed Aug 24, 2005 4:02 pm
Location: Germany

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

Post by Thorsten1867 »

  • 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()
Translated with http://www.DeepL.com/Translator

Download of PureBasic - Modules
Download of PureBasic - Programs

[Windows 11 x64] [PB V5.7x]
Top
User avatar
Thorsten1867
Addict
Addict
Posts: 1372
Joined: Wed Aug 24, 2005 4:02 pm
Location: Germany

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

Post by Thorsten1867 »

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)
Translated with http://www.DeepL.com/Translator

Download of PureBasic - Modules
Download of PureBasic - Programs

[Windows 11 x64] [PB V5.7x]
Top
diskay
User
User
Posts: 25
Joined: Sun Aug 02, 2015 7:17 pm

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

Post by diskay »

very powerful :D
Can you put it on github?
The download address is not accessible in some areas
Top
User avatar
Sicro
Enthusiast
Enthusiast
Posts: 563
Joined: Wed Jun 25, 2014 5:25 pm
Location: Germany
Contact:
Contact Sicro

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

Post by Sicro »

@Thorsten1867:
Thank you very much for the many modules you have published and for licensing them under the MIT license. 8)
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).
Image
Why OpenSource should have a license :: PB-CodeArchiv-Rebirth :: Pleasant-Dark (syntax color scheme) :: RegEx-Engine (compiles RegExes to NFA/DFA)
Manjaro Xfce x64 (Main system) :: Windows 10 Home (VirtualBox) :: Newest PureBasic version
Top
User avatar
Thorsten1867
Addict
Addict
Posts: 1372
Joined: Wed Aug 24, 2005 4:02 pm
Location: Germany

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

Post by Thorsten1867 »

@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
Translated with http://www.DeepL.com/Translator

Download of PureBasic - Modules
Download of PureBasic - Programs

[Windows 11 x64] [PB V5.7x]
Top
User avatar
Thorsten1867
Addict
Addict
Posts: 1372
Joined: Wed Aug 24, 2005 4:02 pm
Location: Germany

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

Post by Thorsten1867 »

  • Changed: AddItem() returns now current ListIndex()
  • Changed: SetItemState() / GetItemState(): #Selected / #Checked / #Inbetween
  • Added: Flag: #ThreeState (CheckBox) / #MultiSelect (Rows)
Translated with http://www.DeepL.com/Translator

Download of PureBasic - Modules
Download of PureBasic - Programs

[Windows 11 x64] [PB V5.7x]
Top
User avatar
Thorsten1867
Addict
Addict
Posts: 1372
Joined: Wed Aug 24, 2005 4:02 pm
Location: Germany

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

Post by Thorsten1867 »

Update:
  • system colors
  • SetColorTheme()
Translated with http://www.DeepL.com/Translator

Download of PureBasic - Modules
Download of PureBasic - Programs

[Windows 11 x64] [PB V5.7x]
Top
User avatar
kpeters58
Enthusiast
Enthusiast
Posts: 341
Joined: Tue Nov 22, 2011 5:11 pm
Location: Kelowna, BC, Canada

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

Post by kpeters58 »

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
Last edited by kpeters58 on Sat Apr 27, 2019 11:16 pm, edited 1 time in total.
PB 5.73 on Windows 10 & OS X High Sierra
Top
User avatar
kpeters58
Enthusiast
Enthusiast
Posts: 341
Joined: Tue Nov 22, 2011 5:11 pm
Location: Kelowna, BC, Canada

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

Post by kpeters58 »

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!
PB 5.73 on Windows 10 & OS X High Sierra
Top
User avatar
Andre
PureBasic Team
PureBasic Team
Posts: 2148
Joined: Fri Apr 25, 2003 6:14 pm
Location: Germany (Saxony, Deutscheinsiedel)
Contact:
Contact Andre

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

Post by Andre »

Great work so far. Big thanks! :D

And yes, alternating colours would be a nice improvement... :mrgreen:
Bye,
...André
(PureBasicTeam::Docs & Support - PureArea.net | Order:: PureBasic | PureVisionXP)
Top
User avatar
Thorsten1867
Addict
Addict
Posts: 1372
Joined: Wed Aug 24, 2005 4:02 pm
Location: Germany

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

Post by Thorsten1867 »

  • Added: alternated row color (#AlternateRowColor)
Translated with http://www.DeepL.com/Translator

Download of PureBasic - Modules
Download of PureBasic - Programs

[Windows 11 x64] [PB V5.7x]
Top
Cyllceaux
Enthusiast
Enthusiast
Posts: 514
Joined: Mon Jun 23, 2014 1:18 pm

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

Post by Cyllceaux »

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?
Top
User avatar
Thorsten1867
Addict
Addict
Posts: 1372
Joined: Wed Aug 24, 2005 4:02 pm
Location: Germany

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

Post by Thorsten1867 »

Added: ListEx::GetState()
Translated with http://www.DeepL.com/Translator

Download of PureBasic - Modules
Download of PureBasic - Programs

[Windows 11 x64] [PB V5.7x]
Top
Post Reply

Return to “Applications - Feedback and Discussion”