VERSION 5.00
Begin VB.Form Cap_Print 
   Caption         =   "Print preview"
   ClientHeight    =   5775
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   10095
   LinkTopic       =   "Form1"
   ScaleHeight     =   5775
   ScaleWidth      =   10095
   StartUpPosition =   3  'Windows Default
   Begin Project1.Cap_OfferOutPut mo_OutPut 
      Height          =   4485
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   9555
      _ExtentX        =   15743
      _ExtentY        =   8969
   End
End
Attribute VB_Name = "Cap_Print"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const C_PRINTTMPFOLDER = "Download\"
Private Const SEP1 As String = "®"
Private Const SEP2 As String = "©"
Private Const SEP As String = SEP1 + SEP2
Private Const C_APPNAME As String = "CAP_PRINT" ' for error log
Private mb_Loaded As Boolean
Public ms_Action As String

Private m_Language As String

#If LIVE = 1 Then
    Dim mo_ArmDb As Object
#Else
    Dim mo_ArmDb As ARMSYSCOMLib.ArmDb
#End If
Private mo_Tools As DPC_Tools
Private ms_ConnectString As String
Private ms_UID As String
Private ml_U_Code As Long
Private Enum ArmErr
    DBCnxFailed = vbObjectError + 1             ' Unable to connect to the database
    CPTAlreadyInitialized = vbObjectError + 2   ' We try to initialize a component that is already initialized
    CPTNotInitialized = vbObjectError + 3       ' We try to use or free that is not initialized yet
    InvalidArgument = vbObjectError + 4
    PropertyNotSet = vbObjectError + 5
    SQLFailure = vbObjectError + 6               ' A SQL runtime error has occured : syntax wrong....
    SQLBadRowAffectedCount = vbObjectError + 7   ' A SQL request has not affected the expected rowcount (ex: one Update do nothing)
    SQLBadRowExpectedCount = vbObjectError + 8   ' A SQL request does not return the expected rowcount : select an item return nothing...
    DrivingError = vbObjectError + 9
    CompFncFailed = vbObjectError + 10           ' when component function fail
    GridLoadFailed = vbObjectError + 11          ' load function failed ... bad sql
    QuietException = vbObjectError + 12              ' do not display error message
End Enum

Public Property Let U_Code(ByVal al_U_Code As Long)
    ml_U_Code = al_U_Code
End Property

Public Property Set ArmDb(ByRef ao_local_connection As Object)
    Set mo_ArmDb = ao_local_connection
End Property

Public Property Set Tools(ByRef ao_Tools As DPC_Tools)
    Set mo_Tools = ao_Tools
End Property

Property Let Language(as_Language As String)
    m_Language = as_Language
End Property


Property Let ConnectString(as_ConnectString As String)
On Error GoTo ErrHandler
    
    ms_ConnectString = as_ConnectString
    Exit Property
ErrHandler:
    Call ErrorHandler("ConnectString")
End Property


Public Sub Load_A_COM()
On Error GoTo ErrHandler
    
    If Not mo_OutPut.Initialized Then

        Dim lsa_connParam() As String
        lsa_connParam = Split(ms_ConnectString, SEP)
        Set mo_OutPut.ArmDb = mo_ArmDb
        Set mo_OutPut.Tools = mo_Tools
        mo_OutPut.U_Code = ml_U_Code
        Call mo_OutPut.Load_A_COM
    End If
    
    ms_Action = ""
    Call InitCtrlSize
    mb_Loaded = True
    Exit Sub
ErrHandler:
    Call ErrorHandler("Load_A_Com")
End Sub

Public Sub Unload_A_COM()
On Error GoTo ErrHandler
    Call mo_OutPut.Unload_A_COM
    Exit Sub
ErrHandler:
    Call ErrorHandler("Unload_A_Com")
End Sub

Private Sub InitCtrlSize()
On Error GoTo ErrHandler
    
    Call mo_OutPut.Move(0, 0, Me.Width - 120, Me.Height - 240)
    Call mo_OutPut.SetPrintableArea(0, 0, Me.Width - 120, Me.Height - 240)
    Exit Sub
