VERSION 5.00
Begin VB.Form DC_Calendar 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Calendar"
   ClientHeight    =   3555
   ClientLeft      =   1410
   ClientTop       =   2295
   ClientWidth     =   6870
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   3555
   ScaleWidth      =   6870
   ShowInTaskbar   =   0   'False
   Begin VB.TextBox txt_MaxCustPal 
      Height          =   315
      Left            =   3000
      TabIndex        =   14
      Top             =   720
      Width           =   1932
   End
   Begin VB.CommandButton spp_save 
      Default         =   -1  'True
      Height          =   612
      Left            =   5400
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   2760
      Width           =   612
   End
   Begin VB.CommandButton ssp_quit 
      Height          =   612
      Left            =   6120
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   2760
      Width           =   612
   End
   Begin VB.CommandButton SSC_dropped 
      Height          =   276
      Left            =   6480
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   120
      Width           =   252
   End
   Begin VB.TextBox txt_ShipDate 
      ForeColor       =   &H00000000&
      Height          =   288
      Left            =   4800
      Locked          =   -1  'True
      TabIndex        =   12
      Text            =   "txt_ShipDate"
      Top             =   120
      Width           =   1572
   End
   Begin VB.TextBox txt_DC 
      Height          =   288
      Left            =   960
      Locked          =   -1  'True
      TabIndex        =   11
      Top             =   120
      Width           =   2412
   End
   Begin VB.TextBox txt_MaxCont 
      Height          =   288
      Left            =   3000
      TabIndex        =   10
      Top             =   2160
      Width           =   1932
   End
   Begin VB.TextBox txt_MaxRec 
      Height          =   288
      Left            =   3000
      TabIndex        =   9
      Top             =   1680
      Width           =   1932
   End
   Begin VB.TextBox txt_MaxInt 
      Height          =   288
      Left            =   3000
      TabIndex        =   8
      Top             =   1200
      Width           =   1932
   End
   Begin VB.Label lbl_MaxCust_Pal 
      Caption         =   "Maxi palletes for customer shipments"
      Height          =   195
      Left            =   120
      TabIndex        =   13
      Top             =   720
      Width           =   2775
   End
   Begin VB.Label lbl_MaxCont 
      Caption         =   "Maxi containers"
      Height          =   255
      Left            =   120
      TabIndex        =   7
      Top             =   2160
      Width           =   2775
   End
   Begin VB.Label lbl_MaxRec 
      Caption         =   "Maxi receipts trucks"
      Height          =   255
      Left            =   120
      TabIndex        =   6
      Top             =   1680
      Width           =   2775
   End
   Begin VB.Label lbl_MaxInt 
      Caption         =   "Maxi trucks for interco shipments"
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   1217
      Width           =   2775
   End
   Begin VB.Label lbl_ShipDate 
      Caption         =   "Shipping date"
      Height          =   252
      Left            =   3600
      TabIndex        =   1
      Top             =   120
      Width           =   1212
   End
   Begin VB.Label lbl_DCName 
      Caption         =   "DC"
      Height          =   252
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   732
   End
End
Attribute VB_Name = "DC_Calendar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim mb_FirstTime As Boolean
Private Sub Form_Activate()
Dim datedeb As String

If mb_FirstTime = OK Then

    txt_MaxCustPal.SetFocus
    
    If gs_Action = "Add" Then
        mb_FirstTime = KO
        datedeb = "01/" & DC_Choice2.cbo_month & "/" & DC_Choice2.cbo_year
        txt_ShipDate = FormatD(datedeb, "ddd dd/mm/yyyy")
    End If
End If

End Sub

Private Sub Form_Load()
Dim datedeb As String

MouseOff

If gl_CodePage <> 1252 And gl_CodePage <> 0 Then ChangeCharset Me

spp_save.Picture = LoadResPicture(RES_OK, 1)
ssp_quit.Picture = LoadResPicture(RES_QUIT, 1)

SSC_dropped.Picture = LoadResPicture(RES_DOWN2, vbResIcon)

Calendar_constants

txt_DC = DC_Choice2.cbo_Ship_DC
mb_FirstTime = OK

If gs_Action <> "Add" Then
    txt_ShipDate = FormatD(gs_TableCode, "ddd dd/mm/yyyy")
    txt_ShipDate.Locked = OK
    SSC_dropped.Enabled = KO
    txt_MaxCustPal = gs_TableCode3
    txt_MaxCont = gs_TableCode6
    txt_MaxInt = gs_TableCode4
    txt_MaxRec = gs_TableCode5
    If gs_Action = "Delete" Then
        txt_MaxCustPal.Locked = OK
        txt_MaxCont.Locked = OK
        txt_MaxInt.Locked = OK
        txt_MaxRec.Locked = OK
    End If
End If

MouseOn

End Sub

Private Sub spp_save_Click()

