Calendario anual

Post Reply
User avatar
Ricardo Ramirez E.
Posts: 161
Joined: Wed Jan 25, 2006 10:45 am
Location: Praia - Cape Verde
Contact:
Contact Ricardo Ramirez E.

Post by Ricardo Ramirez E. »

Gracias :)

Saludos
Saludos
Ricardo R.
xHarbour 1.1.0 Simplex , Microsoft Visual Studio 2008, Bcc55, Fwh Build. 9.01
Top
User avatar
nazariosn
Posts: 15
Joined: Sat Nov 26, 2005 1:06 am
Location: Mexico

Post by nazariosn »

Manuel.

Gracias.

Saludos
Top
User avatar
Otto
Posts: 4470
Joined: Fri Oct 07, 2005 7:07 pm
Contact:
Contact Otto

Post by Otto »

Regards,
Otto
ON CLICK - MOUSEMOVE - ButtonUp

Image

Code: Select all

#include "fivewin.ch"

STATIC oWndPlan
STATIC planFont
STATIC sX          := 1
STATIC sY          := 1
STATIC sXTemp      := 0
STATIC sYTemp      := 0
STATIC aPlan       := {}
STATIC startRow    :=0
STATIC startCol    :=0
STATIC startDay    :=""
STATIC oBrush
STATIC lMove       :=.f.
STATIC hBru
STATIC hPen
STATIC hPen1
STATIC hPen3
STATIC aTemp       := {}
STATIC nStartZeile := 0

function main()

   aadd(aTemp,{0,0})                            // 1
   aadd(aTemp,{0,0})                            // 2
   aadd(aTemp,{0,0})                            // 3
   aadd(aTemp,{0,0})                            // 4
   aadd(aTemp,{0,0})                            // 5
   aadd(aTemp,{0,0})                            // 6
   aadd(aTemp,{0,0})                            // 7
   aadd(aTemp,{0,0})                            // 8
   aadd(aTemp,{0,0})                            // 9
   aadd(aTemp,{0,0})                            // 10
   aadd(aTemp,{0,0})                            // 11
   aadd(aTemp,{0,0})                            // 12

   SET DATE GERMAN

   ***

   hBru   := CreateSolidBrush( RGB(217,230,246) )
   hPen   := CreatePen( 0, 1, 12632256 )
   hPen1  := CreatePen( 0, 1, 280 )
   hPen3  := CreatePen( 0, 18,RGB(183,249,185) )//Sonntagsspalte

   DEFINE BRUSH oBrush  COLOR RGB(255,255,255)
   DEFINE FONT planFont NAME "ARIAL" SIZE  0,-11

   ***

   DEFINE WINDOW oWndPlan TITLE "Kalender" ;
      HSCROLL        ;
      FROM 5, 5 TO 24, 98

   oWndPlan:bLClicked  := { |y,x,flags | f_bLClicked(y,x) }
   oWndPlan:bMMoved    := { |y,x,flags | f_MMoved(y,x) }
   oWndPlan:bLButtonUp := { |y,x,flags | f_LButtonUp(y,x) }

   ACTIVATE WINDOW oWndPlan  ON PAINT DrawRowLines()

return nil