ErrHandler:
    Call ErrorHandler("InitCtrlSize()")
End Sub

Public Sub PrintOffer(ByVal as_COF_Id As String, ByVal ab_PrintPictures As Boolean, ByVal ab_PrintTotal As Boolean, ByVal ab_PrintReps As Boolean, ByVal ab_InterCompany As Boolean, Optional ab_SaveAsPDF As Boolean = False, Optional ab_PrintGeneralTerms As Boolean = True, Optional ab_PrintASItemMessage As Boolean = False)
On Error GoTo ErrHandler
  
Dim ls_req          As String
Dim lc_Cursor       As Long
Dim ls_folderName   As String
Dim ll_COT_ID       As Long
Dim ll_COTZ_ID      As Long
Dim ls_Language_Code    As String
Dim ll_Code_Page    As Long
  
  mo_OutPut.navBar = vpnbTopPrint
  ls_folderName = "OfferTmp"
  
  ls_req = "SELECT COF.COT_Id, COT.COTZ_Id, COT.Language_Code, LNG.Code_Page "
  ls_req = ls_req & "FROM Cap_Offer COF "
  ls_req = ls_req & "INNER JOIN Cap_OfferTemplate COT ON (COF.COT_Id=COT.COT_Id)"
  ls_req = ls_req & "LEFT JOIN language LNG ON (COT.Language_Code=LNG.Language_Code)"
  ls_req = ls_req & "WHERE COF.COF_Id=$COF_Id$"
  ls_req = Replace(ls_req, "$COF_Id$", mo_Tools.SQLStr(as_COF_Id), , , vbTextCompare)
  lc_Cursor = mo_Tools.OpenSQLSafe(mo_ArmDb, ls_req)
  ll_COT_ID = mo_ArmDb.GetFields(lc_Cursor, "COT_Id")
  ll_COTZ_ID = mo_ArmDb.GetFields(lc_Cursor, "COTZ_Id")
  ls_Language_Code = mo_ArmDb.GetFields(lc_Cursor, "Language_Code")
  ll_Code_Page = mo_ArmDb.GetFields(lc_Cursor, "Code_Page")
  Call mo_ArmDb.Close(lc_Cursor)
  
  If Not mo_OutPut.PrintOffer(as_COF_Id, ll_COT_ID, ll_COTZ_ID, App.Path & "\" & C_PRINTTMPFOLDER, ls_folderName, ls_Language_Code, ll_Code_Page, ab_PrintPictures, ab_PrintTotal, ab_PrintReps, ab_SaveAsPDF, ab_InterCompany, ab_PrintGeneralTerms, ab_PrintASItemMessage) Then
      Call Err.Raise(Err.CompFncFailed, "mo_OutPut.PrintOffer", "Not printed!")
  End If
  Exit Sub
ErrHandler:
  Call ErrorHandler("PrintOffer()")
End Sub

Public Sub PrintOfferPacking(ByVal as_COF_Id As String, Optional ab_SaveAsPDF As Boolean = False)
On Error GoTo ErrHandler
  
Dim ls_req          As String
Dim lc_Cursor       As Long
Dim ls_folderName   As String
Dim ls_ss           As String
Dim ll_COT_ID       As Long
Dim ll_COTZ_ID      As Long
Dim ls_Language_Code    As String
Dim ll_Code_Page    As Long
  
  mo_OutPut.navBar = vpnbTopPrint
  ls_folderName = "OfferTmp"
  
  
'  ls_req = "SELECT COF.COT_Id, COT.COTZ_Id, COT.Language_Code, LNG.Code_Page "
'  ls_req = ls_req & "FROM Cap_Offer COF "
'  ls_req = ls_req & "INNER JOIN Cap_OfferTemplate COT ON (COF.COT_Id=COT.COT_Id)"
'  ls_req = ls_req & "LEFT JOIN language LNG ON (COT.Language_Code=LNG.Language_Code)"
'  ls_req = ls_req & "WHERE COF.COF_Id=$COF_Id$"
'  ls_req = Replace(ls_req, "$COF_Id$", mo_Tools.SQLStr(as_COF_Id), , , vbTextCompare)
'  lc_Cursor = mo_Tools.OpenSQLSafe(mo_ArmDb, ls_req)
'  ll_COT_ID = mo_ArmDb.GetFields(lc_Cursor, "COT_Id")
'  ll_COTZ_ID = mo_ArmDb.GetFields(lc_Cursor, "COTZ_Id")
'  ls_Language_Code = mo_ArmDb.GetFields(lc_Cursor, "Language_Code")
'  ll_Code_Page = mo_ArmDb.GetFields(lc_Cursor, "Code_Page")
'  Call mo_ArmDb.Close(lc_Cursor)
  
  ll_COT_ID = 77
  ll_COTZ_ID = 77
  ls_Language_Code = "E"
  ll_Code_Page = "1252"
  
  If Not mo_OutPut.PrintOfferPacking(as_COF_Id, ll_COT_ID, ll_COTZ_ID, App.Path & "\" & C_PRINTTMPFOLDER, ls_folderName, ls_Language_Code, ll_Code_Page, ab_SaveAsPDF) Then
      Call Err.Raise(Err.CompFncFailed, "mo_OutPut.PrintOfferPacking", "Not printed!")
  End If
  Exit Sub
ErrHandler:
  Call ErrorHandler("PrintOffer()")
End Sub

Public Property Get SerializedReprintString()
On Error GoTo ErrHandler
        SerializedReprintString = mo_OutPut.SerializedReprintString
    Exit Property
ErrHandler:
    Call ErrorHandler("get SerializedReprintString()")
End Property

' ************************************************************************************
' **************************** REDIM FUNCTION ****************************************
' ************************************************************************************
Sub SafeRedimString(ByRef as_Array() As String, al_NumElements As Long)

On Error GoTo ErrHandler

  If al_NumElements = 0 Then
          ReDim as_Array(-1 To -1)
  Else
          'MS REDIMM
          Call SafeRedimPreserve(as_Array, al_NumElements - 1)
  End If
  Exit Sub
ErrHandler:
    Call ErrorHandler("SafeRedimString()")
End Sub

Sub SafeRedim(ByRef av_Array() As Variant, al_NumElements As Long)

On Error GoTo ErrHandler

  If al_NumElements = 0 Then
          ReDim av_Array(-1 To -1)
  Else
          'MS REDIMM
          Call SafeRedimPreserve(av_Array, al_NumElements - 1)
  End If
  Exit Sub
ErrHandler:
    Call ErrorHandler("SafeRedim()")
End Sub
' **************************** REDIM FUNCTION ****************************************

' ************************************************************************************
' ********************** ERROR-HANDLING SUPPORT FUNCTIONS ****************************
' ************************************************************************************
#If LIVE = 1 Then
Private Function GetDbError(ByVal lo_Db As Object) As String
#Else
Private Function GetDbError(ByVal lo_Db As ARMSYSCOMLib.ArmDb) As String
#End If
On Error GoTo ErrHandler
    If IsArray(lo_Db.SQLErrorMessages) Then
        Debug.Assert (IsArray(lo_Db.SQLErrorCodes))
        ' Display errors msgBox
        GetDbError = Join(lo_Db.SQLErrorCodes, ",") & vbCrLf & Join(lo_Db.SQLErrorMessages, vbCrLf)
    Else
        ' ExecuteSQL failed but no error message?
        GetDbError = "Unknown error"
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler("GetDbError()")
End Function

' Standard error handler
Private Sub ErrorHandler(ByVal as_Fct As String)
    Call Err.Raise(Err.Number, as_Fct & SEP1 & Err.Source, Err.Description)
End Sub

' display standard error message
Private Sub ErrorMessage(ByVal as_Fct As String)
    If Err.Number = QuietException Then Exit Sub
    Dim ll_oldMP As MousePointerConstants
    
    'save mouse pointer
    ll_oldMP = Screen.MousePointer
    Screen.MousePointer = vbDefault
    
    Dim ls_ErrSource As String
    Dim ls_errDescription As String
    ls_ErrSource = as_Fct & SEP1 & Err.Source
    ls_errDescription = Err.Description
    
    Call LogMessage(App.ProductName & " exception raised. Err.Number:" & Err.Number & ", Err.Source:" & ls_ErrSource & ", Err.Description " & ls_errDescription & ".", "E", False)
    Call MsgBox("Error occured, please contact IT" & vbCrLf & ls_ErrSource & vbCrLf & "Description: " & ls_errDescription, , "Error message: " & as_Fct)
    
    'restore mouse pointer
    Screen.MousePointer = ll_oldMP
End Sub


Private Sub LogMessage(ByVal as_logMsg As String, Optional ByVal as_logType As String = "I", Optional ab_throwException As Boolean = True)
On Error GoTo ErrHandler
Const InsertReq As String = "INSERT INTO A_Log (U_code, Z_creation_date, Source , Log_type, Log_Msg ) VALUES ($UCODE$, GETDATE(), '$APP$', '$LOGTYPE$', '$MSG$')"
    Dim ls_req As String
    Dim ll_cursor As Long
    
    ls_req = Replace(InsertReq, "$UCODE$", CStr(ml_U_Code))
    ls_req = Replace(ls_req, "$APP$", SQLStr(C_APPNAME & " " & App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision, 50))
    ls_req = Replace(ls_req, "$MSG$", SQLStr(as_logMsg, 4000))
    ls_req = Replace(ls_req, "$LOGTYPE$", SQLStr(as_logType), 1)
    
    Call ExecuteSQLSafe(mo_ArmDb, ls_req)
    Exit Sub
ErrHandler:
    If ab_throwException Then Call ErrorHandler("LogMessage()")
End Sub

' procedure save/restore err object
Private Sub UpdateError(Optional ab_saveError As Boolean = False)
Static ls_ErrDesc As String
Static ls_ErrSource As String
Static ll_errnum As Long
    
    If ab_saveError Then
        ls_ErrDesc = Err.Description
        ls_ErrSource = Err.Source
        ll_errnum = Err.Number
    Else
        Err.Description = ls_ErrDesc
        Err.Source = ls_ErrSource
        Err.Number = ll_errnum
    End If
End Sub
' ************************************************************************************

' ************************************************************************************
' **************************** DB-ACCESS FUNCTIONS ***********************************
' ************************************************************************************
#If LIVE = 1 Then
Private Sub ExecuteSQLSafe(ByVal ao_DB As Object, ByVal as_req As String)
#Else
Private Sub ExecuteSQLSafe(ByVal ao_DB As ARMSYSCOMLib.ArmDb, ByVal as_req As String)
#End If

    If Not ao_DB.ExecuteSQL(as_req) Then
        Call Err.Raise(CompFncFailed, "ExecuteSQLSafe", "SQL Error: " & GetDbError(ao_DB))
    End If

End Sub

#If LIVE = 1 Then
Private Function OpenSQLSafe(ByVal ao_DB As Object, ByVal as_req As String) As Long
#Else
Private Function OpenSQLSafe(ByVal ao_DB As ARMSYSCOMLib.ArmDb, ByVal as_req As String) As Long
#End If

    OpenSQLSafe = ao_DB.OpenSQL(as_req)
    
    If OpenSQLSafe = 0 Then Call Err.Raise(CompFncFailed, "OpenSQLSafe", "SQL Error: " & GetDbError(ao_DB))

End Function

Private Function SQLStr(ByVal as_str As String, Optional ByVal al_MaxLen As Long = 8000) As String
    SQLStr = Replace(Left(as_str, IIf(Len(as_str) <= al_MaxLen, Len(as_str), al_MaxLen)), "'", "''")
End Function


Private Sub Form_Resize()
    If mb_Loaded Then
        Call InitCtrlSize
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error GoTo ErrHandler
  
  Call Unload_A_COM
  Exit Sub
ErrHandler:
  Call ErrorMessage("Form_Unload()")
End Sub

