KiXforms Forum Index KiXforms
The Forum for the KiXforms Community
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 
 Quick Links 
Site News
Downloads
Documentation
Donations
Script Archive
Tracking Systems

Calendar

 
Post new topic   Reply to topic    KiXforms Forum Index -> Script Archive
View previous topic :: View next topic  
Author Message
bruno
KiXforms Regular
KiXforms Regular


Joined: 19 May 2003
Posts: 44
Location: France (Europe)

PostPosted: Mon Sep 20, 2004 1:29 pm    Post subject: Calendar Reply with quote

Hello all,
I'm intresting by your comments about this script :
(Thank you for the forums)


Code:

Break on
 
$f = CreateObject("KiXtart.Form")
$f.text="Calendar"
$f.width=200
$f.height=250

$LabelMo = $f.Controls.Label()
$LabelMo.text=@year+"/"+@monthno
$LabelMo.Bounds = 0, 10, $f.width, 12
$LabelMo.textalign=32

$ButPrev = $f.Controls.Button()
$ButPrev.text="Prev."
$ButPrev.Left=10
$ButPrev.height=20
$ButPrev.width=40
$ButPrev.top=$f.height-50
$ButPrev.onclick="prevd($b)"

$ButToday = $f.Controls.Button()
$ButToday.text="Today"
$ButToday.Left=($f.width/2)-25
$ButToday.height=20
$ButToday.width=40
$ButToday.top=$f.height-50
$ButToday.onclick="today($b)"

$ButNext = $f.Controls.Button()
$ButNext.text="Next"
$ButNext.Left=$f.width-60
$ButNext.height=20
$ButNext.width=40
$ButNext.top=$f.height-50
$ButNext.onclick="nextd($b)"

$f.PrintXY(10,40,"Mo")
$f.PrintXY(35,40,"Tu")
$f.PrintXY(60,40,"We")
$f.PrintXY(85,40,"Th")
$f.PrintXY(110,40,"Fr")
$f.PrintXY(135,40,"Sa")
$f.PrintXY(160,40,"Su")

Dim $b[35]

$y=60

For $i = 0 to 34
  If $x>6 $y=$y+25 $x=0 EndIf 
  $b[$i] = $f.Button()
  $b[$i].Location = ($x*25)+10,$y
  $b[$i].Text = ($i+1)
  $b[$i].width = 20
  $b[$i].height = 20
  $b[$i].OnClick = 'rb_Click($b['+$i+'].text,'+$i+',"b")'
  $x=$x+1 
Next

$f.Show

$date=@DATE
gogo($b,$date)

While $f.Visible
    $_ = Execute($f.DoEvents)
Loop

Function rb_Click($d, $rbNumber, $part)
 
  $m=udfFormatDate("!m",$date)
  $y=udfFormatDate("!Y",$date)
  $ds=udfFormatDate("!A",$y+"/"+$m+"/"+$name)
 
  $mes="Your choice is the :"+@CRLF+@CRLF+$ds+" "+$LabelMo.text+"/"+$d 
  $ret=$f.MessageBox($mes,"Calendar",64)
 
EndFunction

Function prevd($b)
 
  For $i=0 to 34 
    $b[$i].visible="true"
    $b[$i].text=($i+1)
  Next

  $year=udfFormatDate("!Y",$date)
  $month=Val(udfFormatDate("!m",$date))-1
 
  If $month<1
    $month=12
    $year=Val($year)-1
  EndIf
 
  If Len("$month")=1 $month="0"+$month EndIf

  $date="$year/"+$month+"/01"

  gogo($b,$date)
 
EndFunction

Function today($b)
 
  For $i=0 to 34 
    $b[$i].visible="true"
    $b[$i].text=($i+1)
  Next

  $datearray=Split($date,"/")
  $year=@year
  $month=@MONTHNO
 
  If Len("$month")=1 $month="0"+$month EndIf

  $date="$year/"+$month+"/01"
 
  gogo($b,$date)
 
EndFunction

Function Nextd($b)
 
  For $i=0 to 34 
    $b[$i].visible="true"
    $b[$i].text=($i+1)
  Next

  $year=udfFormatDate("!Y",$date)
  $month=Val(udfFormatDate("!m",$date))+1

  If $month>12
    $month=1
    $year=Val($year)+1
  EndIf
 
  If Len("$month")=1 $month="0"+$month EndIf

  $date="$year/"+$month+"/01"

  gogo($b,$date)
 
EndFunction