func DrawRowLines ()

   LOCAL  I,  nCurrentRows, iZeile
   LOCAL cHeader1     := ""
   LOCAL oSay
   LOCAL hdc
   LOCAL aDays        := {;
      "So","Mo","Di", "Mi", "Do", "Fr", "Sa","So",;
      "Mo","Di", "Mi", "Do", "Fr", "Sa","So",;
      "Mo","Di", "Mi", "Do", "Fr", "Sa","So",;
      "Mo","Di", "Mi", "Do", "Fr", "Sa","So",;
      "Mo","Di", "Mi", "Do", "Fr", "Sa","So","Mo" }

   LOCAL nYear        := YEAR( DATE() )
   LOCAL cYear        := STR( nYear, 4 )
   LOCAL dDate, nStart
   LOCAL lSchaltJahr  := ( DAY( CTOD( "29.02." + cYear ) ) <> 0 )
   LOCAL aDaysInMonth := { 31, IIF( lSchaltJahr, 29, 28 ), 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 }
   LOCAL nColOffSet   := 10
   LOCAL aRect1
   LOCAL IMonate      := 0
   LOCAL ITemp        := 0
   local cTest        := ""
   local nEnde

   FOR IMonate := 1 TO 12

      aadd(aPlan,{"","","", "", "", "", "","",;
         "","", "", "", "", "","",;
         "","", "", "", "", "","",;
         "","", "", "", "", "","",;
         "","", "", "", "", "","","",0,0,0 } )

   NEXT

   aRect1 := { 0,0,500,1000}
   FillRect(oWndPlan:hDc,aRect1,oBrush:hBrush)
   iZeile       := 0
   nCurrentRows := 30

   FOR I := 1 TO  13

      SelectObject( oWndPlan:hDc, hPen )
      IF iZeile = 5
         SelectObject( oWndPlan:hDc, hPen1 )
         iZeile := 0
      ENDIF

      //Lines
      oWndPlan:line (nCurrentRows, 1,nCurrentRows, 726 )
      nCurrentRows := nCurrentRows +  18
      iZeile := iZeile + 1

   NEXT

   nCurrentRows:= 50

   FOR I := 1 TO  38

      SelectObject( oWndPlan:hDc, hPen )
      IF iZeile = 5
         SelectObject( oWndPlan:hDc, hPen1 )
         iZeile := 0
      ENDIF

      oWndPlan:line (10,nColOffSet + nCurrentRows,400, nColOffSet + nCurrentRows )
      nCurrentRows := nCurrentRows +  18
      iZeile := iZeile + 1

   NEXT

   nCurrentRows:= 50

   FOR I := 1 TO len(aDays)

      if aDays[I] = "So"

         //Farbhintergrund Sonntag
         SelectObject( oWndPlan:hDc, hPen3 )

         // Sonntag  erste fette Linie
         oWndPlan:line (0,nColOffSet+   10 + nCurrentRows,400, nColOffSet+  10 + nCurrentRows )

         SelectObject( oWndPlan:hDc, hPen )
         oWndPlan:say( 8, nColOffSet+36+I*18,aDays[I],RGB(255,128,0), RGB(125,236,175),planFont,.T.)

      else
         oWndPlan:say( 8, nColOffSet+36+I*18,aDays[I],RGB(255,128,0),16777215,planFont,.T.)

      endif

      nCurrentRows := nCurrentRows +  18

   NEXT

   nCurrentRows := 12

   FOR I := 1 TO  12

      SelectObject( oWndPlan:hDc, hPen )
      IF iZeile = 5
         SelectObject( oWndPlan:hDc, hPen1 )
         iZeile := 0
      ENDIF

      nCurrentRows := nCurrentRows +  18
      dDate := CTOD( "01." + PADL( ALLTRIM(STR( i, 2 )), 2, "0" ) + "." + cYear )
      nStart := DOW( dDate )
      aPlan[I,38] :=  nStart
      aPlan[I,39] :=  30-18+ (18*( aDaysInMonth[i] + nStart - 1 )) //col begin of month
      aPlan[I,40] :=  nStart + aDaysInMonth[i]  //col end of month

      FOR iZeile := nStart TO aDaysInMonth[i] + nStart - 1
         aPlan[I,iZeile] =    ( PADL( ALLTRIM(STR( (iZeile-nStart+1), 2 )), 2, "0" )+ "." + PADL( ALLTRIM(STR( (I), 2 )), 2, "0" ) + "." + cYear )
      NEXT

      cHeader1 :=      OemToAnsi( CMONTH( dDate ) ) //Monate
      oWndPlan:say( nCurrentRows+1, 2, cHeader1,RGB(63,63,63),16777215,planFont,.T.)

   NEXT

   IF (sy > 0 .AND. sy < 13)  .AND.  (sx > 0 .AND. sx < 38)


      IF lMove = .t.
         IZeile := INT((syTemp-30)/18 ) + 1
         aTemp[IZeile,1]:=10

         FOR ITemp := IZeile+1 TO 12
            aTemp[ITemp,1]:=0
         NEXT

         FOR ITemp := 1 TO 12

            if aTemp[ITemp,1] > 0
               if sXTemp > aPlan[ITemp,39] + aPlan[ITemp,38]*18
                  sXTemp := aPlan[ITemp,39] + aPlan[ITemp,38]*18
               endif

               IF 30-18+ (18*(ITemp)) >= startCol  .AND. ;
                  .NOT.  (30-18+ (18*(ITemp)) = startCol  .AND. ;
                  startRow > sXTemp)

                  FillRect( oWndPlan:hDc, { 30-18+ (18*(ITemp)),startRow, 30 +(18*(ITemp)), sXTemp}, hBru )

                  IF ITemp > nStartZeile
                     FillRect( oWndPlan:hDc, { 30-18+ (18*(ITemp-1)),startRow, 30 +(18*(ITemp-1)), (30 +( 13 + 18*(aPlan[ITemp-1,40])))   }, hBru )
                     FillRect( oWndPlan:hDc, { 30-18+ (18*(ITemp)),  30 + 13 + (18*(aPlan[ITemp,38])), 30 +(18*(ITemp)), sXTemp}, hBru )
                  ENDIF

               else
                  FillRect( oWndPlan:hDc, {startCol,startRow,startCol+18,startRow+18}, hBru )
               ENDIF
            endif
         NEXT
      ENDIF
   ENDIF

   nCurrentRows := 12

   FOR I := 1 TO  12

      SelectObject( oWndPlan:hDc, hPen )
      IF iZeile = 5
         SelectObject( oWndPlan:hDc, hPen1 )
         iZeile := 0
      ENDIF

      nCurrentRows := nCurrentRows +  18
      dDate := CTOD( "01." + PADL( ALLTRIM(STR( i, 2 )), 2, "0" ) + "." + cYear )
      nStart := DOW( dDate )

      aPlan[I,38] :=  nStart
      aPlan[I,39] :=  30-18+ (18*( aDaysInMonth[i] + nStart - 1 )) //col begin of month
      aPlan[I,40] :=  nStart + aDaysInMonth[i]  //col end of month

      FOR iZeile := nStart TO aDaysInMonth[i] + nStart - 1

         cHeader1 :=    ALLTRIM(str(iZeile-nStart+1)) //Tage
         if aDays[iZeile] = "So"
            oWndPlan:say( nCurrentRows+3,36 + nColOffSet + (iZeile)  *18, ;
               cHeader1, RGB(63,63,63),RGB(125,236,175),planFont,.T.,.T.)
         else
            oWndPlan:say( nCurrentRows+3,36 + nColOffSet + (iZeile)  *18, ;
               cHeader1, RGB(63,63,63),16777215,planFont,.T., .T.)
         ENDIF
      NEXT
   NEXT

   IF (sy > 0 .AND. sy < 13)  .AND.  (sx > 0 .AND. sx < 38)
      oWndPlan:say(syTemp+20, sxTemp-20,  aPlan[sy, sx] + " # "+str(ctod(aPlan[sy, sx])-ctod(startDay)+ 1), RGB(63,63,63), RGB(125,236,175), planFont, .T. )
   endif

return nil

func f_LButtonUp(y,x)

   msginfo(startDay + " -- " + aPlan[sy, sx] + "    Tage: " + str( ctod(aPlan[sy, sx])-ctod(startDay)  +1   ))
   lMove:=.f.

return nil

func  f_MMoved(y,x)

   IF sy <>  (INT((y-30)/18 ) + 1) .OR. sy <> (INT( (x-50-10)/18 ) + 1 )
      sy := INT((y-30)/18 ) + 1
      sx := INT((x-50-10)/18 ) + 1

      IF y < 30
         sy := 0
         y  := 0
      ENDIF

      syTemp := y
      sxTemp :=   59 +      sx * 18

      oWndPlan:refresh()

   ENDIF