Dim ld_AddDate As Date
Dim ls_AddDate As String

MouseOff
gb_Return = OK
Select Case gs_Action
Case "Add":
    If Add_Table Then
        ld_AddDate = StringToDate(right(txt_ShipDate, 10))
        ls_AddDate = DateToString(DateAdd("d", 1, ld_AddDate))
        txt_ShipDate = FormatD(ls_AddDate, "ddd dd/mm/yyyy")
        If gl_NbLineDisplay < 2 Then
            C_main.FillGrid
        End If
    End If
Case "Update":
    If Upd_Table Then
        Unload Me
        Exit Sub
    End If
Case "Delete":
    If Dlt_Table Then
        Unload Me
        Exit Sub
    End If
End Select

MouseOn
End Sub

Private Sub SSC_dropped_Click()
Dim ld_AddDate As Date
Dim ls_AddDate As String
Dim ls_Message As String
Dim li_Day As Integer
On Error GoTo suite

MouseOff
gb_Return = KO
gs_Date = right(txt_ShipDate, 10)
Dates.show 1
If gb_Return Then
    If gs_Date <> "" Then
        txt_ShipDate = FormatD(gs_Date, "ddd dd/mm/yyyy")
        ls_Message = "Do you really want to plan" & Chr(10) & Chr(13) & "a week-end day ?"
        li_Day = Weekday(StringToDate(right(txt_ShipDate, 10)))
        If (li_Day = 1 Or li_Day = 7) And gs_Action = "Add" Then
            If SendMessage(0, ls_Message, gut_LangLogin.Code, vbQuestion + vbYesNo, "Day in a week-end") = vbNo Then
                Do While (Weekday(StringToDate(right(txt_ShipDate, 10))) = 1 Or Weekday(StringToDate(right(txt_ShipDate, 10))) = 7) And gs_Action = "Add"
                    ld_AddDate = StringToDate(right(txt_ShipDate, 10))
                    ls_AddDate = DateToString(DateAdd("d", 1, ld_AddDate))
                    txt_ShipDate = FormatD(ls_AddDate, "ddd dd/mm/yyyy")
                Loop
            End If
        End If
    Else
        txt_ShipDate = ""
    End If
End If
MouseOn
Exit Sub

suite:
StdError
MouseOn
End Sub


Private Sub ssp_quit_Click()
Unload Me
End Sub





Private Function Control() As Boolean
    
Control = OK

If txt_ShipDate = "" Then
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    txt_ShipDate.SetFocus
    Control = KO
    Exit Function
End If

If txt_MaxCustPal = "" Then
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    txt_MaxCustPal.SetFocus
    Control = KO
    Exit Function
End If
If Not CheckNumericValue(txt_MaxCustPal) Then
    SendMessage 8, "Value must be a numeric", gut_LangLogin.Code
    txt_MaxCustPal.SetFocus
    Control = KO
    Exit Function
End If

If txt_MaxInt = "" Then
    txt_MaxInt.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Control = KO
    Exit Function
End If
If Not CheckNumericValue(txt_MaxInt) Then
    SendMessage 8, "Value must be a numeric", gut_LangLogin.Code
    txt_MaxInt.SetFocus
    Control = KO
    Exit Function
End If
If txt_MaxRec = "" Then
    txt_MaxRec.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Control = KO
    Exit Function
End If
If Not CheckNumericValue(txt_MaxRec) Then
    SendMessage 8, "Value must be a numeric", gut_LangLogin.Code
    txt_MaxRec.SetFocus
    Control = KO
    Exit Function
End If
If txt_MaxCont = "" Then
    txt_MaxCont.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Control = KO
    Exit Function
End If
If Not CheckNumericValue(txt_MaxCont) Then
    SendMessage 8, "Value must be a numeric", gut_LangLogin.Code
    txt_MaxCont.SetFocus
    Control = KO
    Exit Function
End If

End Function



Private Function Add_Table() As Boolean
Dim ls_req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ll_lngrows As Long
Dim ls_Line As String

On Error GoTo suite

Add_Table = KO

If Control Then
    ls_req = gs_ParamReqIns & " '" _
           & FormatD(right(txt_ShipDate, 10), "mm/dd/yyyy") & "', " _
           & CInt(txt_MaxCustPal) & ", " _
           & CInt(txt_MaxCont) & ", " _
           & CInt(txt_MaxInt) & ", " _
           & CInt(txt_MaxRec) & ", 'E'"
           
    If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_req) Then
        li_Status = SQLRowCount(ll_Statement, ll_lngrows)
        If ll_lngrows = 0 Then
            li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
            SendMessage 4, "Insert failed", gut_LangLogin.Code
            C_main.FillGrid
        Else
            Add_Table = OK
            ' Find the code
            ls_Line = right(txt_ShipDate, 10) & Chr(9) & 1 & Chr(9) & txt_MaxCustPal & Chr(9) & txt_MaxInt & Chr(9) & txt_MaxRec & Chr(9) & txt_MaxCont
            C_main.Grid.AddItem ls_Line
            C_main.Grid.Row = C_main.Grid.Rows - 1
            li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        End If
    Else
            li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
            SendMessage 4, "Insert failed", gut_LangLogin.Code
    End If
