www.FiveTechSoft.com
by Otto » Sun Dec 16, 2012 10:50 pm
by ukoenig » Mon Dec 17, 2012 9:44 am
FUNCTION WND_CLOSE(oWnd)
LOCAL nMinusW := oWnd:nWidth / 70, nMinusH := oWnd:nHeight / 70
LOCAL nT := oWnd:nTop, nL := oWnd:nLeft, nW := oWnd:nWidth, nH := oWnd:nHeight
I := 1
FOR I := 1 TO 30
INKEY(0.01)
nT := nT + nMinusH
nL := nL + nMinusW
nW := nW - ( 2 * nMinusW )
nH := nH - ( 2 * nMinusH )
oWnd:Move( nT, nL, nW, nH , .f. ) // Top, left, width, height
NEXT
oWnd:End()
RETURN NIL
by Otto » Mon Dec 17, 2012 10:10 am
/*
*
* WS.PRG
* Aug 07-2012 10:58 PM
*
*/
#include "FiveWin.Ch"
#include "adodef.ch"
#include "ord.ch"
#include "xbrowse.ch"
//----------------------------------------------------------------------------//
#define PRN_SINGLEDBF
#define DYN_BTNS
#define STANDALONE
//----------------------------------------------------------------------------//
REQUEST DBFCDX
//----------------------------------------------------------------------------//
static cPath := ""
static cStaffDBF := "STAFF.DBF"
static cToursDbf := "TOURS.DBF"
static cSchedDbf := "SCHED.DBF"
static cAliasSched, cAliasStaff, cAliasTours, cAliasFree, cAliasUrlaub
static oBrwRoster, oBrwFree, oBrwUrlaub
static oSay1, oSay2, oSay3
static oDragCur
static oBrwFocus
//----------------------------------------------------------------------------//
static dBOW, aWeeks
static aTours, aStaff, aRoster := {}
static nSelStaff := 0, nSelTour := 0, nSelWeek := 0
static nToursBias := 0, nStaffBias := 0
//----------------------------------------------------------------------------//
function Main()
InitVars()
CheckDbf()
OpenDbf()
SetWeek()
//
BrowseWnd()
CLOSE DATA
return (0)
//----------------------------------------------------------------------------//
init procedure PrgInit
SET DATE GERMAN
SET CENTURY ON
SET TIME FORMAT TO "HH:MM:SS"
SET EPOCH TO YEAR(DATE())-50
SET DELETED ON
SET EXCLUSIVE OFF
RDDSETDEFAULT( "DBFCDX" )
XbrNumFormat( 'E', .t. )
SetKinetic( .f. )
SetGetColorFocus()
SetBalloon( .t. )
return
//----------------------------------------------------------------------------//
exit procedure PrgExit
SET RESOURCES TO
return
//----------------------------------------------------------------------------//
static function BrowseWnd()
local oWnd, oBar, oFont, oBold, oLarg
local nBarHt, nCol, oCol, n
DEFINE CURSOR oDragCur DRAG
DEFINE FONT oLarg NAME "Segoe UI" SIZE 0,-20 BOLD
DEFINE FONT oFont NAME "Segoe UI" SIZE 0,-15
DEFINE FONT oBold NAME "Segoe UI" SIZE 0,-15 BOLD
DEFINE WINDOW oWnd TITLE "STAFF SCHEDULE" MENU TMenu():New()
oWnd:SetFont( oFont )
DEFINE BUTTONBAR oBar OF oWnd SIZE 64,68 2007
SET MESSAGE OF oWnd TO '' 2007
nBarHt := oBar:nHeight
@ nBarHt + 10, 10 SAY oSay1 VAR "Arbeitseinteilung „Sommer 2012“ " + ;
D2CDM( dBow ) + '/' + D2CDM( dBow + 6 ) + ;
" (Work Schedule - Staff Roster )" ;
SIZE 1000, 30 PIXEL OF oWnd TRANSPARENT ;
FONT oLarg UPDATE
@ nBarHt + 45, 00 XBROWSE oBrwRoster SIZE 0,150 PIXEL OF oWnd ;
DATASOURCE aRoster ;
COLUMNS 1, 2, 3, 4, 5, 6, 7, 8;
HEADERS "Schicht" ;
CELL LINES NOBORDER
BrwWeekHeaders( oBrwRoster )
oBrwRoster:aCols[ 1 ]:bStrData := { || ID2C( oBrwRoster:aRow[ 1 ], aTours ) }
for nCol := 2 to 8
oBrwRoster:aCols[ nCol ]:bStrData := RosterStrData( oBrwRoster:aCols[ nCol ] )
next
oBrwFocus := oBrwRoster
WITH OBJECT oBrwRoster
:lColChangeNotify := .t.
:bChange := { || CheckFocus() }
:bGotFocus := { |o| oBrwFocus := o, CheckFocus() }
:L2007 := .f.
:lRecordSelector := .f.
:lHScroll := .f.
:lVScroll := .f.
:nHeadStrAligns := AL_CENTER
:nDataStrAligns := AL_CENTER
:bClrSel := { || { CLR_BLACK, CLR_HGRAY } }
:bClrStd := { || ID2CLR( oBrwRoster:aCols[ 1 ]:Value ) }
//
:aCols[ 1 ]:lMergeVert := .t.
//
:oDragCursor := oDragCur
:bDragBegin := { |nRow,nCol,nFlags,oBrw| SetDropInfo( oBrw ) }
:bDropOver := { |uDropInfo, nRow, nCol, nFlags| DropOver( uDropInfo, nRow, nCol, nFlags, oBrwRoster ) }
//
:CreateFromCode()
END
@ nBarHt + 235, 10 SAY oSay2 VAR "Freie Tage" SIZE 1000,20 PIXEL OF oWnd FONT oBold TRANSPARENT
@ nBarHt + 270, 00 XBROWSE oBrwFree SIZE 0, 100 PIXEL OF oWnd ;
DATASOURCE cAliasFree ;
AUTOCOLS ;
CELL LINES NOBORDER COLOR CLR_BLACK, GetSysColor( 15 )
oBrwFree:aCols[ 1 ]:bStrData := { || ID2C( ( cAliasFree )->STAFFID, aStaff ) }
for nCol := 2 to 8
oBrwFree:aCols[ nCol ]:bStrData := SchedStrData( oBrwFree:aCols[ nCol ], 0, "Freie" )
next
WITH OBJECT oBrwFree
:lColChangeNotify := .t.
:bChange := { || CheckFocus() }
:bGotFocus := { |o| oBrwFocus := o, CheckFocus() }
:l2007 := .f.
:lRecordSelector := .f.
:lHeader := .f.
:lVScroll := :lHScroll := .f.
:bClrSel := { || { CLR_BLACK, CLR_HGRAY } }
:nDataStrAligns := AL_CENTER
//
:oDragCursor := oDragCur
:bDragBegin := { |nRow,nCol,nFlags,oBrw|SetDropInfo( oBrw ) }
:bDropOver := { | uDropInfo, nRow, nCol, nFlags| DropOver( uDropInfo, nRow, nCol, nFlags, oBrwFree ) }
//
:CreateFromCode()
// :bRClicked := { || xbrowse( oBrwFree:cAlias ) }
END
@ nBarHt + 372, 10 SAY oSay3 VAR "Urlaub" SIZE 300,20 PIXEL OF oWnd FONT oBold TRANSPARENT
@ nBarHt + 410, 00 XBROWSE oBrwUrlaub SIZE 0, 100 PIXEL OF oWnd ;
DATASOURCE cAliasUrlaub ;
COLUMNS "STAFFID", "MO", "DI", "MI", "DO", "FR", "SA", "SO" ;
CELL LINES NOBORDER
oBrwUrlaub:aCols[ 1 ]:bStrData := { || ID2C( ( cAliasUrlaub )->STAFFID, aStaff ) }
for nCol := 2 to 8
oBrwUrlaub:aCols[ nCol ]:bStrData := SchedStrData( oBrwUrlaub:aCols[ nCol ], -1, "Urlaub" )
next
WITH OBJECT oBrwUrlaub
:lColChangeNotify := .t.
:bChange := { || CheckFocus() }
:bGotFocus := { |o| oBrwFocus := o, CheckFocus() }
:l2007 := .f.
:lRecordSelector := .f.
:lHeader := .f.
:lVScroll := :lHScroll := .f.
:bClrSel := { || { CLR_BLACK, CLR_HGRAY } }
:nDataStrAligns := AL_CENTER
//
:oDragCursor := oDragCur
:bDragBegin := { |nRow,nCol,nFlags,oBrw| SetDropInfo( oBrw ) }
:bDropOver := { |uDropInfo,nRow,nCol,nFlags| DropOver( uDropInfo, nRow, nCol, nFlags, oBrwUrlaub ) }
//
:CreateFromCode()
END
DEFINE BUTTON OF oBar FILE "c:\fwh\bitmaps\calendar2.bmp" ;
PROMPT "Week" MENU PopMenuWeeks() ACTION This:ShowPopup()
DEFINE BUTTON OF oBar FILE "c:\fwh\bitmaps\users.bmp" ;
PROMPT "Staff" ACTION DlgStaff()
DEFINE BUTTON OF oBar FILE "c:\fwh\bitmaps\bitm.bmp" ;
PROMPT "Tours" ACTION DlgTours()
DEFINE BUTTON OF oBar FILE "c:\fwh\bitmaps\print32.bmp" ;
PROMPT "Print" ACTION ExportPrintDbf()
DEFINE BUTTON OF oBar GROUP ;
WHEN nSelStaff > 0 .and. nSelTour != 0 ;
PROMPT "Freie" ACTION BtnFreeAction()
DEFINE BUTTON OF oBar ;
WHEN nSelStaff > 0 .and. nSelTour >= 0 ;
PROMPT "Urlaub" ACTION BtnUrlaubAction()
#ifndef DYN_BTNS
DEFINE BUTTON OF oBar ;
PROMPT "Schicht" MENU PopTourMenu() ACTION This:ShowPopup()
#endif
DEFINE BUTTON OF oBar FILE "c:\fwh\bitmaps\32x32\exit.bmp" GROUP ;
PROMPT "Quit" ACTION oWnd:End()
#ifdef DYN_BTNS
for n := 1 to Len( aTours )
AddTourBtn( oBar, n )
next
#endif
ACTIVATE WINDOW oWnd MAXIMIZED ;
ON INIT ( oBrwRoster:SetFocus(), CheckFocus() ) ;
ON RESIZE OnResize() ;
ON PAINT OnPaint( hDC, oWnd )
RELEASE FONT oFont, oLarg
return nil
//----------------------------------------------------------------------------//
static function SchedStrData( oCol, nVal, cText )
//return { || If( Eval( oCol:bEditValue ) == nVal, cText, "" ) }
return { || If( Eval( oCol:bEditValue ) == nVal, ;
Eval( oCol:oBrw:acols[1]:bStrData ), "" ) }
//----------------------------------------------------------------------------//
static function RosterStrData( oCol )
return { || ID2C( Eval( oCol:bEditValue ), aStaff ) }
//----------------------------------------------------------------------------//
static function OnResize()
local oWnd := oBrwRoster:oWnd
local oRect := oWnd:GetCliRect
local nColWidth := Int( oRect:nWidth / 8 ) - 1
local nRow
WITH OBJECT oBrwRoster
:KeyCount()
:nWidths := nColWidth
:nHeight := :nHeaderHeight + :nLen * :nRowHeight
nRow := :nTop + :nHeight
END
nRow += 10
oSay2:nTop := nRow
nRow += ( oSay2:nHeight + 4 )
WITH OBJECT oBrwFree
:KeyCount()
:nTop := nRow
:nWidths := nColWidth
:nHeight := :nLen * :nRowHeight
nRow := :nTop + :nHeight
END
nRow += 10
oSay3:nTop := nRow
nRow += ( oSay3:nHeight + 4 )
WITH OBJECT oBrwUrlaub
:KeyCount()
:nTop := nRow
:nWidths := nColWidth
:nHeight := :nLen * :nRowHeight
nRow := :nTop + :nHeight
END
return nil
//----------------------------------------------------------------------------//
static function OnPaint( hDC, oWnd )
oWnd:Line( oBrwFree:nTop - 1, 0, oBrwFree:nTop - 1, oWnd:nWidth )
oWnd:Line( oBrwUrlaub:nTop - 1, 0, oBrwUrlaub:nTop - 1, oWnd:nWidth )
return nil
//----------------------------------------------------------------------------//
static function RefreshAll( lRoster )
DEFAULT lRoster := .f.
if lRoster
FillRoster()
endif
oBrwRoster:aCols[ 1 ]:WorkMergeData()
oBrwRoster:Refresh()
OnResize()
WndMain():Refresh()
oBrwRoster:Refresh()
oBrwFree:Refresh()
oBrwUrlaub:Refresh()
oBrwFocus:SetFocus()
CheckFocus()
return nil
//----------------------------------------------------------------------------//
static function DropOver( oBrwFrom, nRow, nCol, nFlags, oBrwThis )
local oCol
local nRecs, aPoint
if oBrwFrom == oBrwThis
return nil
endif
do case
case oBrwThis == oBrwRoster
aPoint := ClientToClient( oBrwFrom:hWnd, oBrwThis:hWnd, { nRow, nCol } )
IF apoint[1] <= 45 //Uwe
apoint[1] := 50
ENDIF
oBrwThis:LButtonDown( aPoint[ 1 ], aPoint[ 2 ], nFlags )
oBrwThis:LButtonUp()
oBrwThis:Refresh()
if oBrwFrom:nColSel == oBrwThis:nColSel
if StaffAllocate( oBrwFrom:aCols[ 1 ]:Value, oBrwFrom:nColSel, oBrwThis:aCols[ 1 ]:Value )
RefreshAll( .t. )
endif
endif
oBrwFrom:SetFocus()
case oBrwThis == oBrwFree
do case
case oBrwFrom == oBrwRoster
if StaffAllocate( oBrwFrom:SelectedCol():Value, oBrwFrom:nColSel, 0 )
RefreshAll( .t. )
endif
oBrwThis:SetFocus()
case oBrwFrom == oBrwUrlaub
if StaffAllocate( oBrwFrom:aCols[ 1 ]:Value, oBrwFrom:nColSel, 0 )
oBrwFrom:Refresh()
oBrwThis:Refresh()
endif
oBrwFrom:SetFocus()
endcase
case oBrwThis == oBrwUrlaub
do case
case oBrwFrom == oBrwRoster
if StaffAllocate( oBrwFrom:SelectedCol():Value, oBrwFrom:nColSel, -1 )
RefreshAll( .t. )
endif
oBrwThis:SetFocus()
case oBrwFrom == oBrwFree
if StaffAllocate( oBrwFrom:aCols[ 1 ]:Value, oBrwFrom:nColSel, -1 )
oBrwFrom:Refresh()
oBrwThis:Refresh()
endif
oBrwFrom:SetFocus()
endcase
endcase
CheckFocus()
return nil
//----------------------------------------------------------------------------//
static function StaffAllocate( nStaffID, nWeek, nWork )
local lDone := .f.
local nPresentWork
local nSerial, aStaff, nSaveRec
if nStaffID > 0 .and. nWeek > 1
if ( cAliasSched )->( DBSEEK( DTOS( dBow ) + Str( nStaffID, 3 ) ) )
if nWork != ( nPresentWork := ( cAliasSched )->( FieldGet( nWeek ) ) )
if nPresentWork > 0
// Tour. Need to renumber Serial Order
nSerial := AScan( ( aStaff := TourWeekStaff( nPresentWork, nWeek ) ), nStaffID )
if nSerial < Len( aStaff )
// Promote serial no of other staff
nSaveRec := ( cAliasSched )->( RECNO() )
for nSerial := nSerial + 1 to Len( aStaff )
if ( cAliasSched )->( DBSEEK( DTOS( dBow ) + Str( aStaff[ nSerial ], 3 ) ) )
RLOK()
( cAliasSched )->( FieldPut( nWeek, FieldGet( nWeek ) - 1 ) )
DBUNLOCK()
endif
next
( cAliasSched )->( DBGOTO( nSaveRec ) )
endif
endif
if nWork > 0
// Tour. Get SerialNo in the tour
nSerial := Len( TourWeekStaff( nWork, nWeek ) ) + 1
nWork := nWork * 100 + nSerial
endif
( cAliasSched )->( RLOK() )
( cAliasSched )->( FieldPut( nWeek, nWork ) )
( cAliasSched )->( DBUNLOCK() )
( cAliasSched )->( DBCOMMIT() )
if nWork > 0 .or. nPresentWork > 0
RefreshAll( .t. )
else
oBrwFree:Refresh()
oBrwUrlaub:Refresh()
oBrwFocus:SetFocus()
endif
lDone := .t.
endif
endif
endif
return lDone
//----------------------------------------------------------------------------//
static function TourWeekStaff( nTour, nWeek )
local aStaff := {}
local n, nStaff
if nTour > 100
nTour := Int( nTour / 100 )
endif
for n := 1 to Len( aRoster )
if aRoster[ n, 1 ] == nTour
if ( nStaff := aRoster[ n, nWeek ] ) > 0
AAdd( aStaff, nStaff )
endif
endif
next
return aStaff
//----------------------------------------------------------------------------//
static function InitVars()
dBOW := BOW()
WeeksArray()
return nil
//----------------------------------------------------------------------------//
static function CheckDBF()
field ID,FBOW,STAFFID
local cDbf, aCols, c
cDbf := cPath + cStaffDBF
if ! File( cDbf )
aCols := { ;
{ "ID", 'N', 3, 0 }, ;
{ "FNAME", 'C', 20, 0 } }
DBCREATE( cDbf, aCols )
USE ( cDbf ) NEW EXCLUSIVE
INDEX ON ID TAG ID
USE
USE ( cDbf ) NEW EXCLUSIVE
FOR EACH c IN { "Tom", "BRADY ", "ALEX", "CHRISTOPHER" }
APPEND BLANK
FIELD->ID := RECNO()
FIELD->FNAME := c
NEXT
CLOSE DATA
endif
cDbf := cPath + cToursDBF
if ! File( cDbf )
aCols := { ;
{ "ID", 'N', 3, 0 }, ;
{ "FNAME", 'C', 20, 0 }, ;
{ "FG", 'N', 11, 0 }, ;
{ "BG", 'N', 11, 0 } }
DBCREATE( cDbf, aCols )
USE ( cDbf ) NEW EXCLUSIVE
INDEX ON ID TAG ID
USE
USE ( cDbf ) NEW EXCLUSIVE
FOR EACH c IN { { "7-12/15-18", RGB( 193,255,190 ) }, ;
{ "12-17/18-21", RGB( 255,225,155 ) } }
APPEND BLANK
FIELD->ID := RECNO()
FIELD->FNAME := c[ 1 ]
FIELD->FG := CLR_BLACK
FIELD->BG := c[ 2 ]
NEXT
CLOSE DATA
endif
cDbf := cPath + cSchedDbf
if ! File( cDbf )
aCols := { ;
{ "STAFFID", 'N', 3, 0 }, ;
{ "MO", 'N', 4, 0 }, ;
{ "DI", 'N', 4, 0 }, ;
{ "MI", 'N', 4, 0 }, ;
{ "DO", 'N', 4, 0 }, ;
{ "FR", 'N', 4, 0 }, ;
{ "SA", 'N', 4, 0 }, ;
{ "SO", 'N', 4, 0 }, ;
{ "FBOW", 'D', 8, 0 } }
DBCREATE( cDbf, aCols )
USE ( cDbf ) NEW EXCLUSIVE
INDEX ON DTOS(FBOW)+STR(STAFFID,3) TAG WEEKSTAFF
USE
endif
return nil
//----------------------------------------------------------------------------//
static function OpenDBF()
cAliasTours := cGetNewAlias( "TOUR" )
USE ( cPath + cToursDbf ) NEW ALIAS ( cAliasTours ) SHARED
aTours := FW_DbfToArray( "ID,TRIM(FNAME),FG,BG" )
SET DELETED OFF
GO BOTTOM
nToursBias := FIELD->ID - RECNO()
SET DELETED ON
GO TOP
cAliasStaff := cGetNewAlias( "STAF" )
USE ( cPath + cStaffDbf ) NEW ALIAS ( cAliasStaff ) SHARED
aStaff := FW_DBFToArray( "ID,TRIM(FNAME)" )
SET DELETED OFF
GO BOTTOM
nStaffBias := FIELD->ID - RECNO()
SET DELETED ON
GO TOP
cAliasFree := cGetNewAlias( "SCHE" )
USE ( cPath + cSchedDbf ) NEW ALIAS ( cAliasFree ) SHARED
SET ORDER TO TAG WEEKSTAFF
SET FILTER TO !DELETED()
GO TOP
cAliasUrlaub := cGetNewAlias( "SCHE" )
USE ( cPath + cSchedDbf ) NEW ALIAS ( cAliasUrlaub ) SHARED
SET ORDER TO TAG WEEKSTAFF
SET FILTER TO !DELETED()
GO TOP
cAliasSched := cGetNewAlias( "SCHE" )
USE ( cPath + cSchedDbf ) NEW ALIAS ( cAliasSched ) SHARED
SET ORDER TO TAG WEEKSTAFF
GO TOP
return nil
//----------------------------------------------------------------------------//
static function InitStaffSched( dDate )
( cAliasStaff )->( DBGOTOP() )
( cAliasStaff )->( DBEVAL( { || AddStaffToSched( FIELD->ID ) } ) )
( cAliasStaff )->( DBGOTOP() )
return nil
//----------------------------------------------------------------------------//
static function AddStaffToSched( nStaffID )
// call aliased to SCHED
if ! ( cAliasSched )->( DBSEEK( DTOS( dBow ) + Str( nStaffID, 3 ) ) )
DO
( cAliasSched )->( DBAPPEND() )
UNTIL ! NetErr()
( cAliasSched )->STAFFID := nStaffID
( cAliasSched )->FBOW := dBow
( cAliasSched )->( DBUNLOCK() )
endif
return nil
//----------------------------------------------------------------------------//
static function BOW( dDate )
local nDay
DEFAULT dDate := Date()
nDay := DOW( dDate ) - 2
if nDay < 0
nDay := 6
endif
return dDate - nDay
//----------------------------------------------------------------------------//
static function WeeksArray
local n
aWeeks := { BOW() }
for n := 1 to 10
AAdd( aWeeks, ATail( aWeeks ) + 7 )
next
return aWeeks
//----------------------------------------------------------------------------//
static function NonZeroColsCount()
// call aliased
local nCount := 0
local i
for i := 2 to 8
if FieldGet( i ) != 0
nCount++
endif
next i
return nCount
//----------------------------------------------------------------------------//
static function D2CDM( dDate )
return LTrim( Str( Day( dDate ) ) ) + '.' + LTrim( Str( Month( dDate ) ) ) + '.'
//----------------------------------------------------------------------------//
static function FillRoster()
local nWeek, nTour
local nAt, nPrev, nSerial, nSl
local aTourStaff := {}
ASIZE( aRoster, 0 ) // do not use aRoster := {}
AEval( aTours, { |a| AAdd( aRoster, { a[ 1 ], 0,0,0,0,0,0,0,0 } ) } )
for nWeek := 2 to 8
aTourStaff := {}
( cAliasSched )->( DBGOTOP() )
do while ! ( cAliasSched )->( eof() )
if ( nTour := ( cAliasSched )->( FieldGet( nWeek ) ) ) > 0
AAdd( aTourStaff, { nTour, ( cAliasSched )->STAFFID } )
endif
( cAliasSched )->( DbSkip( 1 ) )
enddo
ASort( aTourStaff,,, { |x,y| x[ 1 ] < y[ 1 ] } )
nPrev := 0
nSerial := 0
for nAt := 1 to Len( aTourStaff )
nTour := aTourStaff[ nAt, 1 ]
if nTour > 100
nSl := nTour % 100
nTour := Int( nTour / 100 )
else
nSl := 0
endif
if nTour == nPrev
nSerial++
else
nPrev := nTour
nSerial := 1
endif
if nSl != nSerial
// may happen when staff are deleted
if ( cAliasSched )->( DBSEEK( DTOS( dBow ) + Str( aTourStaff[ nAt, 2 ], 3 ) ) )
( cAliasSched )->( RLOK() )
( cAliasSched )->( FieldPut( nWeek, nTour * 100 + nSerial ) )
( cAliasSched )->( DBUNLOCK() )
endif
endif
FillRosterOneStaff( aTourStaff[ nAt, 2 ], nWeek, nTour )
next nAt
next nWeek
( cAliasSched )->( DBGOTOP() )
SortRoster()
return nil
//----------------------------------------------------------------------------//
static function FillRosterOneStaff( nStaff, nWeek, nTour )
local nAt := AScan( aRoster, { |a| a[ 1 ] == nTour .and. a[ nWeek ] == 0 } )
if nAt == 0
AAdd( aRoster, { nTour, 0,0,0,0,0,0,0,0 } )
nAt := Len( aRoster )
endif
aRoster[ nAt, nWeek ] := nStaff
return nil
//----------------------------------------------------------------------------//
static function SortRoster()
AEval( aRoster, { |a,i| a[ 9 ] := a[ 1 ] * 100 + i } )
ASort( aRoster, nil, nil, { |x,y| x[ 9 ] < y[ 9 ] } )
return nil
//----------------------------------------------------------------------------//
//----------------------------------------------------------------------------//
static function SetWeek( dDate )
local cBow
if ! Empty( dDate )
if dBow == BOW( dDate )
// no change
return nil
endif
dBow := BOW( dDate )
endif
cBow := DTOS( dBow )
if SELECT( cAliasFree ) > 0
// dbfs are all open
( cAliasSched )->( OrdScope( 0, cBow ), OrdScope( 1, cBow ), DbGoTop() )
( cAliasFree )->( OrdScope( 0, cBow ), OrdScope( 1, cBow ), DbGoTop() )
( cAliasUrlaub )->( OrdScope( 0, cBow ), OrdScope( 1, cBow ), DbGoTop() )
endif
InitStaffSched()
FillRoster()
if oBrwRoster != nil
BrwWeekHeaders( oBrwRoster )
RefreshAll( .t. )
endif
return nil
//----------------------------------------------------------------------------//
static function IDLOOKUP( nID, aList )
if nID > 100
nID := Int( nID / 100 )
endif
return AScan( aList, { |a| a[ 1 ] == nID } )
//----------------------------------------------------------------------------//
static function ID2C( nId, aList )
local nAt := IDLOOKUP( nID, aList )
return If( nAt == 0, '', aList[ nAt, 2 ] )
//----------------------------------------------------------------------------//
static function ID2CLR( nID )
local nAt := IDLOOKUP( nID, aTours )
return If( nAt == 0, { CLR_BLACK, CLR_WHITE }, { aTours[ nAt, 3 ], aTours[ nAt, 4 ] } )
//----------------------------------------------------------------------------//
static function BrwWeekHeaders( oBrw )
oBrw:aCols[ 2 ]:cHeader := "Mo" + CRLF + D2CDM( dBow )
oBrw:aCols[ 3 ]:cHeader := "Di" + CRLF + D2CDM( dBow + 1 )
oBrw:aCols[ 4 ]:cHeader := "Mi" + CRLF + D2CDM( dBow + 2 )
oBrw:aCols[ 5 ]:cHeader := "Do" + CRLF + D2CDM( dBow + 3 )
oBrw:aCols[ 6 ]:cHeader := "Fr" + CRLF + D2CDM( dBow + 4 )
oBrw:aCols[ 7 ]:cHeader := "Sa" + CRLF + D2CDM( dBow + 5 )
oBrw:aCols[ 8 ]:cHeader := "So" + CRLF + D2CDM( dBow + 6 )
return nil
//----------------------------------------------------------------------------//
static function PopMenuWeeks()
local oPop
local n
MENU oPop POPUP 2007
for n := 1 to Len( aWeeks )
MenuAddItem( DTOC( aWeeks[ n ] ), nil, aWeeks[ n ] == dBow, .t., ;
{ |oItem| SetWeek( CTOD( oItem:cPrompt ) ), ;
AEval( oPop:aMenuItems, { |o| o:SetCheck( .f. ) } ), ;
oItem:SetCheck( .t. ) } )
next
ENDMENU
return oPop
//----------------------------------------------------------------------------//
static function CheckFocus()
local nWork
nSelWeek := oBrwFocus:nColSel
nSelStaff := nSelTour := 0
if nSelWeek > 1
if oBrwFocus == oBrwRoster
nSelStaff := oBrwRoster:aRow[ nSelWeek ]
if nSelStaff > 100
nSelStaff := Int( nSelStaff / 100 )
endif
nSelTour := oBrwRoster:aRow[ 1 ]
else
( oBrwFocus:cAlias )->( DBSKIP( 0 ) ) // force reread data
nWork := ( oBrwFocus:cAlias )->( FieldGet( nSelWeek ) )
if oBrwFocus == oBrwFree
if nWork == 0
nSelStaff := ( oBrwFocus:cAlias )->STAFFID
nSelTour := nWork
endif
else
if nWork == -1
nSelStaff := ( oBrwFocus:cAlias )->STAFFID
nSelTour := nWork
endif
endif
endif
endif
if WndMain() != nil
WndMain():oBar:AEvalWhen()
endif
if oBrwRoster != nil
// all browses are active
oBrwRoster:bDragBegin := ;
oBrwFree: bDragBegin := ;
oBrwUrlaub:bDragBegin := nil
if oBrwFocus == oBrwRoster
if oBrwRoster:aCols[ nSelWeek ]:Value > 0
oBrwRoster:bDragBegin := { |r,c,f,o| SetDropInfo( o ) }
endif
elseif oBrwFocus == oBrwFree
if oBrwFree:aCols[ nSelWeek ]:Value == 0
oBrwFree:bDragBegin := { |r,c,f,o| SetDropInfo( o ) }
endif
elseif oBrwFocus == oBrwUrlaub
if oBrwUrlaub:aCols[ nSelWeek ]:Value == -1
oBrwUrlaub:bDragBegin := { |r,c,f,o| SetDropInfo( o ) }
endif
endif
endif
return nil
//----------------------------------------------------------------------------//
static function BtnFreeAction()
CheckFocus()
if nSelStaff > 0 .and. nSelWeek > 1 .and. nSelTour != 0
StaffAllocate( nSelStaff, nSelWeek, 0 )
endif
return nil
//----------------------------------------------------------------------------//
static function BtnUrlaubAction()
CheckFocus()
if nSelStaff > 0 .and. nSelWeek > 1 .and. nSelTour >= 0
StaffAllocate( nSelStaff, nSelWeek, -1 )
endif
return nil
//----------------------------------------------------------------------------//
static function BtnTourAction( nTourID )
CheckFocus()
if nSelStaff > 0 .and. nSelWeek > 1 .and. nSelTour != nTourID
StaffAllocate( nSelStaff, nSelWeek, nTourID )
endif
return nil
//----------------------------------------------------------------------------//
#ifdef DYN_BTNS
static function AddTourBtn( oBar, n )
static lGroup := .t.
local nAt, nTour
local cPrompt := Trim( aTours[ n, 2 ] )
nAt := Int( Len( cPrompt ) / 2 )
cPrompt := "Schicht " + Left( cPrompt, nAt ) + " " + SubStr( cPrompt, nAt + 1 )
nAt := Len( oBar:aControls )
nTour := aTours[ n, 1 ]
if lGroup
DEFINE BUTTON OF oBar AT nAt PROMPT cPrompt GROUP ;
WHEN nSelStaff > 0 .and. nSelTour != nTour ;
ACTION BtnTouraction( nTour )
lGroup := .f.
else
DEFINE BUTTON OF oBar AT nAt PROMPT cPrompt ;
WHEN nSelStaff > 0 .and. nSelTour != nTour ;
ACTION BtnTouraction( nTour )
lGroup := .f.
endif
return nil
#else
//----------------------------------------------------------------------------//
static function PopTourMenu()
local oPop, n
MENU oPop POPUP 2007
for n := 1 to Len( aTours )
MenuAddItem( aTours[ n, 2 ], nil, .f., .t., ;
{ |oItem| BtnTourAction( oItem:Cargo ) } ):Cargo := aTours[ n, 1 ]
next n
ENDMENU
return oPop
#endif
//----------------------------------------------------------------------------//
static function DlgTours()
local oDlg, oBrw
local cAlias := cGetNewAlias( "TOUR" )
USE ( cPath + cToursDbf ) NEW ALIAS ( cAlias ) SHARED
DEFINE DIALOG oDlg SIZE 400,400 PIXEL TITLE "SCHICHT" ;
FONT WndMain():oFont
@ 10,10 XBROWSE oBrw SIZE -10,-30 PIXEL OF oDlg ;
DATASOURCE cAlias ;
COLUMNS "ID", "FNAME", "FG", "BG" ;
HEADERS "ID", "Schicht", "FG", "BG" ;
COLSIZES nil, 50 ;
CELL LINES NOBORDER
WITH OBJECT oBrw
:nStretchCol := 2
:FG:bStrData := { || " " }
:BG:bStrData := { || " " }
:bClrStd := { || { oBrw:FG:Value, oBrw:BG:Value } }
:bClrSel := ;
:bClrSelFocus := { || { oBrw:BG:Value, oBrw:FG:Value } }
WITH OBJECT :FG
:bClrStd := { || { oBrw:BG:Value, oBrw:FG:Value } }
:bClrSel := ;
:bClrSelFocus := { || { oBrw:FG:Value, oBrw:BG:Value } }
END
:fg:bLDClickData := { || TourClr( oBrw, 3 ) }
:bg:bLDClickData := { || TourClr( oBrw, 4 ) }
//
:CreateFromCode()
END
@ 175, 10 BUTTONBMP BITMAP "c:\FWH\bitmaps\new2.bmp" SIZE 20,20 PIXEL OF oDlg ;
ACTION ( cAlias )->( EditTour( oBrw, .t. ) )
@ 175, 32 BUTTONBMP BITMAP "c:\FWH\bitmaps\edit.bmp" SIZE 20,20 PIXEL OF oDlg ;
ACTION ( cAlias )->( EditTour( oBrw, .f. ) )
@ 175, 54 BUTTONBMP BITMAP "c:\FWH\bitmaps\16x16\delete.bmp" SIZE 20,20 PIXEL OF oDlg ;
ACTION ( cAlias )->( DelTour( oBrw ) )
@ 175,170 BUTTONBMP BITMAP "c:\FWH\bitmaps\close.bmp" SIZE 20,20 PIXEL OF oDlg ;
ACTION oDlg:End()
ACTIVATE DIALOG oDlg CENTERED
( cAlias )->( DBCLOSEAREA() )
return nil
//----------------------------------------------------------------------------//
static function EditTour( oBrw, lNew )
local cTour := FieldGet( 2 )
local lDone := .f.
local oBar, nAt, nBtn, oBtn, nID
DEFAULT lNew := .f.
if lNew
cTour := Space( Len( cTour ) )
endif
if MsgGet( If( lNew, "Enter New", "Modify" ), "TOUR NAME", @cTour )
if ! Empty( cTour )
if lNew
APPEND BLANK
FieldPut( 1, RECNO() + nToursBias )
else
RLOK()
endif
FieldPut( 2, cTour )
if lNew
FieldPut( 4, CLR_WHITE )
endif
DBUNLOCK()
DBSKIP( 0 )
nID := FieldGet( 1 )
oBrw:Refresh()
lDone := .t.
endif
endif
if lDone
if lNew
AAdd( aTours, { FieldGet( 1 ), Trim( FieldGet( 2 ) ), FieldGet( 3 ), FieldGet( 4 ) } )
#ifdef DYN_BTNS
AddTourBtn( WndMain():oBar, Len( aTours ) )
#endif
RefreshAll( .t. )
else
cTour := Trim( cTour )
aTours[ IDLOOKUP( nId, aTours ), 2 ] := cTour
oBrwRoster:Refresh()
#ifdef DYN_BTNS
oBar := WndMain():oBar
nAt := IdLookUp( nID, aTours )
nBtn := Len( oBar:aControls ) - Len( aTours ) - 1 + nAt
oBtn := oBar:aControls[ nBtn ]
nAt := Int( Len( cTour ) / 2 )
cTour := Left( cTour, nAt ) + " " + SubStr( cTour, nAt + 1 )
oBtn:SetText( "Schicht " + cTour )
oBtn:Refresh()
#endif
endif
endif
return lDone
//----------------------------------------------------------------------------//
static function TourClr( oBrw, nCol )
local nClr := ( oBrw:cAlias )->( FieldGet( nCol ) )
local nSel
nSel := ChooseColor( nClr )
if nSel != nClr
( oBrw:cAlias )->( RLOK(), FieldPut( nCol, nSel ), DBUNLOCK() )
aTours[ ( oBrw:cAlias )->( RECNO() ), nCol ] := nSel
oBrwRoster:Refresh()
endif
return nil
//----------------------------------------------------------------------------//
static function DelTour( oBrw )
local nID := oBrw:aCols[ 1 ]:Value
local nAt := IdLookUp( nID, aTours )
local oBar := WndMain():oBar
local nBtn := Len( oBar:aControls ) - Len( aTours ) - 1 + nAt
oBar:Del( nBtn )
ADel( aTours, nAt, .t. )
( oBrw:cAlias )->( RLOK(), DBDELETE(), DBUNLOCK() )
oBrw:Refresh()
( cAliasSched )->( DelTourFromSched( nID ) )
RefreshAll( .t. )
return nil
//----------------------------------------------------------------------------//
static function DelTourFromSched( nTour )
local nWeek, nVal
SET SCOPE TO
GO TOP
do while ! eof()
for nWeek := 2 to 8
nVal := FieldGet( nWeek )
if nVal > 100
nVal := Int( nVal / 100 )
endif
if nVal == nTour
RLOK()
FieldPut( nWeek, 0 )
DBUNLOCK()
endif
next
SKIP
enddo
GO TOP
SET SCOPE TO DTOS( dBow ), DTOS( dBow )
GO TOP
return nil
//----------------------------------------------------------------------------//
static function DlgStaff()
local oDlg, oBrw
local cAlias := cGetNewAlias( "STAFF" )
USE ( cPath + cStaffDbf ) NEW ALIAS ( cAlias ) SHARED
DEFINE DIALOG oDlg SIZE 400,400 PIXEL TITLE "SCHICHT" ;
FONT WndMain():oFont
@ 10,10 XBROWSE oBrw SIZE -10,-30 PIXEL OF oDlg ;
DATASOURCE cAlias ;
COLUMNS "ID", "FNAME" ;
HEADERS "ID", "Staff" ;
COLSIZES nil, 50 ;
CELL LINES NOBORDER
WITH OBJECT oBrw
:nStretchCol := 2
//
:CreateFromCode()
END
@ 175, 10 BUTTONBMP BITMAP "c:\FWH\bitmaps\new2.bmp" SIZE 20,20 PIXEL OF oDlg ;
ACTION ( cAlias )->( EditStaff( oBrw, .t. ) )
@ 175, 32 BUTTONBMP BITMAP "c:\FWH\bitmaps\edit.bmp" SIZE 20,20 PIXEL OF oDlg ;
ACTION ( cAlias )->( EditStaff( oBrw, .f. ) )
@ 175, 54 BUTTONBMP BITMAP "c:\FWH\bitmaps\16x16\delete.bmp" SIZE 20,20 PIXEL OF oDlg ;
ACTION ( cAlias )->( DelStaff( oBrw ) )
@ 175,170 BUTTONBMP BITMAP "c:\FWH\bitmaps\close.bmp" SIZE 20,20 PIXEL OF oDlg ;
ACTION oDlg:End()
ACTIVATE DIALOG oDlg CENTERED
( cAlias )->( DBCLOSEAREA() )
return nil
//----------------------------------------------------------------------------//
static function EditStaff( oBrw, lNew )
local cStaff := FieldGet( 2 )
local lDone := .f.
local oBar, nAt, oBtn, nID
DEFAULT lNew := .f.
if lNew
cStaff := Space( Len( cStaff ) )
endif
if MsgGet( If( lNew, "Enter New", "Modify" ), "STAFF NAME", @cStaff )
if ! Empty( cStaff )
if lNew
APPEND BLANK
FieldPut( 1, RECNO() + nStaffBias )
else
RLOK()
endif
FieldPut( 2, cStaff )
DBUNLOCK()
DBSKIP( 0 )
nID := FieldGet( 1 )
oBrw:Refresh()
cStaff := Trim( cStaff )
if lNew
AAdd( aStaff, { nID, cStaff } )
AddStaffToSched( nID )
oBrwFree:Refresh()
oBrwUrlaub:Refresh()
else
aStaff[ IdLookUp( nID, aStaff ), 2 ] := cStaff
endif
RefreshAll()
lDone := .t.
endif
endif
oBrw:SetFocus()
return nil
//----------------------------------------------------------------------------//
static function DelStaff( oBrw )
local cAlias
local nID := oBrw:aCols[ 1 ]:Value
if ! MsgNoYes( "Delete " + Trim( oBrw:aCols[ 2 ]:Value ) + " ? " )
oBrw:SetFocus()
return nil
endif
// Clear the ID from SCHED dbf
SET DELETED OFF
( cAliasSched )->( OrdScope( 0, nil ), OrdScope( 1, nil ), DbGoTop() )
( cAliasSched )->( DBEVAL( { || ;
If( FIELD->STAFFID == nID .AND. !DELETED(), ;
( RLOK(), FIELD->FBOW := CTOD( '' ), DBDELETE(), DBUNLOCK() ), nil ) } ) )
SET DELETED ON
( cAliasSched )->( OrdScope( 0, DTOS( dBow ) ), OrdScope( 1, DTOS( dBow ) ), DbGoTop() )
// Delete in Staff dbf and Array
( oBrw:cAlias )->( RLOK(), DBDELETE(), DBUNLOCK() )
ADel( aStaff, IDLOOKUP( nID ), .t. )
oBrw:Refresh()
RefreshAll( .t. )
oBrw:SetFocus()
return nil
//============================================================================//
// EXPORT TO TMP* DBF FOR USE WITH FASTREPORT
//----------------------------------------------------------------------------//
#ifdef PRN_SINGLEDBF
static function ExportPrintDbf()
local aNames := { "Schicht", "Mo", "Di", "Mi", "Do", "Fr", "Sa", "So" }
local aCols, cFld, cFile, nCol, nRecPos
aCols := {}
for each cFld in aNames
AAdd( aCols, { cFld, 'C', 20, 0 } )
next
cFile := cPath + "TMPSCHICHT.DBF"
DBCREATE( cFile, aCols )
USE ( cFile ) NEW ALIAS TMP EXCLUSIVE
TMP->( ExportFromBrw( oBrwRoster ) )
TMP->( ExportFromBrw( oBrwFree, "Freie" ) )
TMP->( ExportFromBrw( oBrwUrlaub, "Urlaub" ) )
USE
? "Exported to temporary files"
oBrwFocus:SetFocus()
return nil
//----------------------------------------------------------------------------//
static function ExportFromBrw( oBrw, cText )
local uBookMark := oBrw:BookMark
local nCol
Eval( oBrw:bGoTop )
if Eval( oBrw:bKeyCount ) > 0
REPEAT
DBAPPEND()
if cText != nil
FieldPut( 1, cText )
else
FieldPut( 1, Eval( oBrw:aCols[ 1 ]:bStrData ) )
endif
for nCol := 2 to 8
FieldPut( nCol, Eval( oBrw:aCols[ nCol ]:bStrData ) )
next
UNTIL Eval( oBrw:bSkip, 1 ) != 1
endif
EVal( oBrw:bBookMark, uBookMark )
return nil
//----------------------------------------------------------------------------//
#else
static function ExportPrintDbf()
local aNames := { "Schicht", "Mo", "Di", "Mi", "Do", "Fr", "Sa", "So" }
local aCols, cFld, cFile, nCol, nRecPos
aCols := {}
for each cFld in aNames
AAdd( aCols, { cFld, 'C', 20, 0 } )
next
cFile := cPath + "TMPSCHICHT.DBF"
DBCREATE( cFile, aCols )
USE ( cFile ) NEW ALIAS TMP EXCLUSIVE
TMP->( ExportFromBrw( oBrwRoster ) )
USE
aCols[ 1, 1 ] := "Staff"
cFile := cPath + "TMPFREIE.DBF"
DBCREATE( cFile, aCols )
USE ( cFile ) NEW ALIAS TMP EXCLUSIVE
TMP->( ExportFromBrw( oBrwFree ) )
USE
cFile := cPath + "TMPURLAUB.DBF"
DBCREATE( cFile, aCols )
USE ( cFile ) NEW ALIAS TMP EXCLUSIVE
TMP->( ExportFromBrw( oBrwUrlaub ) )
USE
? "Exported to temporary files"
oBrwFocus:SetFocus()
return nil
//----------------------------------------------------------------------------//
static function ExportFromBrw( oBrw )
local uBookMark := oBrw:BookMark
local nCol
Eval( oBrw:bGoTop )
if Eval( oBrw:bKeyCount ) > 0
REPEAT
DBAPPEND()
for nCol := 1 to 8
FieldPut( nCol, Eval( oBrw:aCols[ nCol ]:bStrData ) )
next
UNTIL Eval( oBrw:bSkip, 1 ) != 1
endif
EVal( oBrw:bBookMark, uBookMark )
return nil
//----------------------------------------------------------------------------//
#endif
//============================================================================//
#ifdef STANDALONE
//============================================================================//
//----------------------------------------------------------------------------//
static function Client2Screen( hWnd, aPoint )
aPoint := ClientToScreen( hWnd, aPoint )
if aPoint[ 1 ] > 0x8000
aPoint[ 1 ] -= 0xFFFF
endif
if aPoint[ 2 ] > 0x8000
aPoint[ 2 ] -= 0xFFFF
endif
return aPoint
//----------------------------------------------------------------------------//
static function Screen2Client( hWnd, aPoint )
aPoint := ScreenToClient( hWnd, aPoint )
if aPoint[ 1 ] > 0x8000
aPoint[ 1 ] -= 0xFFFF
endif
if aPoint[ 2 ] > 0x8000
aPoint[ 2 ] -= 0xFFFF
endif
return aPoint
//----------------------------------------------------------------------------//
static function ClientToClient( hFrom, hDest, aPoint, lInWnd )
aPoint := Client2Screen( hFrom, aPoint )
lInWnd := ( WindowFromPoint( aPoint[ 2 ], aPoint[ 1 ] ) == hDest )
aPoint := Screen2Client( hDest, aPoint )
return aPoint
//============================================================================//
static function RLOK()
do while ! DBRLOCK()
enddo
return .t.
//============================================================================//
#endif
by ukoenig » Thu Dec 20, 2012 2:04 pm
// New !!!
// ---------
static oSay4, oSay5,cWeek[2], nWeekcount := 0
..
..
FUNCTION MAIN()
..
..
SetWeek()
// New !!!
// ---------
cWeek[1] := DTOC( aWeeks[ 1 ] )
cWeek[2] := DTOC( aWeeks[ 11 ] )
--
--
static function BrowseWnd()
..
..
// New !!!
// ---------
@ nBarHt + 3, 830 SAY oSay4 VAR cWeek[1] ;
SIZE 100, 20 PIXEL OF oWnd TRANSPARENT ;
FONT oBold UPDATE
oSay4:lTransparent := .T.
oSay4:SetColor( 255, )
@ nBarHt + 20, 830 SAY oSay5 VAR cWeek[2] ;
SIZE 100, 20 PIXEL OF oWnd TRANSPARENT ;
FONT oBold UPDATE
oSay5:lTransparent := .T.
oSay5:SetColor( 255, )
---
---
DEFINE BUTTON OF oBar FILE c_path1 + "start.bmp" GROUP ;
PROMPT "Start" ACTION SelectWeek(1)
DEFINE BUTTON OF oBar FILE c_path1 + "minus.bmp" ;
PROMPT "Minus" ACTION ( nWeekCount--, ;
IIF ( nWeekcount = 0, nWeekcount := 1, NIL ), SelectWeek(nWeekcount) )
DEFINE BUTTON OF oBar FILE c_path1 + "plus.bmp" ;
PROMPT "Plus" ACTION ( nWeekCount++, ;
IIF ( nWeekcount = 12, nWeekcount := 11, NIL ), SelectWeek(nWeekcount) )
DEFINE BUTTON OF oBar FILE c_path1 + "end.bmp" ;
PROMPT "End" ACTION SelectWeek(11)
---
---
// New !!!
// ---------
static function SelectWeek(nPos)
local n
for n := 1 to Len( aWeeks )
IF nPos = n
cWeek[1] := DTOC( aWeeks[ n ] )
SetWeek( CTOD( cWeek[1] ) )
ENDIF
cWeek[2] := DTOC( aWeeks[ n ] )
next
oSay4:Refresh()
oSay5:Refresh()
RETURN( NIL )
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: No registered users and 92 guests