return nil

func f_bLClicked(y,x)

   local ITemp:=0

   sy := INT((y-30)/18 ) + 1
   sx := INT((x-50-10)/18 ) + 1
   startDay := aPlan[sy, sx]
   nStartZeile := sy
   startRow := INT((x - 30)/18)*18   + 18 + 7
   startCol := (INT((y-30)/18 ))*18 + 30

   FOR ITemp := 1 TO 12
      aTemp[ITemp,1]:=0
   NEXT

   FillRect( oWndPlan:hDc, {startCol,startRow,startCol+18,startRow+18}, hBru )
   oWndPlan:refresh()

   lMove:=.t.

return nil
Top
User avatar
mmercado
Posts: 782
Joined: Wed Dec 19, 2007 7:50 am
Location: Salamanca, Gto., México

Post by mmercado »

Hi Otto:

Very nice work, congratulations.

Manuel Mercado
Top
User avatar
Andrés González
Posts: 625
Joined: Thu Jan 19, 2006 10:45 am
Location: Mallorca

Post by Andrés González »

Thanks Otto,

great work, very nice and clean.

Congratulations.
Saludos

Andrés González desde Mallorca
Top
User avatar
Otto
Posts: 4470
Joined: Fri Oct 07, 2005 7:07 pm
Contact:
Contact Otto

Post by Otto »

I saw that I had a mistake in naming the variables. X was y and vice versa. I changed the code.

Please lets go ahead with this.

Carles:
What is local aInfo := oWndPlan:DispBegin()
exactly doing?

Regards,
Otto

PS: Could you please send me your email addresses.
I would like to share my snipkeeper code with you, too.
datron&aon.at (& =@)



Code:
#include "fivewin.ch"

STATIC oWndPlan
STATIC planFont
STATIC sy := 1
STATIC sx := 1
STATIC syTemp := 0
STATIC sxTemp := 0
STATIC aPlan := {}
STATIC ClickCol :=0
STATIC ClickRow :=0
STATIC startDay :=""
STATIC oBrush
STATIC lMove :=.f.
STATIC hBru
STATIC hPen
STATIC hPen1
STATIC hPen3
STATIC aTemp := {}
STATIC nStartZeile := 0

/* ********** added by rochinha, modify by Quique ********** */
STATIC nYear
/* ********** added by rochinha, modify by Quique ********** */

function main()
/* ********** added by rochinha, modify by Quique ********** */
nYear := YEAR( DATE() )
/* ********** added by rochinha, modify by Quique ********** */

aadd(aTemp,{0,0}) // 1
aadd(aTemp,{0,0}) // 2
aadd(aTemp,{0,0}) // 3
aadd(aTemp,{0,0}) // 4
aadd(aTemp,{0,0}) // 5
aadd(aTemp,{0,0}) // 6
aadd(aTemp,{0,0}) // 7
aadd(aTemp,{0,0}) // 8
aadd(aTemp,{0,0}) // 9
aadd(aTemp,{0,0}) // 10
aadd(aTemp,{0,0}) // 11
aadd(aTemp,{0,0}) // 12

SET DATE GERMAN

***

hBru := CreateSolidBrush( RGB(217,230,246) )
hPen := CreatePen( 0, 1, 12632256 )
hPen1 := CreatePen( 0, 1, 280 )
hPen3 := CreatePen( 0, 18,RGB(183,249,185) )//Sonntagsspalte

DEFINE BRUSH oBrush COLOR RGB(255,255,255)
DEFINE FONT planFont NAME "ARIAL" SIZE 0,-11

***

DEFINE WINDOW oWndPlan TITLE "Kalender" ;
HSCROLL ;
FROM 5, 5 TO 24, 98

oWndPlan:bLClicked := { |x,y,flags | f_bLClicked(x,y) }
oWndPlan:bMMoved := { |x,y,flags | f_MMoved(x,y) }
oWndPlan:bLButtonUp := { |x,y,flags | f_LButtonUp(x,y) }

/* ********** added by rochinha ********** */
oWndPlan:cTitle := "Kalender [ " + str(nYear,4) + " ]"
/* ********** added by rochinha ********** */

/* ********** added by rochinha ********** */
oWndPlan:oHScroll:bGoUp := {|| PreviousYear() }
oWndPlan:oHScroll:bGoDown := {|| NextYear() }
/* ********** added by rochinha ********** */

ACTIVATE WINDOW oWndPlan ON PAINT DrawRowLines()

return nil

func PreviousYear() /* ********** added by rochinha ********** */
nYear := nYear - 1
DrawRowLines()
oWndPlan:refresh()
oWndPlan:cTitle := "Kalender [ " + str(nYear,4) + " ]"
return .t.

func NextYear() /* ********** added by rochinha ********** */
nYear := nYear + 1
DrawRowLines()
oWndPlan:refresh()
oWndPlan:cTitle := "Kalender [ " + str(nYear,4) + " ]"
return .t.

func DrawRowLines ()
//Charles
local aInfo := oWndPlan:DispBegin()
//Charles

LOCAL I, nCurrentRows, iZeile
LOCAL cHeader1 := ""
LOCAL oSay
LOCAL hdc
LOCAL aDays := {;
"So","Mo","Di", "Mi", "Do", "Fr", "Sa","So",;
"Mo","Di", "Mi", "Do", "Fr", "Sa","So",;
"Mo","Di", "Mi", "Do", "Fr", "Sa","So",;
"Mo","Di", "Mi", "Do", "Fr", "Sa","So",;
"Mo","Di", "Mi", "Do", "Fr", "Sa","So","Mo" }

