Pickdate

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

Post by Otto »

Hello Rochina, hello Kleyber,

I cleaned the code very much today. I will publish tomorrow the cleaned source code.

Then I try to make a class out of this.
Kleyber,

Now I have:
STATIC nWidth := 30
static nHeight := 50
so if you amount nWidth you can have more characters,


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

Post by Otto »

Here is my first attempt with a class design.

Regards,
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
//-----------------------------------------------------------------//

User avatar
Silvio
Posts: 3107
Joined: Fri Oct 07, 2005 6:28 pm
Location: Teramo,Italy

Post by Silvio »

i think U made some errors..
Umust create the pickdate as a object control..and the put it into oWnd or odlg

sample :
define window ownd
opick:=Tpickdate():New(ownd)
Activate window ownd

methods....
New constructor
Redefine
paint
default
end
lbuttonleft
lbuttonright
mousemove
destroy
or add a method activate


If U want i can tryto help u and to create something
Best Regards, Saludos

Falconi Silvio
User avatar
Otto
Posts: 4470
Joined: Fri Oct 07, 2005 7:07 pm
Contact:

Post by Otto »

Hello Silvio,

thank you for your broad minded offer to help.
All my source code is here. Please go ahead and post back your results.
I look forward seeing your results.
Thanks in advance
Otto
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Post by Antonio Linares »

Otto,

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

"Double buffer" painting, to avoid "flickering" on re-painting.
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Silvio
Posts: 3107
Joined: Fri Oct 07, 2005 6:28 pm
Location: Teramo,Italy

Post by Silvio »

Otto ,
If U pick and large the window the picdate not refresh !!
Best Regards, Saludos

Falconi Silvio
User avatar
Silvio
Posts: 3107
Joined: Fri Oct 07, 2005 6:28 pm
Location: Teramo,Italy

Post by Silvio »

there's some problems... I an in Holyday and I not have here my manuals and lib

I made this class :

Code: Select all

#include "FiveWin.ch"

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

function Main()
   LOCAL oPickDate
   Local oWnd

    SET DATE GERMAN

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


   oPickDate := TPickdate():New(30,50,20,30,oWnd)



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



   ACTIVATE WINDOW oWnd;
   ON RESIZE    oPickDate:Paint()

return nil



CLASS Tpickdate FROM  TControl


   DATA nStartRow,  nStartCols
   DATA nWidth,nHeight
   DATA oplanFont,sy,sx

   DATA ClickRow,syTemp,sxTemp,ClickCol

   DATA startDay,endDay,oBrush

   DATA hBru,hPen1,hPen3

   DATA nClrText,nClrPane

   DATA lMove AS LOGIC INIT .F.
   DATA aPlan AS ARRAY INIT {}
   DATA aTemp AS ARRAY INIT {}
   DATA nStartZeile INIT 0

   DATA nVersion
   DATA nYear


   DATA lBorder
   Data hPen

   CLASSDATA lRegistered AS LOGICAL

   METHOD  New(nTop,nLeft,nWidth,nHeight,oWnd,nYear,lBorder,oplanFont,nClrFore,nClrBack,nVersion )
   METHOD  Initiate( hDlg ) INLINE Super:Initiate( hDlg ), ::Default()
   METHOD  Paint()
   METHOD  Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
   METHOD  Line( nTop, nLeft, nBottom, nRight, oPen )
   METHOD  SelectPen    ( hPen    )   INLINE SelectObject( ::hDC, hPen    )
   METHOD  End() INLINE ::Destroy()
   METHOD  Destroy()
   METHOD  LButtonUp( nRow, nCol, nKeyFlags )
   METHOD  Ldblclick( nRow, nCol, nKeyFlags )
   METHOD  MouseMove( nRow, nCol, nKeyFlags )
   METHOD  PreviousYear()
   METHOD  NextYear()


ENDCLASS