Function gogo($b,$date)

  $year=udfFormatDate("!Y",$date)
  $month=udfFormatDate("!m",$date)
  $day=udfFormatDate("!d",$date)

  $LabelMo.text=$year+"/"+$month
  $pday=udfFormatDate("!w",$year+"/"+$month+"/01")

  Select
   Case $month="01"
     $lm=31
   Case $month="02"
     If Val($year)=(Val($year)/400)*400 OR Val($year)=(Val($year)/4)*4 AND Val($year)<>(Val($year)/100)*100
       $lm=29
     Else
       $lm=28   
     EndIf       
   Case $month="03"
     $lm=31
   Case $month="04"
     $lm=30
   Case $month="05"
     $lm=31
   Case $month="06"
     $lm=30
   Case $month="07"
     $lm=31
   Case $month="08"
     $lm=31
   Case $month="09"
     $lm=30
   Case $month="10"
     $lm=31
   Case $month="11"
     $lm=30
   Case $month="12"
     $lm=31
   Case 1
     $lm=0
  EndSelect

  $nu=1 
  $ok=0
  For $i=0 to 34 
    If $b[$i].text=$pday
      $ok=1
    EndIf
   
    If $ok=1
      $b[$i].text=$nu
      $nu=$nu+1
      If $nu>$lm+1
        $b[$i].visible="false"
      EndIf         
    Else   
      $b[$i].visible="false"
    EndIf
  Next

EndFunction