/* blocked by rochinha
LOCAL nYear := YEAR( DATE() ) */
LOCAL cYear := STR( nYear, 4 )
LOCAL dDate, nStart
LOCAL lSchaltJahr := ( DAY( CTOD( "29.02." + cYear ) ) <> 0 )
LOCAL aDaysInMonth := { 31, IIF( lSchaltJahr, 29, 28 ), 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 }
LOCAL nColOffSet := 10
LOCAL aRect1
LOCAL IMonate := 0
LOCAL ITemp := 0
local cTest := ""
local nEnde

FOR IMonate := 1 TO 12

aadd(aPlan,{"","","", "", "", "", "","",;
"","", "", "", "", "","",;
"","", "", "", "", "","",;
"","", "", "", "", "","",;
"","", "", "", "", "","","",0,0,0 } )

NEXT

aRect1 := { 0,0,500,1000}
FillRect(oWndPlan:hDc,aRect1,oBrush:hBrush)
iZeile := 0
nCurrentRows := 30

FOR I := 1 TO 13

SelectObject( oWndPlan:hDc, hPen )
IF iZeile = 5
SelectObject( oWndPlan:hDc, hPen1 )
iZeile := 0
ENDIF

//Lines
oWndPlan:line (nCurrentRows, 1,nCurrentRows, 726 )
nCurrentRows := nCurrentRows + 18
iZeile := iZeile + 1

NEXT

nCurrentRows:= 50

FOR I := 1 TO 38

SelectObject( oWndPlan:hDc, hPen )
IF iZeile = 5
SelectObject( oWndPlan:hDc, hPen1 )
iZeile := 0
ENDIF

oWndPlan:line (10,nColOffSet + nCurrentRows,400, nColOffSet + nCurrentRows )
nCurrentRows := nCurrentRows + 18
iZeile := iZeile + 1

NEXT

nCurrentRows:= 50

FOR I := 1 TO len(aDays)

if aDays = "So"

//Farbhintergrund Sonntag
SelectObject( oWndPlan:hDc, hPen3 )

// Sonntag erste fette Linie
oWndPlan:line (0,nColOffSet+ 10 + nCurrentRows,400, nColOffSet+ 10 + nCurrentRows )

SelectObject( oWndPlan:hDc, hPen )
oWndPlan:say( 8, nColOffSet+36+I*18,aDays,RGB(255,128,0), RGB(125,236,175),planFont,.T.)

else
oWndPlan:say( 8, nColOffSet+36+I*18,aDays,RGB(255,128,0),16777215,planFont,.T.)

endif

nCurrentRows := nCurrentRows + 18

NEXT

nCurrentRows := 12

FOR I := 1 TO 12

SelectObject( oWndPlan:hDc, hPen )
IF iZeile = 5
SelectObject( oWndPlan:hDc, hPen1 )
iZeile := 0
ENDIF

nCurrentRows := nCurrentRows + 18
dDate := CTOD( "01." + PADL( ALLTRIM(STR( i, 2 )), 2, "0" ) + "." + cYear )
nStart := DOW( dDate )
aPlan[I,38] := nStart
aPlan[I,39] := 30-18+ (18*( aDaysInMonth + nStart - 1 )) //col begin of month
aPlan[I,40] := nStart + aDaysInMonth //col end of month

FOR iZeile := nStart TO aDaysInMonth + nStart - 1
aPlan[I,iZeile] = ( PADL( ALLTRIM(STR( (iZeile-nStart+1), 2 )), 2, "0" )+ "." + PADL( ALLTRIM(STR( (I), 2 )), 2, "0" ) + "." + cYear )
NEXT

cHeader1 := OemToAnsi( CMONTH( dDate ) ) //Monate
oWndPlan:say( nCurrentRows+1, 2, cHeader1,RGB(63,63,63),16777215,planFont,.T.)

NEXT

IF (sx > 0 .AND. sx < 13) .AND. (sy > 0 .AND. sy < 38)

IF lMove = .t.
IZeile := INT((sxTemp-30)/18 ) + 1
aTemp[IZeile,1]:=10

FOR ITemp := IZeile+1 TO 12
aTemp[ITemp,1]:=0
NEXT

FOR ITemp := 1 TO 12

if aTemp[ITemp,1] > 0
if syTemp > aPlan[ITemp,39] + aPlan[ITemp,38]*18
syTemp := aPlan[ITemp,39] + aPlan[ITemp,38]*18
endif

IF 30-18+ (18*(ITemp)) >= ClickRow .AND. ;
.NOT. (30-18+ (18*(ITemp)) = ClickRow .AND. ;
ClickCol > syTemp)

FillRect( oWndPlan:hDc, { 30-18+ (18*(ITemp)),ClickCol, 30 +(18*(ITemp)), syTemp}, hBru )

IF ITemp > nStartZeile
FillRect( oWndPlan:hDc, { 30-18+ (18*(ITemp-1)),ClickCol, 30 +(18*(ITemp-1)), (30 +( 13 + 18*(aPlan[ITemp-1,40]))) }, hBru )
FillRect( oWndPlan:hDc, { 30-18+ (18*(ITemp)), 30 + 13 + (18*(aPlan[ITemp,38])), 30 +(18*(ITemp)), syTemp}, hBru )
ENDIF

else
FillRect( oWndPlan:hDc, {ClickRow,ClickCol,ClickRow+18,ClickCol+18}, hBru )
ENDIF
endif
NEXT
ENDIF
ENDIF

nCurrentRows := 12

FOR I := 1 TO 12

SelectObject( oWndPlan:hDc, hPen )
IF iZeile = 5
SelectObject( oWndPlan:hDc, hPen1 )
iZeile := 0
ENDIF

nCurrentRows := nCurrentRows + 18
dDate := CTOD( "01." + PADL( ALLTRIM(STR( i, 2 )), 2, "0" ) + "." + cYear )
nStart := DOW( dDate )