METHOD New(nTop,nLeft,nWidth,nHeight,oWnd,nYear,lBorder,oplanFont,nClrFore,;
   nClrBack,nVersion ) CLASS Tpickdate



           DEFAULT    nWidth      := 10 ,;
                      nHeight     := 10 ,;
                      nLeft := 50 ,;
                      nTop   := 30 ,;
                      nYear       := YEAR( DATE() ) ,;
                      nVERSION     := "1.0.0" ,;
                      oWnd := GetWndDefault()   ,;
                       lBorder     := .t.

              ::nWidth      := nWidth
              ::nHeight     := nHeight
              ::nStartCols  := nLeft
              ::nStartRow   := nTop
              ::nYear       := nYear
              ::lBorder     :=lBorder

       ::nStyle    = nOR( WS_CHILD, WS_VISIBLE, WS_CLIPSIBLINGS,;
                          WS_CLIPCHILDREN, WS_TABSTOP )

              ::oWnd := oWnd


                if ::oplanFont == nil
                     DEFINE FONT  ::oplanFont NAME "ARIAL" SIZE  0,-11
                  else
                   ::oplanFont := oplanFont
                endif



        ::nClrText  = nClrFore
        ::nClrPane := nClrBack








   ::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




  #ifdef __XPP__
      DEFAULT ::lRegistered := .f.
   #endif

   ::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )


    if ! Empty( oWnd:hWnd )
      ::Create()
      oWnd:AddControl( Self )
   else
      oWnd:DefControl( Self )
   endif




    Return self



METHOD Paint()  CLASS Tpickdate
   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



   ::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)


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


   aRect1 := { 0,0,  ::nStartRow + (13 * ::nHeight) ,::nStartCols ;
             + (38 * ::nWidth) + ::nWidth} //procl


     FillRect(  ::hDC,aRect1,::oBrush:hBrush)


   iZeile  := 0

   nCurrentCol := ::nStartCols

   FOR I := 1 TO  38
          ::SelectPen    ( ::hPen    )

      IF iZeile = 5
          ::SelectPen    (  ::hPen1    )
         iZeile := 0
      ENDIF

      //vertikale Linie zw. Tage

      ::oWnd:line( 10, ::nWidth + nCurrentCol, ::nStartRow + (13 * ::nHeight), ::nWidth + nCurrentCol,::hPen )


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

   NEXT

   nCurrentCol := ::nStartCols

   FOR I := 1 TO len(aDays)
      if aDays[I] = "So"
         //Farbhintergrund Sonntag

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

         ::SelectPen    (  ::hPen    )

        ::oWnd:say( 8, ::nWidth+36+I* ::nWidth,aDays[I],RGB(255,128,0), RGB(125,236,175),::oplanFont,.T.)



      else
        ::oWnd:say( 8, ::nWidth+36+I*::nWidth,aDays[I],RGB(255,128,0),16777215,::oplanFont,.T.)


      endif
      nCurrentCol := nCurrentCol +  ::nWidth
   NEXT

   nCurrentRows := ::nStartRow

   FOR I := 1 TO  13
                     ::SelectPen    (  ::hPen    )

      IF iZeile = 5
                    ::SelectPen    (  ::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,::oplanFont,.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),::oplanFont,.T.,.T.)
         else
            ::oWnd:say( nCurrentRows+3,36 + ::nWidth + (iZeile)  * ::nWidth, cHeader1, RGB(63,63,63),16777215,::oplanFont,.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), ::oplanFont, .T. )
   endif



       ::ReleaseDC()
   sysrefresh()




return nil

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


METHOD Line( nTop, nLeft, nBottom, nRight, hPen ) CLASS Tpickdate
  * local hPen := if( oPen = nil, 0, oPen:hPen )
   ::GetDC()
   MoveTo( ::hDC, nLeft, nTop )
   LineTo( ::hDC, nRight, nBottom, hPen )
   ::ReleaseDC()
return nil

//----------------------------------------------------------------------------//
 METHOD LButtonUp( nRow, nCol, nKeyFlags ) CLASS Tpickdate
    ::endDay := ::aPlan[::sx,::sy]

   IF ::sy > 0 .AND. ::sx > 0
      if msgYesNo(::startDay + " -- " + ::endDay + "    Tage: " +;
         str( ctod(::endDay)-ctod(::startDay)  +1   ))=.t.

      endif
   ENDIF
   ::lMove:=.f.

   return nil