;Function udfFormatDate() strftime like date formatting
;
;Author Richard Howarth (rhowarth@sgb.co.uk)
;
;Contributors Week number calculation transliterated from a GAWK script
; created by J R Stockton " target=_blankhttp://www.merlyn.demon.co.uk/index.htm <http://www.merlyn.demon.co.uk/index.htm</font>
;
;Action Formats date and time information - very similar to C strftime()
;
;Syntax udfFormatDate($sFormat, Optional $sDateAndTime
;
;Version 1.0
;
;Date 15 July 2003
;
;
;Parameters $sFormat Format string that the date information is inserted into.
; Each part of the information is introduced by the "!"
; character - change $sIntro if you prefer to use a
; different character. I didn't use "%" as it clashes with
; the KiXtart environment variable character
;
; $sDateAndTime OPTIONAL, in format "YYYY/MM/DD HH:MM:SS"
; If not set defaults to the current date and time. You may
; specify just the date if you are using only date tokens. If
; you only want to use the time tokens, you will need to insert
; a dummy date.
;
;
;
;Remarks (1) If you use the tokens marked "*" in the list, you will need to include the
; SerialDate() function from the ScriptLogic site:
; " target=_blankhttp://scriptlogic.com/Kixtart/FunctionLibrary_ViewFunction.aspx?ID=SerialDate <http://scriptlogic.com/Kixtart/FunctionLibrary_ViewFunction.aspx?ID=SerialDate</font>
;
; (2) The week number returned conforms to ISO8601. This is commonly used in the UK, but
; may not be valid in the US. The value returned is "YYYY/WW", where YYYY is the year
; that the week falls into, and WW is the week number.
;
; (3) Unrecognised tokens including a trailing introduction character are returned as-is.
;
; (4) The values returned by this function are KiXtart oriented, so if you are used to the
; values returned by strftime() be sure you understand the differences.
;
; (5) The "a","A" and "W" tokens are only valid for years 1970-2099
;
;Returns Formatted string.
;
;Dependencies If tokens marked "*" are used then SerialDate() is required.
;
;KiXtart Ver 4.02
;
; Token SerialDate Action
; ----- ---------- ------
; a * Abbreviated week day name (Mon...Sun)
; A * Full week day name (Monday...Sunday)
; b Abbreviated month name (Jan...Dec)
; B Full month name (January...December)
; c * Local long time and date representation
; d Day of month (01...31)
; D Local date representation, synonym for "x"
; H Hour (24 hour clock)
; I Hour (12 hour clock)
; j * Day of year (1...366)
; m Month (01...12)
; M Minute(00...59)
; o Ordinal suffix (1st, 2nd, 3rd...)
; p AM or PM indicator
; S Second (00...59)
; T Local time representation, synonym for "X"
; w Week day number (1...7) 1 is Monday
; W * Week Number. ISO 8601
; x Local date representation
; X Local time representation
; y Year without century (00...99)
; Y Year with century
;
;Examples:
; (1) Create a filename based on todays date:
; $sFileName=udfFormatDate(%TEMP%+"\File!Y!m!d.txt")
;
; (2) On which day did the (popular  ) new millenium fall:
; udfFormatDate("New millenium started on a !A!","2000/01/01")
;
; (3) Get the ISO week number of the 1st of Jan 2005 (puts year into element 0, week into element 1)
; $aiISOWeek=Split(udfFormatDate("!W","2005/01/01"),"/")
; "Year is " $aiISOWeek[0] ?
; "Week is " $aiISOWeek[1] ?
; Note, this example is included because 1st Jan 2005 falls on week 53 of 2004
;
Function udfFormatDate($sFormat,Optional $sDate) ; {{{
Dim $asTwelveHourSplit,$asDayName,$asMonthName,$asOrdinal
Dim $aiDateBits,$aiTimeBits
Dim $sIntro,$bTokenNext
Dim $sLocalTime,$sLocalDate,$sLocalDateAndTime
Dim $sAction

; Token intro character. Change if you don't like it.
$sIntro="!"
; Define locale defaults - UK *CHANGEME* for your locale
$sLocalTime=$sIntro+"H:"+$sIntro+"M:"+$sIntro+"S"
$sLocalDate=$sIntro+"d/"+$sIntro+"m/"+$sIntro+"Y"
$sLocalDateAndTime=$sIntro+"a "+$sIntro+"b "+$sIntro+"d"+$sIntro+"o "+$sLocalTime+" "+$sIntro+"Y"

; Define name constants - UK English *CHANGEME* for your locale
$asTwelveHourSplit="am","pm"
$asDayName="Monday","Tuesday","Wednesday","Thursday",
"Friday","Saturday","Sunday"
$asMonthName="January","February","March","April",
"May","June","July","August",
"September","October","November","December"
$sOrdinal="stndrdthththththththththththththththththstndrdthththththththst"

If NOT $sDate $sDate=@DATE+" "+@TIME EndIf

$aiDateBits=Split(Split($sDate)[0],"/")
$aiTimeBits=Split(Split($sDate)[1],":")

While $sFormat
$sAction=Left($sFormat,1)
$sFormat=SubStr($sFormat,2)
If $bTokenNext
$bTokenNext=0
Select
Case $sAction==$sIntro ; No action - use token intro character
Case $sAction=="a"
$sAction=(SerialDate($sDate)-SerialDate("1969/01/01")+2) mod 7 + 1
$sAction=Left($asDayName[$sAction-1],3)
Case $sAction=="A"
$sAction=(SerialDate($sDate)-SerialDate("1969/01/01")+2) mod 7 + 1
$sAction=$asDayName[$sAction-1]
Case $sAction=="b" $sAction=Left($asMonthName[CInt($aiDateBits[1])-1],3)
Case $sAction=="B" $sAction=$asMonthName[CInt($aiDateBits[1])-1]
Case $sAction=="c" $sAction="" $sFormat=$sLocalDateAndTime+$sFormat
Case $sAction=="d" $sAction=$aiDateBits[2]
Case $sAction=="D" $sAction="" $sFormat=$sLocalDate+$sFormat
Case $sAction=="H" $sAction=$aiTimeBits[0]
Case $sAction=="I"
$sAction=$aiTimeBits[0]
If CInt($sAction)>12 $sAction=Right("0"+(CInt($sAction)-12),2) EndIf
Case $sAction=="j" $sAction=1+SerialDate($sDate)-SerialDate(CStr($aiDateBits[0])+"/01/01")
Case $sAction=="m" $sAction=$aiDateBits[1]
Case $sAction=="M" $sAction=$aiTimeBits[1]
Case $sAction=="o" $sAction=SubStr($sOrdinal,CInt($aiDateBits[2])*2-1,2)
Case $sAction=="p"
$sAction=IIf(CInt($aiTimeBits[0])>=12,$asTwelveHourSplit[1],$asTwelveHourSplit[0])
Case $sAction=="S" $sAction=$aiTimeBits[2]
Case $sAction=="T" $sAction="" $sFormat=$sLocalTime+$sFormat
Case $sAction=="w"
$sAction=(SerialDate($sDate)-SerialDate("1969/01/01")+2) mod 7 + 1
Case $sAction=="W"
Dim $iDate,$iNearestThursday,$iExcess,$iQuadYears,$iYear,$iDay
$iDate=CInt(SerialDate($sDate)-SerialDate("1969/01/01"))
$iNearestThursday=$iDate+4-(($iDate+2) mod 7 + 1)
$iExcess=$iNearestThursday mod 1461
$iQuadYears=($iNearestThursday-$iExcess)/1461
$iDay=$iExcess mod 365
$iYear=($iExcess-$iDay)/365
If ($iYear=4) $iYear=3 $iDay=365 EndIf
$sAction=CStr(1969+4*$iQuadYears+$iYear)+"/"+Right("0"+CStr(1+($iDay-($iDay mod 7))/7),2)
Case $sAction=="x" $sAction="" $sFormat=$sLocalDate+$sFormat
Case $sAction=="X" $sAction="" $sFormat=$sLocalTime+$sFormat
Case $sAction=="y" $sAction=Right($aiDateBits[0],2)
Case $sAction=="Y" $sAction=$aiDateBits[0]
Case "Unknown Token" $sAction=$sIntro+$sAction
EndSelect
$udfFormatDate=$udfFormatDate+CStr($sAction)
Else
If $sAction==$sIntro
$bTokenNext=1
Else
$udfFormatDate=$udfFormatDate+$sAction
EndIf
EndIf
Loop

If $bTokenNext $udfFormatDate=$udfFormatDate+$sIntro EndIf

EndFunction ; }}}
Exit 0




;FUNCTION      SerialDate
;
;ACTION        Convert dates to numbers (and back) for the purpose of performing date math
;
;AUTHOR        ScriptLogic (http://www.scriptlogic.com)
;
;CONTRIBUTOR   Jens Meyer (sealeopard@usa.net)
;
;VERSION       1.1
;
;SYNTAX        SERIALDATE(DATE)
;
;PARAMETERS    DATE or NUMBER
;              if a date is used, it must be in the form of "YYYY/MM/DD"
;              if a number is used, it must be a number previously derived from this function.
;
;RETURNS       If a date is passed to this function, the function returns a number. If a number is
;              passed to this function, a date "YYYY/MM/DD" is returned
;
;REMARKS       This function was developed as a core routine for the DateMath( ) function. In
;              normal usage, you would most like just use the DateMath( ) function which depends
;              on this function.
;              Algorithms used in the development of this routine were obtained from:
;              http://www.capecod.net/~pbaum/date/date0.htm
;
;              Fixed a couple of inconsistencies in the returned values and formatting
;
;              Original UDF is posted at http://www.scriptlogic.com/kixtart/FunctionLibrary_ViewFunction.aspx?ID=SerialDate
;
;DEPENDENCIES  none
;
;EXAMPLE       $rc=serialdate('2001/07/01')
;
;KIXTART BBS   http://www.kixtart.org/cgi-bin/ultimatebb.cgi?ubb=get_topic&f=12&t=000089
;
Function serialdate($ExpD)
  Dim $z,$h,$a,$b,$c,$y,$m,$d
  If InStr($ExpD,'/')
    $ExpD=Split($ExpD,'/')
    $y=Val($ExpD[0])
    $m=Val($ExpD[1])
    $d=Val($ExpD[2])
    If $m<3
      $m=$m+12
      $y=$y-1
    EndIf
    $SerialDate=$d+(153*$m-457)/5+365*$y+$y/4-$y/100+$y/400-306
  Else
    $z=0+$ExpD+306
    $h=100*$z-25
    $a=$h/3652425
    $b=$a-$a/4
    $y=(100*$b+$h)/36525
    $c=$b+$z-365*$y-$y/4
    $m=(5*$c+456)/153
    $d=$c-(153*$m-457)/5
    If $m>12
      $y=$y+1
      $m=$m-12
    EndIf
    $SerialDate=Right('0000'+$y,4)+'/'+Right('00'+$m,2)+'/'+Right('00'+$d,2)
  EndIf
EndFunction

_________________
There is no stupid question. Whoever seeks is never stupid because he will know ...
Bruno.
Back to top
View user's profile Send private message
Jochen
KiXforms Devotee
KiXforms Devotee


Joined: 05 Mar 2003
Posts: 1204
Location: Stuttgart, Germany

PostPosted: Mon Sep 20, 2004 3:55 pm    Post subject: Reply with quote

First glance:

Use ToolButtons instead and set .Flatstyle to 1 ... should look better and that weird behaviour when selected should be gone too Smile

More to follow when I have time to dig in deeper

_________________
Jochen

Tell me, and I will forget.
Show me, and I may remember.
Involve me, and I will understand.
Back to top
View user's profile Send private message MSN Messenger
Shawn
KiXforms Developer
KiXforms Developer


Joined: 22 Feb 2003
Posts: 1983
Location: Canada

PostPosted: Mon Sep 20, 2004 6:57 pm    Post subject: Reply with quote

wow - very nice - very cool!
Back to top
View user's profile Send private message
bruno
KiXforms Regular
KiXforms Regular


Joined: 19 May 2003
Posts: 44
Location: France (Europe)

PostPosted: Tue Sep 21, 2004 7:46 am    Post subject: Reply with quote

Thank you.

Your right Shawn, it's look better.
I add also cursor=16 to the Toolbuttons for nicer...

_________________
There is no stupid question. Whoever seeks is never stupid because he will know ...
Bruno.
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    KiXforms Forum Index -> Script Archive All times are GMT
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
You cannot attach files in this forum
You can download files in this forum


Powered by phpBB © 2001, 2005 phpBB Group