aPlan[I,38] := nStart
aPlan[I,39] := 30-18+ (18*( aDaysInMonth + nStart - 1 )) //col begin of month
aPlan[I,40] := nStart + aDaysInMonth //col end of month

FOR iZeile := nStart TO aDaysInMonth + nStart - 1

cHeader1 := ALLTRIM(str(iZeile-nStart+1)) //Tage
if aDays[iZeile] = "So"
oWndPlan:say( nCurrentRows+3,36 + nColOffSet + (iZeile) *18, ;
cHeader1, RGB(63,63,63),RGB(125,236,175),planFont,.T.,.T.)
else
oWndPlan:say( nCurrentRows+3,36 + nColOffSet + (iZeile) *18, ;
cHeader1, RGB(63,63,63),16777215,planFont,.T., .T.)
ENDIF
NEXT
NEXT

IF (sx > 0 .AND. sx < 13) .AND. (sy > 0 .AND. sy < 38)
oWndPlan:say(sxTemp+20, syTemp-20, aPlan[sx, sy] + " # "+str(ctod(aPlan[sx, sy])-ctod(startDay)+ 1), RGB(63,63,63), RGB(125,236,175), planFont, .T. )
endif

oWndPlan:DispEnd( aInfo )

return nil

func f_LButtonUp(x,y)

IF sy > 0 // Quique
msginfo(startDay + " -- " + aPlan[sx, sy] + " Tage: " + str( ctod(aPlan[sx, sy])-ctod(startDay) +1 ))
ENDIF
lMove:=.f.

return nil

func f_MMoved(x,y)
IF sx <> (INT((x-30)/18 ) + 1) .OR. sx <> (INT( (y-50-10)/18 ) + 1 )
sx := INT((x-30)/18 ) + 1
sy := INT((y-50-10)/18 ) + 1

IF x < 30
sx := 0
x := 0
ENDIF

sxTemp := x
syTemp := 59 + sy * 18

oWndPlan:refresh()

ENDIF

return nil

func f_bLClicked(x,y)
local ITemp:=0

sx := INT((x-30)/18 ) + 1
sy := INT((y-50-10)/18 ) + 1

IF sy > 0 // Quique
startDay := aPlan[sx, sy]
nStartZeile := sx
ClickCol := INT((y - 30)/18)*18 + 18 + 7
ClickRow := (INT((x-30)/18 ))*18 + 30

FOR ITemp := 1 TO 12
aTemp[ITemp,1]:=0
NEXT

FillRect( oWndPlan:hDc, {ClickRow,ClickCol,ClickRow+18,ClickCol+18}, hBru )
oWndPlan:refresh()

lMove:=.t.
ENDIF

return nil
Top
User avatar
Andrés González
Posts: 625
Joined: Thu Jan 19, 2006 10:45 am
Location: Mallorca

Post by Andrés González »

Otto something wrong put the code in inside of code labels... some funny faces are inside.

I arranged the code, but in both examples when you try to mark de days the last days are not marked. Try to mark from 1/1/08 to 31/12/08 the last days will be not marked. But the result ist correct they say the days correctly and the nember of the days also correctly. The wrong days are 29,30,31 / 12/ year.... if you try other month work perfectly.

.
Saludos

Andrés González desde Mallorca
Top
User avatar
Otto
Posts: 4470
Joined: Fri Oct 07, 2005 7:07 pm
Contact:
Contact Otto

Post by Otto »

Code: Select all

// This sample shows how to create  pickdate.

#include "FiveWin.ch"

//----------------------------------------------------------------------------//

function Main()
   LOCAL oPickDate

   oPickDate := TPickdate():New()
   oPickDate:nWidth      := 14
   oPickDate:nHeight     := 30

   msginfo(oPickDate:GetDate())
   oPickDate:end()


return nil


********************************************************************************
*** CLASS Tpickdate
********************************************************************************

//----------------------------------------------------------------------------//

#include "FiveWin.ch"


//-----------------------------------------------------------------//

CLASS Tpickdate
   DATA VERSION
   DATA nYear
   DATA nWidth,nHeight,nStartCols,nStartRow
   DATA oWnd,planFont,sy,sx
   DATA ClickRow,syTemp,sxTemp,ClickCol
   DATA aPlan,nStartZeile
   DATA startDay,endDay,oBrush,lMove
   DATA hBru,hPen,hPen1,hPen3,aTemp

    METHOD New()

    method PreviousYear()

    method NextYear()

    method GetDate()

    method LButtonUp(x,y)

    method bLClicked(x,y)

    method DrawRowLines ()

    method MMoved(x,y)

    METHOD End()

ENDCLASS

//-----------------------------------------------------------------//

METHOD New() CLASS Tpickdate

   ::VERSION     := "1.0.0"
   ::nWidth      := 10
   ::nHeight     := 10
   ::nStartCols  := 50
   ::nStartRow   := 30
   ::nYear       := YEAR( DATE() )
   ::hBru        := CreateSolidBrush( RGB(217,230,246) )

   ::hPen        := CreatePen( 0, 1, 12632256 )
   ::hPen1       := CreatePen( 0, 1, 280 )
   ::hPen3       := CreatePen( 0, ::nWidth,RGB(183,249,185) ) //Sonntagsspalte

   DEFINE BRUSH ::oBrush  COLOR RGB(255,255,255)
   DEFINE FONT  ::planFont NAME "ARIAL" SIZE  0,-11

   ::sy          := 1
   ::sx          := 1
   ::syTemp      := 0
   ::sxTemp      := 0

   ::aPlan       := {}
   ::ClickCol    := 0
   ::ClickRow    := 0
   ::startDay    := ""
   ::endDay      := ""
   ::lMove       := .f.
   ::aTemp       := {}
   ::nStartZeile := 0


   aadd(::aTemp,{0,0})                          // 1
   aadd(::aTemp,{0,0})                          // 2
   aadd(::aTemp,{0,0})                          // 3
   aadd(::aTemp,{0,0})                          // 4
   aadd(::aTemp,{0,0})                          // 5
   aadd(::aTemp,{0,0})                          // 6
   aadd(::aTemp,{0,0})                          // 7
   aadd(::aTemp,{0,0})                          // 8
   aadd(::aTemp,{0,0})                          // 9
   aadd(::aTemp,{0,0})                          // 10
   aadd(::aTemp,{0,0})                          // 11
   aadd(::aTemp,{0,0})                          // 12

   SET DATE GERMAN