End If
Exit Function

suite:
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
StdError

End Function

Private Function Dlt_Table() As Boolean
Dim ls_req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ll_lngrows As Long

On Error GoTo suite

Dlt_Table = KO

MouseOn
If SendMessage(5, "Delete record ?", gut_LangLogin.Code, vbQuestion + vbYesNo, "Delete ") = vbYes Then
    MouseOff
    ls_req = gs_ParamReqDel & " '" _
        & FormatD(gs_TableCode, "mm/dd/yyyy") & "', " _
        & gs_TableCode2
    If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_req) Then
        li_Status = SQLRowCount(ll_Statement, ll_lngrows)
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        If ll_lngrows = 0 Then
            SendMessage 7, "Delete failed : concurrency problem ?", gut_LangLogin.Code
            C_main.FillGrid
        Else
            Dlt_Table = OK
            C_main.Grid.RemoveItem C_main.Grid.Row
        End If
    Else
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        SendMessage 6, "Delete failed ", gut_LangLogin.Code
    End If
End If
MouseOff
Exit Function

suite:
Select Case Err
Case 30015
    C_main.FillGrid
Case Else
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    StdError
End Select
End Function

Private Sub Calendar_constants()
Dim ls_Field As String, ls_Text As String
Dim ll_Statement As Long
Dim li_Status As Integer

On Error GoTo suite

If SQLSubmit(gl_Environment, gl_Database, ll_Statement, gs_ParamReqCsts) Then
    li_Status = SQL_SUCCESS
Else
    li_Status = SQL_ERROR
End If
Do While li_Status = SQL_SUCCESS Or _
         li_Status = SQL_SUCCESS_WITH_INFO
    li_Status = SQLFetch(ll_Statement)
    If li_Status = SQL_SUCCESS Or _
       li_Status = SQL_SUCCESS_WITH_INFO Then
        ls_Field = ODBCData(ll_Statement, 1)
        ls_Text = Left(ODBCData(ll_Statement, 2), 40)
        Select Case ls_Field
            Case "title": Caption = ls_Text
            Case "titleA": If gs_Action = "Add" Then Caption = Caption & " - " & ls_Text
            Case "titleU": If gs_Action = "Update" Then Caption = Caption & " - " & ls_Text
            Case "titleD": If gs_Action = "Delete" Then Caption = Caption & " - " & ls_Text
            Case "lbl_DCName": lbl_DCName = ls_Text
            Case "lbl_ShipDate": lbl_ShipDate = ls_Text
            Case "lbl_MaxInt": lbl_MaxInt = ls_Text
            Case "lbl_MaxRec": lbl_MaxRec = ls_Text
            Case "lbl_MaxCont": lbl_MaxCont = ls_Text
            Case "lbl_MaxCust_Pal": lbl_MaxCust_Pal = ls_Text
        End Select
    End If
Loop
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
Exit Sub

suite:
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
StdError


End Sub

Private Function Upd_Table() As Boolean

Dim ls_req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ll_lngrows As Long
Dim ls_Line As String

Upd_Table = KO

On Error GoTo suite

If Control Then
       ls_req = gs_ParamReqUpd & " '" _
           & FormatD(right(txt_ShipDate, 10), "mm/dd/yyyy") & "', " _
           & CInt(txt_MaxCustPal) & ", " _
           & CInt(txt_MaxCont) & ", " _
           & CInt(txt_MaxInt) & ", " _
           & CInt(txt_MaxRec) & ", " _
           & gs_TableCode2
    If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_req) Then
        li_Status = SQLRowCount(ll_Statement, ll_lngrows)
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        If ll_lngrows = 0 Then
            SendMessage 2, "Another user change the record", gut_LangLogin.Code
            C_main.FillGrid
        Else
            Upd_Table = OK
            C_main.Grid.RemoveItem C_main.Grid.Row
            ls_Line = right(txt_ShipDate, 10) & Chr(9) & CInt(gs_TableCode2) + 1 & Chr(9) & txt_MaxCustPal & Chr(9) & txt_MaxInt & Chr(9) & txt_MaxRec & Chr(9) & txt_MaxCont
            C_main.Grid.AddItem ls_Line, C_main.Grid.Row
        End If
    Else
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        SendMessage 3, "Update failed", gut_LangLogin.Code
    End If
End If
Exit Function

suite:
Select Case Err
Case 30015
    C_main.FillGrid
Case Else
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    StdError
End Select
End Function