//----------------------------------------------------------------------------//
METHOD Ldblclick( nRow, nCol, nKeyFlags )   CLASS Tpickdate

        local ITemp := 0

   ::sx := INT((nRow - ::nStartRow)/::nHeight ) + 1
   ::sy := INT((nCol - ::nStartCols)/::nWidth )

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

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

      sysrefresh()

      ::lMove:=.t.
   ENDIF
       Super:LDblClick( nRow, nCol, nKeyFlags )
      return nil


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


 METHOD MouseMove( nRow, nCol, nKeyFlags )    CLASS Tpickdate


    Super:MouseMove( nRow, nCol, nKeyFlags )

  if IsOverWnd( ::hWnd, nRow, nCol )
    if !::lCaptured
       ::Capture()
    endif
 else
    if !::lCaptured
       ReleaseCapture()
    endif
   ENDIF


if ::lMove

 IF ::sx <>  (INT((nRow-::nStartRow)/::nHeight ) + 1) .OR.;
    ::sx <>  (INT((nCol-::nStartCols )/::nHeight ) + 1 )


      ::sx := INT((nRow-::nStartRow)/::nHeight ) + 1
      ::sy := INT((nCol -::nStartCols )/::nWidth )

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

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

    endif
return NIL


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


  METHOD Destroy()    CLASS Tpickdate

   RELEASE FONT ::oplanFont

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



   return NIL



method PreviousYear()  CLASS Tpickdate
::nYear := ::nYear - 1
::Paint()
*::oWnd:refresh()
::oWnd:cTitle := "Kalender [ " + str(::nYear,4) + " ]"

return .t.
//-----------------------------------------------------------------//

method NextYear()     CLASS Tpickdate
::nYear := ::nYear + 1
::Paint()
*::oWnd:refresh()
::oWnd:cTitle := "Kalender [ " + str(::nYear,4) + " ]"

return .t.





To do :

a) the methods oPickDate:PreviousYear() and oPickDate:NextYear() not refresh the object

b) mousemove method sometimes work no
Best Regards, Saludos

Falconi Silvio
User avatar
Otto
Posts: 4470
Joined: Fri Oct 07, 2005 7:07 pm
Contact:

Post by Otto »

Hello Silvio,

thank you for your work.

>To do :

>a) the methods oPickDate:PreviousYear() and oPickDate:NextYear() not refresh the object

>b) mousemove method sometimes work no


I don’t see advantages in your design to create the window outside the class.
As I have no problems with my source I go ahead with my code.

Regards,
Otto
User avatar
Silvio
Posts: 3107
Joined: Fri Oct 07, 2005 6:28 pm
Location: Teramo,Italy

Post by Silvio »

because with the redefine method i can create also this control into a dialog not only in a window...what do you think about it ?

then on each box we can insert bitmaps to give an event as alarm or appoinment.

but if not like it go head with your source.

mine was only an
idea..
Best Regards, Saludos

Falconi Silvio
User avatar
quique
Posts: 408
Joined: Sun Aug 13, 2006 5:38 am
Contact:

Post by quique »

Silvio, I like the idea of a class
Saludos
Quique
User avatar
quique
Posts: 408
Joined: Sun Aug 13, 2006 5:38 am
Contact:

Post by quique »

Silvio, if you do it a control, I include it in the IDE I doing
Saludos
Quique
User avatar
Otto
Posts: 4470
Joined: Fri Oct 07, 2005 7:07 pm
Contact:

Post by Otto »

Hello Silvio,

how did you resolved the repaint in your TPlan class?
Maybe you can implement it this way?

Regards,
Otto
User avatar
Silvio
Posts: 3107
Joined: Fri Oct 07, 2005 6:28 pm
Location: Teramo,Italy

Post by Silvio »

Otto,
in your sources there are many variables not used , I'm compiling with w2 parameters.

I saw calanual.prg of Manuel : it is a strange but
Otto output and Manuel Output is the same ....

for quique
ok it run as a new control but there are error with mouse movement
Best Regards, Saludos

Falconi Silvio
User avatar
quique
Posts: 408
Joined: Sun Aug 13, 2006 5:38 am
Contact:

Post by quique »

Silvio also it lacks the horizontal scroll that added him to change of year
Saludos
Quique
User avatar
Otto
Posts: 4470
Joined: Fri Oct 07, 2005 7:07 pm
Contact:

Post by Otto »

Hello quique,

I think for vertical scrolling a period of 1 month is better.
I changed my code. I wait till Silvio posts his changes to implement the functionality.
Regrads,
Otto
Post Reply