return Self
//----------------------------------------------------------------------------//


method GetDate()
local cZeitraum := ""
   local oSelf:= Self

   ::hPen3       := CreatePen( 0, ::nWidth,RGB(183,249,185) ) //Sonntagsspalte

   DEFINE WINDOW ::oWnd TITLE "Kalender" ;
      VSCROLL        ;
      FROM 5, 5 TO 24, 98

   ::oWnd:bLClicked        := { |x,y,flags | ::bLClicked(x,y) }
   ::oWnd:bMMoved          := { |x,y,flags | ::MMoved(x,y) }
   ::oWnd:bLButtonUp       := { |x,y,flags | ::LButtonUp(x,y) }

   ::oWnd:cTitle           := "Kalender [ " + str(::nYear,4) + " ]"

   ::oWnd:oVScroll:bGoUp   := {|| ::PreviousYear() }
   ::oWnd:oVScroll:bGoDown := {|| ::NextYear() }

   ACTIVATE WINDOW ::oWnd ON INIT (oSelf:oWnd:nWidth( oSelf:nStartCols + 38 * oSelf:nWidth + oSelf:nWidth + oSelf:nWidth),;
      oSelf:oWnd:nHeight(oSelf:nStartRow + 13 * oSelf:nHeight   ) );
      ON PAINT ::DrawRowLines() VALID ((cZeitraum := ::startDay + " -- " + ::endDay + "    Tage: " + str( ctod(::endDay)-ctod(::startDay)  +1   )),.t.)

return (cZeitraum)
//-----------------------------------------------------------------//

method PreviousYear()
::nYear := ::nYear - 1
::DrawRowLines()
::oWnd:refresh()
::oWnd:cTitle := "Kalender [ " + str(::nYear,4) + " ]"
return .t.
//-----------------------------------------------------------------//

method NextYear()
::nYear := ::nYear + 1
::DrawRowLines()
::oWnd:refresh()
::oWnd:cTitle := "Kalender [ " + str(::nYear,4) + " ]"
return .t.
//-----------------------------------------------------------------//

method LButtonUp(x,y)
   ::endDay := ::aPlan[::sx,::sy]

   IF ::sy > 0 .AND. ::sx > 0
      if msgYesNo(::startDay + " -- " + ::endDay + "    Tage: " + str( ctod(::endDay)-ctod(::startDay)  +1   ))=.t.
         ::oWnd:end()
      endif
   ENDIF
   ::lMove:=.f.
return nil
//-----------------------------------------------------------------//

method bLClicked(x,y)
   local ITemp := 0

   ::sx := INT((x - ::nStartRow)/::nHeight ) + 1
   ::sy := INT((y - ::nStartCols)/::nWidth )

   IF ::sy > 0 .AND. ::sx > 0
      ::startDay    := ::aPlan[::sx,::sy]
      ::nStartZeile := ::sx
      ::ClickRow    := (INT((x-::nStartRow)/::nHeight ))*::nHeight + ::nStartRow
      ::ClickCol    :=  ::nStartCols + ::sy * ::nWidth

      FOR ITemp := 1 TO 12
         ::aTemp[ITemp,1]:=0
      NEXT

      ::oWnd:refresh()

      ::lMove:=.t.
   ENDIF
return nil
//-----------------------------------------------------------------//

method DrawRowLines ()
   local aInfo := ::oWnd:DispBegin()
   local I, nCurrentRows, iZeile
   local nCurrentCol
   local cHeader1 := ""
   local oSay
   local hdc
   local aDays        := {;
      "So","Mo","Di", "Mi", "Do", "Fr", "Sa","So",;
      "Mo","Di", "Mi", "Do", "Fr", "Sa","So",;
      "Mo","Di", "Mi", "Do", "Fr", "Sa","So",;
      "Mo","Di", "Mi", "Do", "Fr", "Sa","So",;
      "Mo","Di", "Mi", "Do", "Fr", "Sa","So","Mo" }

   local cYear        := STR( ::nYear, 4 )
   local dDate, nStart
   local lSchaltJahr  := ( DAY( CTOD( "29.02." + cYear ) ) <> 0 )
   local aDaysInMonth := { 31, IIF( lSchaltJahr, 29, 28 ), 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 }
   local aRect1
   local IMonate      := 0
   local ITemp        := 0
   local cTest        := ""
   local nEnde
   local iSpalte      := 0
   local nRight
   local nBottom
   local nLeft
   local nTop

   FOR IMonate := 1 TO 12
       aadd(::aPlan,{"","","", "", "", "", "","",;
         "","", "", "", "", "","",;
         "","", "", "", "", "","",;
         "","", "", "", "", "","",;
         "","", "", "", "", "","","",0,0,0 } )
   NEXT

   aRect1 := { 0,0,  ::nStartRow + (13 * ::nHeight) ,::nStartCols + (38 * ::nWidth) + ::nWidth} //procl
   FillRect(::oWnd:hDc,aRect1,::oBrush:hBrush)
   iZeile  := 0

   nCurrentCol := ::nStartCols

   FOR I := 1 TO  38

      SelectObject( ::oWnd:hDc, ::hPen )
      IF iZeile = 5
         SelectObject( ::oWnd:hDc, ::hPen1 )
         iZeile := 0
      ENDIF

      //vertikale Linie zw. Tage
      ::oWnd:line (10, ::nWidth + nCurrentCol, ::nStartRow + (13 * ::nHeight), ::nWidth + nCurrentCol )

      nCurrentCol := nCurrentCol +  ::nWidth
      iZeile := iZeile + 1

   NEXT

   nCurrentCol := ::nStartCols

   FOR I := 1 TO len(aDays)
      if aDays[I] = "So"
         //Farbhintergrund Sonntag
         SelectObject( ::oWnd:hDc, ::hPen3 )

         // Sonntag  erste fette Linie
         ::oWnd:line (0, ::nWidth + ::nWidth/2  + nCurrentCol,::nStartRow + (13 * ::nHeight), ::nWidth + ::nWidth/2 + nCurrentCol )

         SelectObject( ::oWnd:hDc, ::hPen )
         ::oWnd:say( 8, ::nWidth+36+I* ::nWidth,aDays[I],RGB(255,128,0), RGB(125,236,175),::planFont,.T.)
      else
         ::oWnd:say( 8, ::nWidth+36+I*::nWidth,aDays[I],RGB(255,128,0),16777215,::planFont,.T.)
      endif
      nCurrentCol := nCurrentCol +  ::nWidth
   NEXT

   nCurrentRows := ::nStartRow

   FOR I := 1 TO  13

      SelectObject( ::oWnd:hDc, ::hPen )
      IF iZeile = 5
         SelectObject( ::oWnd:hDc, ::hPen1 )
         iZeile := 0
      ENDIF

      //Lines
      ::oWnd:line (nCurrentRows, 1,nCurrentRows, ::nStartCols+ 38 * ::nWidth ) //726

      nCurrentRows := nCurrentRows + ::nHeight
      iZeile := iZeile + 1
   NEXT


   nCurrentRows := 12

   FOR I := 1 TO  12

      SelectObject( ::oWnd:hDc, ::hPen )
      IF iZeile = 5
         SelectObject( ::oWnd:hDc, ::hPen1 )
         iZeile := 0
      ENDIF

      nCurrentRows := nCurrentRows +  ::nHeight
      dDate  := CTOD( "01." + PADL( ALLTRIM(STR( i, 2 )), 2, "0" ) + "." + cYear )
      nStart := DOW( dDate )

      ::aPlan[I,38]   :=  nStart
      ::aPlan[I,39]   :=  ::nStartCols + ::nWidth * nStart //- ::nWidth //col begin of month
      ::aPlan[I,40]   :=  nStart + aDaysInMonth[i]  //col end of month

      FOR iSpalte := nStart TO aDaysInMonth[i] + nStart - 1
         ::aPlan[I,iSpalte] =    ( PADL( ALLTRIM(STR( (iSpalte-nStart+1), 2 )), 2, "0" )+ "." + PADL( ALLTRIM(STR( (I), 2 )), 2, "0" ) + "." + cYear )
      NEXT

      cHeader1 :=   OemToAnsi( CMONTH( dDate ) )//Monate
      ::oWnd:say( nCurrentRows+1, 2, cHeader1,RGB(63,63,63),16777215,::planFont,.T.)

   NEXT

   IF (::sx > 0 .AND. ::sx < 13)  .AND.  (::sy > 0 .AND. ::sy < 38)

      IF ::lMove = .t.

         IZeile := ::sx

         ::aTemp[IZeile,1] := 10

         FOR ITemp := IZeile+1 TO 12
            ::aTemp[ITemp,1] := 0
         NEXT

         FOR ITemp := 1 TO 12

            if ::aTemp[ITemp,1] > 0

               IF ctod(::aPlan[::sx,::sy]) > ctod("  .  .    ")
                  FillRect( ::oWnd:hDc, {::ClickRow,;
                     ::ClickCol,;
                     ::ClickRow+::nHeight,;
                     ::ClickCol+::nWidth}, ::hBru )

                  IF ::nStartRow-::nHeight + (::nHeight*(ITemp)) = ::ClickRow .OR. IZeile=1
                     nTop       := ::nStartRow - ::nHeight  + (::nHeight*(ITemp))
                     nLeft      := ::ClickCol
                     IF ::ClickCol < ::aPlan[ITemp,39]
                        nLeft    :=   ::aPlan[ITemp,39]
                     ENDIF

                     nBottom    := ::nStartRow  + (::nHeight*(ITemp))
                     nRight     := ::syTemp
                     IF ::syTemp > nLeft
                        IF ::syTemp <=  ::nStartCols+::aPlan[ITemp,40]*::nWidth
                           FillRect( ::oWnd:hDc, {nTop,;
                              nLeft,;
                              nBottom,;
                              nRight },::hBru)
                        ENDIF
                     ENDIF

                  ELSEIF ITemp > ::nStartZeile

                     **********
                     IF ITemp > ::nStartZeile+1

                     nTop       := ::nStartRow - ::nHeight  + (::nHeight*(ITemp-1))
                     nLeft      := ::aPlan[ITemp-1,39]

                     nBottom    := ::nStartRow  + (::nHeight*(ITemp-1))
                     nRight     := ::nStartCols +( ::nWidth*(::aPlan[ITemp-1,40]))

                     IF  ::syTemp >=   ::aPlan[ITemp,39]
                        IF ::syTemp <=  ::nStartCols+::aPlan[ITemp,40]*::nWidth
                           FillRect( ::oWnd:hDc, {nTop,;
                              nLeft,;
                              nBottom,;
                              nRight },::hBru)
                        ENDIF

                     ENDIF
                     ENDIF


                     ***********


                     nTop       := ::nStartRow - ::nHeight  + (::nHeight*(ITemp))
                     nLeft      := ::aPlan[ITemp,39]

                     nBottom    := ::nStartRow  + (::nHeight*(ITemp))
                     nRight     := ::syTemp

                     IF  ::syTemp >=   ::aPlan[ITemp,39]
                        IF ::syTemp <=  ::nStartCols+::aPlan[ITemp,40]*::nWidth
                           FillRect( ::oWnd:hDc, {nTop,;
                              nLeft,;
                              nBottom,;
                              nRight },::hBru)
                        ENDIF

                     ENDIF

                     nTop       :=   ::nStartRow-::nHeight+ (::nHeight*(ITemp-1))
                     nLeft      :=   ::ClickCol
                     IF ::ClickCol < ::aPlan[ITemp-1,39]
                        nLeft      :=   ::aPlan[ITemp-1,39]
                     ENDIF

                     nBottom    :=   ::nStartRow +(::nHeight*(ITemp-1))
                     nRight     :=   ::nStartCols +( ::nWidth*(::aPlan[ITemp-1,40]))

                     FillRect( ::oWnd:hDc, {nTop,;
                        nLeft,;
                        nBottom,;
                        nRight }, ::hBru )

                  else
                  ENDIF
               ENDIF
            endif
         NEXT

      ENDIF
   ENDIF

   nCurrentRows := 12

   FOR I := 1 TO  12

      SelectObject( ::oWnd:hDc, ::hPen )
      IF iZeile = 5
         SelectObject( ::oWnd:hDc, ::hPen1 )
         iZeile := 0
      ENDIF

      nCurrentRows := nCurrentRows +  ::nHeight
      dDate := CTOD( "01." + PADL( ALLTRIM(STR( i, 2 )), 2, "0" ) + "." + cYear )
      nStart := DOW( dDate )

      FOR iZeile := nStart TO aDaysInMonth[i] + nStart - 1
         cHeader1 :=    ALLTRIM(str(iZeile-nStart+1)) //Tage
         if aDays[iZeile] = "So"
            ::oWnd:say( nCurrentRows+3,36 + ::nWidth + (iZeile) * ::nWidth,  cHeader1, RGB(63,63,63),RGB(125,236,175),::planFont,.T.,.T.)
         else
            ::oWnd:say( nCurrentRows+3,36 + ::nWidth + (iZeile)  * ::nWidth, cHeader1, RGB(63,63,63),16777215,::planFont,.T., .T.)
         ENDIF
      NEXT
   NEXT

   IF (::sx > 0 .AND. ::sx < 13)  .AND.  (::sy > 0 .AND. ::sy < 38)
      ::oWnd:say(::sxTemp+20, ::syTemp-20,  ::aPlan[::sx,::sy] + " # "+str(ctod(::aPlan[::sx,::sy])-ctod(::startDay)+ 1), RGB(63,63,63), RGB(125,236,175), ::planFont, .T. )
   endif

   ::oWnd:DispEnd( aInfo )

return nil
//-----------------------------------------------------------------//

method MMoved(x,y)

   IF ::sx <>  (INT((x-::nStartRow)/::nHeight ) + 1) .OR. ::sx <> (INT( (y-::nStartCols )/::nHeight ) + 1 )
      ::sx := INT((x-::nStartRow)/::nHeight ) + 1
      ::sy := INT((y -::nStartCols )/::nWidth )

      IF x < ::nStartRow
         ::sx  := 0
         x     := 0
      ENDIF

      ::sxTemp :=   ::nStartRow +  ::sx * ::nHeight
      ::syTemp :=   ::nStartCols +  ::sy * ::nWidth +  ::nWidth

      ::oWnd:refresh()

   ENDIF

return nil
//-----------------------------------------------------------------//


METHOD End()

   RELEASE FONT ::planFont

   ::hBru:end()
   ::hPen:end()
   ::hPen1:end()
   ::hPen3:end()



return NIL
//-----------------------------------------------------------------//
Last edited by Otto on Sat Jul 26, 2008 8:06 pm, edited 1 time in total.
Top
User avatar
Andrés González
Posts: 625
Joined: Thu Jan 19, 2006 10:45 am
Location: Mallorca

Post by Andrés González »

Hay que seguir en el foro ingles:

http://forums.fivetechsoft.com/viewtopic.php?t=12021[/url]
Saludos

Andrés González desde Mallorca
Top
User avatar
quique
Posts: 408
Joined: Sun Aug 13, 2006 5:38 am
Contact:
Contact quique

Post by quique »

Gracias Otto, ¿puedes ponerlo dentro de un bloque de código para no perder el formato del programa y simbolos que se pierden por los emoticons?

Andy, creo que está bien que esté aquí también, porque no todos hablamos ingles.
Saludos
Quique
Top
User avatar
Andrés González
Posts: 625
Joined: Thu Jan 19, 2006 10:45 am
Location: Mallorca

Post by Andrés González »

Tienes razon Quique perdona pero como lo encontre en el foro ingles no reparé en poner el mensaje.
Saludos

Andrés González desde Mallorca
Top
User avatar
Andrés González
Posts: 625
Joined: Thu Jan 19, 2006 10:45 am
Location: Mallorca

Post by Andrés González »

Thanks Otto for transforming into a Class.

Gracias Otto por transformala en una Classe.
Saludos

Andrés González desde Mallorca
Top
User avatar
Otto
Posts: 4470
Joined: Fri Oct 07, 2005 7:07 pm
Contact:
Contact Otto

Post by Otto »

http://forums.fivetechsoft.com/viewtopic.php?t=12150

I have new sourcecode on the English forum.

Regrads,
Otto
Top
User avatar
Otto
Posts: 4470
Joined: Fri Oct 07, 2005 7:07 pm
Contact:
Contact Otto

Post by Otto »

To all,

Antonio published the full sourcecode of the new pickdate control and a demo sample on the English forum.
Antonio, thank you very much for your help.
Regards,
Otto
Image
Top
User avatar
Alfredo Arteaga
Posts: 326
Joined: Sun Oct 09, 2005 5:22 pm
Location: Mexico
Contact:
Contact Alfredo Arteaga

Post by Alfredo Arteaga »

Gracias Otto, Antonio, Manuel. Ya la tengo en uso:

Image
Top
Post Reply

Return to “FiveWin para Harbour/xHarbour”