VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmDPC_Image 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "#Image Upload"
   ClientHeight    =   8730
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   14505
   ControlBox      =   0   'False
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   8730
   ScaleWidth      =   14505
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Tag             =   "frmDPC_Image"
   Visible         =   0   'False
   Begin VB.CommandButton btn_Validate 
      Default         =   -1  'True
      Height          =   612
      Left            =   13035
      Style           =   1  'Graphical
      TabIndex        =   3
      Tag             =   "btn_Validate"
      Top             =   7995
      Width           =   612
   End
   Begin VB.CommandButton btn_Quit 
      Height          =   612
      Left            =   13830
      Style           =   1  'Graphical
      TabIndex        =   2
      Tag             =   "btn_Quit"
      Top             =   7980
      Width           =   612
   End
   Begin VB.Frame fra_Selection 
      Height          =   7680
      Left            =   240
      TabIndex        =   0
      Tag             =   "fra_Selection"
      Top             =   120
      Width           =   14175
      Begin VB.CommandButton cmd_Save_As 
         Caption         =   "#Save As ..."
         Height          =   375
         Left            =   7320
         TabIndex        =   18
         Tag             =   "cmd_SaveAs"
         Top             =   3360
         Width           =   2415
      End
      Begin VB.CommandButton cmd_ClearImage 
         Caption         =   "#Clear Image"
         Height          =   375
         Left            =   7320
         TabIndex        =   17
         Tag             =   "cmd_ClearImage"
         Top             =   2880
         Width           =   2415
      End
      Begin VB.CheckBox chk_Valid 
         Height          =   375
         Left            =   11160
         TabIndex        =   9
         Tag             =   "IMI_Valid"
         Top             =   1320
         Width           =   255
      End
      Begin VB.CommandButton cmd_SelectExisting 
         Caption         =   "#Select Existing ..."
         Height          =   375
         Left            =   7320
         TabIndex        =   15
         Tag             =   "cmd_SelExis"
         Top             =   2400
         Visible         =   0   'False
         Width           =   2415
      End
      Begin VB.TextBox txt_IMI_Name 
         Height          =   375
         Left            =   8520
         TabIndex        =   13
         Tag             =   "IMI_Name"
         Top             =   360
         Width           =   2775
      End
      Begin VB.TextBox txt_FileName 
         Height          =   375
         Left            =   12720
         TabIndex        =   12
         Tag             =   "IMI_FileName"
         Top             =   360
         Width           =   1095
      End
      Begin VB.TextBox txt_IMI_Id 
         Enabled         =   0   'False
         Height          =   285
         Left            =   13200
         TabIndex        =   11
         Tag             =   "IMI_Id"
         Top             =   840
         Width           =   615
      End
      Begin VB.TextBox txt_FileNamePath 
         Enabled         =   0   'False
         Height          =   375
         Left            =   7320
         TabIndex        =   10
         Top             =   1800
         Width           =   5415
      End
      Begin VB.TextBox txt_Height 
         Enabled         =   0   'False
         Height          =   375
         Left            =   8520
         TabIndex        =   8
         Tag             =   "IMI_Height"
         Top             =   1320
         Width           =   1095
      End
      Begin VB.TextBox txt_Width 
         Enabled         =   0   'False
         Height          =   375
         Left            =   8520
         TabIndex        =   7
         Tag             =   "IMI_Width"
         Top             =   840
         Width           =   1095
      End
      Begin VB.CommandButton cmd_BrowseFile 
         Caption         =   "..."
         Height          =   375
         Left            =   12840
         TabIndex        =   4
         Top             =   1800
         Width           =   1215
      End
      Begin VB.PictureBox pic_ImgBox 
         Appearance      =   0  'Flat
         AutoRedraw      =   -1  'True
         BackColor       =   &H80000005&
         ForeColor       =   &H80000008&
         Height          =   6390
         Left            =   60
         ScaleHeight     =   6360
         ScaleWidth      =   7020
         TabIndex        =   1
         Top             =   375
         Width           =   7050
      End
      Begin VB.Label lbl_Label 
         Caption         =   "#Valid"
         Height          =   255
         Index           =   1
         Left            =   10200
         TabIndex        =   16
         Tag             =   "lbl_IMI_Valid"
         Top             =   1440
         Width           =   855
      End
      Begin VB.Label lbl_Label 
         Caption         =   "#Name"
         Height          =   255
         Index           =   0
         Left            =   7320
         TabIndex        =   14
         Tag             =   "lbl_IMI_Width"
         Top             =   480
         Width           =   735
      End
      Begin VB.Label lbl_Label 
         Caption         =   "#Height"
         Height          =   255
         Index           =   3
         Left            =   7320
         TabIndex        =   6
         Tag             =   "lbl_IMI_Height"
         Top             =   1440
         Width           =   615
      End
      Begin VB.Label lbl_Label 
         Caption         =   "#Width"
         Height          =   255
         Index           =   2
         Left            =   7320
         TabIndex        =   5
         Tag             =   "lbl_IMI_Width"
         Top             =   960
         Width           =   735
      End
   End
   Begin MSComDlg.CommonDialog dlg_Common 
      Left            =   8160
      Top             =   0
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
End
Attribute VB_Name = "frmDPC_Image"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Const CL_COLOR_ENABLED As Long = &H80000005
Private Const CL_COLOR_DISABLED As Long = &H8000000F

Private Const C_ERRORRAISE As Long = 2500
Private Const SEP = "®©"
Private Const C_SEP As String = "@@"
Private Const SEP1 As String = "®"
Private Const SEP2 As String = "©"
Private Const SCREEN_NAME As String = "frmDPC_Image"
Private Const C_MSG_ID_BASE As Long = 9800

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
    SQLTableReferenceConstraint = vbObjectError + 13 ' A SQL request cannot be executed : Table reference constraint
    DuplicityDetected = vbObjectError + 2301     ' detected row with same unique id
End Enum

#If ENV = LIVE Then
Private mo_Db As Object
Private mo_FSO As Object
#Else
Private mo_Db As ARMSYSCOMLib.ArmDb
Private mo_FSO As FileSystemObject
#End If

Private ms_DPCImageCachePath As String
Private ml_U_Code As Long
Private ms_Language_Code As String
Private mc_ScreenLabels As Long
Private mo_Tools As DPC_Tools
Private ms_PicPath                      As String       'used to save images from database
Private ml_iConcurrency As Long
Private mb_ImageChanged As Boolean  'indicate if image picture was changed
Private mb_ShowSelectExisting As Boolean
Private me_ImageType As eDPCImageType
Private mb_ImageSelectExisting As Boolean  'indicate if existing image was selected


Public Mode As eDPCScreenMode
Public IMG_Id As Long
Public Result As Boolean

Property Let Language_Code(AString As String)
  ms_Language_Code = AString
End Property

Property Get Language_Code() As String
  Language_Code = ms_Language_Code
End Property

Public Property Set ArmDb(ByRef lo_Db As Object)
  If Not (lo_Db Is Nothing) Then
      Set mo_Db = lo_Db
  End If
End Property

Property Let U_Code(al_Code As Long)
  ml_U_Code = al_Code
End Property

Property Let ShowSelectExisting(ab_ShowSel As Boolean)
  mb_ShowSelectExisting = ab_ShowSel
End Property

Property Let ImageType(ae_Type As eDPCImageType)
  me_ImageType = ae_Type
End Property

Public Property Set Tools(ByRef ao_Tools As Object)
On Error GoTo ErrorHandler

  Set mo_Tools = ao_Tools
  Exit Property
ErrorHandler:
  Call ErrorHandler("Tools.Set")
End Property

Public Sub Load_A_COM()
On Error GoTo ErrHandler

Dim ll_max As Long
    
  If mo_Db Is Nothing Then
      Call Err.Raise(ArmErr.PropertyNotSet)
  End If
  If mo_Tools Is Nothing Then
      Call Err.Raise(ArmErr.PropertyNotSet)
  End If
    
  ms_DPCImageCachePath = prg.AppCache_Dir & DPC_IMAGE_CACHE
  btn_Validate.Picture = LoadResPicture(RES_OK, 1)
  btn_Quit.Picture = LoadResPicture(RES_QUIT, 1)
  Set mo_FSO = New FileSystemObject
    
  ms_PicPath = prg.AppCache_Dir & DPC_IMAGE_CACHE
  
  Set pic_ImgBox.Picture = Nothing
      
  Call ShowImage(IMG_Id, "")
  mb_ImageChanged = False
  mb_ImageSelectExisting = False
  
  If mb_ShowSelectExisting = True And (Mode = eDPCScreenMode.smAdd Or Mode = eDPCScreenMode.smUpdate) Then
    cmd_SelectExisting.Visible = True
  Else
    cmd_SelectExisting.Visible = False
  End If
  
  If Mode = eDPCScreenMode.smNone Then
    Call mo_Tools.EnableFrame(Me.Controls, Me, False)
    btn_Quit.Enabled = True
    
    'txt_IMI_Name.Locked = True
    'txt_FileName.Locked = True
    'cmd_BrowseFile.Enabled = False
    'chk_Valid.Enabled = False
  End If
  
  Call mo_Tools.Load_A_ComControls(Me.Controls, mo_Db, ms_Language_Code, Me.hwnd)
  'Screen csts
  mc_ScreenLabels = mo_Tools.LoadLabels(mo_Db, Me.Controls, Me, SCREEN_NAME, ms_Language_Code, Me.hwnd)
  Call mo_Tools.ChangeCharset(Me.Controls, gl_CodePage, gl_CodePage, Me)
  Result = False
  Exit Sub
ErrHandler:
  Call ErrorHandler("Load_A_COM")
End Sub

Public Sub Unload_A_COM()
On Error GoTo ErrHandler

  Call mo_Tools.Unload_A_ComControls(Me.Controls, Me.hwnd)
  Call mo_Db.Close(mc_ScreenLabels)
  Set mo_Db = Nothing
  Set mo_FSO = Nothing
  Set mo_Tools = Nothing
  
  Exit Sub
ErrHandler:
  Call ErrorHandler("Unload_A_COM")
End Sub

Private Sub DrawSelImage(ByVal ao_Image As StdPicture, ByVal ao_Canvas As PictureBox)
Dim lf_AspectRatioX As Double
Dim lf_AspectRatioY As Double
Dim lf_Width As Double
Dim lf_Height As Double

  Set ao_Canvas.Picture = Nothing
  If ao_Image Is Nothing Then
    Exit Sub
  End If
  
  lf_Width = ao_Canvas.ScaleX(ao_Image.Width, vbHimetric, vbTwips)
  lf_Height = ao_Canvas.ScaleY(ao_Image.Height, vbHimetric, vbTwips)
  
  If (lf_Height > ao_Canvas.ScaleHeight) Or (lf_Width > ao_Canvas.ScaleWidth) Then
    lf_AspectRatioX = ao_Canvas.ScaleWidth / lf_Width
    lf_AspectRatioY = ao_Canvas.ScaleHeight / lf_Height
    If lf_AspectRatioX < lf_AspectRatioY Then
      lf_Width = lf_Width * lf_AspectRatioX
      lf_Height = lf_Height * lf_AspectRatioX
    Else
      lf_Width = lf_Width * lf_AspectRatioY
      lf_Height = lf_Height * lf_AspectRatioY
    End If
  End If
  Call ao_Canvas.PaintPicture(ao_Image, (ao_Canvas.ScaleWidth - lf_Width) / 2, (ao_Canvas.ScaleHeight - lf_Height) / 2, lf_Width, lf_Height)
  'Call ao_Canvas.PaintPicture(ao_Image, 0, 0)
  'ao_Canvas.Picture = ao_Canvas.Image
  
End Sub

Private Function LoadSelImage(ByVal al_IMG_Id As Long) As StdPicture
Dim ls_PicName As String

  Set LoadSelImage = Nothing
  If al_IMG_Id = 0 Then Exit Function
  ls_PicName = ms_PicPath & "IMG" & al_IMG_Id & ".jpg"
  If Not mo_FSO.FileExists(ls_PicName) Then
    If Not mo_Db.BlobToFileSQL("SELECT IMG_File FROM DPC_Image WHERE IMG_Id=" & al_IMG_Id, ls_PicName, True, False) Then
      Call MsgBox(mo_Tools.MsgText(mo_Db, ms_Language_Code, C_MSG_ID_BASE + 44, "#Cannot download the image from db - IMG_Id:" & al_IMG_Id))
      Exit Function
    End If
  End If
  Set LoadSelImage = LoadPicture(ls_PicName)
End Function

Private Function DeleteImage(ByVal al_IMG_Id As Long) As Boolean
Dim ls_PicName As String

  DeleteImage = False
  If al_IMG_Id = 0 Then Exit Function
  ls_PicName = ms_PicPath & "IMG" & al_IMG_Id & ".jpg"
  If mo_FSO.FileExists(ls_PicName) Then
        Call mo_FSO.DeleteFile(ls_PicName)
  End If
  DeleteImage = True
End Function

Private Sub UploadImage(ByVal as_FileName As String, ByVal as_IMG_Id As String)
On Error GoTo ErrHandler

Dim ll_Index As Long
Dim ls_RequestIns As String
Dim ls_Filename As String

    ls_RequestIns = "INSERT INTO DPC_Image (IMG_Id,IMG_File) VALUES ($IMG_Id$,?)"
    ls_RequestIns = mo_Tools.ReplacePlaceHolder(ls_RequestIns, "$IMG_Id$", as_IMG_Id)
        
    If Not mo_Db.FileToBlobSQL(ls_RequestIns, as_FileName, 9) Then
        Err.Raise ArmErr.SQLFailure, "FileToBlobSQL", mo_Db.LastErrorMessage & " Error writing blob: " & ls_RequestIns & " File: " & ls_Filename
    End If

    Exit Sub
ErrHandler:
    Call ErrorHandler("UploadImage as_FileName=" & as_FileName)
End Sub

Private Sub UpdateImage(ByVal as_FileName As String, ByVal as_IMG_Id As String)
On Error GoTo ErrHandler

Dim ll_Index As Long
Dim ls_RequestUpd As String
Dim ls_Filename As String

    ls_RequestUpd = "UPDATE DPC_Image SET IMG_File = ? WHERE IMG_Id = $IMG_Id$"
    ls_RequestUpd = mo_Tools.ReplacePlaceHolder(ls_RequestUpd, "$IMG_Id$", as_IMG_Id)
        
    If Not mo_Db.FileToBlobSQL(ls_RequestUpd, as_FileName, 9) Then
        Err.Raise ArmErr.SQLFailure, "FileToBlobSQL", mo_Db.LastErrorMessage & " Error writing blob: " & ls_RequestUpd & " File: " & ls_Filename
    End If

    Exit Sub
ErrHandler:
    Call ErrorHandler("UploadImage as_FileName=" & as_FileName)
End Sub

Private Function ShowImage(ByVal al_ImgId As Long, ByVal as_FileName As String) As Boolean
On Error GoTo ErrHandler

Dim ls_Request As String
Dim ll_Cursor As Long

    If al_ImgId > 0 Then
        ls_Request = "exec DPC_ImageInfo_sel " & al_ImgId & ",$Language_Code$"
        ls_Request = Replace(ls_Request, "$Language_Code$", mo_Tools.SQLStr(Language_Code), , , vbTextCompare)
        ll_Cursor = mo_Tools.OpenSQLSafe(mo_Db, ls_Request)
        
        If Not mo_Db.EOF(ll_Cursor) Then
            txt_IMI_Name.Text = mo_Db.GetFields(ll_Cursor, "IMI_Name")
            txt_IMI_Id.Text = al_ImgId
            txt_Width.Text = mo_Db.GetFields(ll_Cursor, "IMI_Width")
            txt_Height.Text = mo_Db.GetFields(ll_Cursor, "IMI_Height")
            txt_FileName.Text = mo_Db.GetFields(ll_Cursor, "IMI_FileName")
            txt_FileNamePath.Text = ms_PicPath & "IMG" & al_ImgId & ".jpg"
            If mo_Db.GetFields(ll_Cursor, "IMI_Valid") = "X" Then
                chk_Valid.Value = Checked
            Else
                chk_Valid.Value = False
            End If
            ml_iConcurrency = mo_Db.GetFields(ll_Cursor, "iConcurrency")
        Else
            Err.Raise ArmErr.CompFncFailed, "ShowImage", "#Image does not exists in DPC_Image table with IMG_Id=" & al_ImgId
        End If
    
        Call DrawSelImage(LoadSelImage(al_ImgId), pic_ImgBox)
        
        Call mo_Db.Close(ll_Cursor)
        
    ElseIf as_FileName <> "" Then
        Call DrawSelImage(LoadPicture(as_FileName), pic_ImgBox)
        
        txt_Width.Text = Round(pic_ImgBox.ScaleX(pic_ImgBox.Image.Width, vbHimetric, vbPixels))
        txt_Height.Text = Round(pic_ImgBox.ScaleY(pic_ImgBox.Image.Height, vbHimetric, vbPixels))

    End If
    
    ShowImage = True
    
    Exit Function
ErrHandler:
        
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
    End If

    ShowImage = False
    Call ErrorHandler("ShowImage")
End Function

Private Sub btn_Quit_Click()
On Error GoTo ErrHandler
    
  Result = False
  Hide
  Exit Sub
ErrHandler:
  Call ErrorMessage("btn_Quit_Click")
End Sub

Private Sub btn_Validate_Click()
On Error GoTo ErrHandler
  
'Dim ll_IMG_Id_orig As Long
Dim ls_Request As String

  Call mo_Tools.LockScreen(Me, True)
  
    If IMG_Id = 0 And Mode <> eDPCScreenMode.smAdd Then
        Result = True
        Hide
        Call mo_Tools.LockScreen(Me, False)
        Exit Sub
    End If
    
    If (Mode = eDPCScreenMode.smUpdate Or Mode = eDPCScreenMode.smAdd) And txt_FileNamePath.Text = "" Then
        Call mo_Tools.ShowMsg(mo_Db, ms_Language_Code, 9736, "#Please select image")
        Call mo_Tools.LockScreen(Me, False)
        Exit Sub
    End If
    
  
    If (Mode = eDPCScreenMode.smUpdate Or Mode = eDPCScreenMode.smAdd) And txt_FileNamePath.Text <> "" Then
    
        If mb_ImageChanged = True And mb_ImageSelectExisting = False Then
            'll_IMG_Id_orig = IMG_Id
            IMG_Id = mo_Tools.GetNextID(mo_Db, "DPC_Image")
            txt_IMI_Id.Text = IMG_Id
            Call UploadImage(txt_FileNamePath, IMG_Id)
                      
            ls_Request = "exec DPC_ImageInfo_ins2 $IMI_Id$,$Language_Code$,$IMI_Name$,$IMI_FileName$,$IMI_Width$,$IMI_Height$,$IMI_Valid$,$IMI_Type$,$Z_creator$"
        
            ls_Request = mo_Tools.ReplaceRequestByFrameData(ls_Request, Me.Controls, fra_Selection)
            ls_Request = Replace(ls_Request, "$IMI_Type$", mo_Tools.SqlInt(me_ImageType), , , vbTextCompare)
            ls_Request = Replace(ls_Request, "$Language_Code$", mo_Tools.SQLStr(Language_Code), , , vbTextCompare)
            ls_Request = Replace(ls_Request, "$Z_creator$", ml_U_Code)
            
            Call mo_Tools.ExecuteSQLSafe(mo_Db, ls_Request)
        Else
            ls_Request = "exec DPC_ImageInfo_upd $IMI_Id$,$Language_code$,$IMI_Name$,$IMI_FileName$,$IMI_Width$,$IMI_Height$,$IMI_Valid$,$Z_last_upd_user$,$iConcurrency$"
            ls_Request = mo_Tools.ReplaceRequestByFrameData(ls_Request, Me.Controls, fra_Selection)
            ls_Request = Replace(ls_Request, "$Language_Code$", mo_Tools.SQLStr(Language_Code), , , vbTextCompare)
            ls_Request = Replace(ls_Request, "$Z_last_upd_user$", ml_U_Code)
            ls_Request = mo_Tools.ReplacePlaceHolder(ls_Request, "$iConcurrency$", ml_iConcurrency)
        
            Call mo_Tools.ExecuteSQLSafe(mo_Db, ls_Request, 1)
        End If
                        
        'Call DeleteImage(ll_IMG_Id_orig)
    End If
  
    'If Mode = eDPCScreenMode.smAdd And txt_FileNamePath <> "" Then
        
    '    IMG_Id = mo_Tools.GetNextID(mo_Db, "DPC_Image")
    '    txt_IMI_Id.Text = IMG_Id
    '    Call UploadImage(txt_FileNamePath, IMG_Id)
    
    '    ls_Request = "exec DPC_ImageInfo_ins2 $IMI_Id$,$Language_Code$,$IMI_Name$,$IMI_FileName$,$IMI_Width$,$IMI_Height$,$IMI_Valid$,$IMI_Type$,$Z_creator$"
    
    '    ls_Request = mo_Tools.ReplaceRequestByFrameData(ls_Request, Me.Controls, fra_Selection)
    '    ls_Request = Replace(ls_Request, "$IMI_Type$", mo_Tools.SqlInt(me_ImageType), , , vbTextCompare)
    '    ls_Request = Replace(ls_Request, "$Language_Code$", mo_Tools.SQLStr(Language_Code), , , vbTextCompare)
    '    ls_Request = Replace(ls_Request, "$Z_creator$", ml_U_Code)
        
    '    Call mo_Tools.ExecuteSQLSafe(mo_Db, ls_Request)
    'End If
  
  Result = True
  Hide
  Call mo_Tools.LockScreen(Me, False)
  Exit Sub
ErrHandler:
  Call ErrorMessage("btn_Validate_Click")
End Sub

' display standard error message
Public Sub ErrorMessage(ByVal as_Fct As String)
    Dim ls_ErrSource As String
    Dim ls_errDescription As String
    Dim ls_Message As String
    
    ls_ErrSource = as_Fct & SEP1 & Err.Source
    ls_errDescription = Err.Description
    ls_Message = SCREEN_NAME & " exception. Nr:" & Err.Number & ",Desc: " & ls_errDescription & ",Src:" & ls_ErrSource & "@"
    Call mo_Tools.LogMessage(mo_Db, ml_U_Code, SCREEN_NAME, ls_Message, "E")
    Call MsgBox("Error occured, please contact IT. Application will now shutdown." & vbCrLf & ls_ErrSource & vbCrLf & "Description: " & ls_errDescription, vbCritical, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision)
    End
End Sub

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

Private Sub cmd_BrowseFile_Click()
On Error GoTo ErrHandler
    
Dim ls_Filename As String
    
    dlg_Common.Filter = "JPG files (*.JPG)|*.JPG"
    dlg_Common.CancelError = False
    Call dlg_Common.ShowOpen
    ls_Filename = dlg_Common.FileName
    If ls_Filename <> "" Then
        txt_FileNamePath.Text = ls_Filename
        txt_FileName.Text = right(ls_Filename, Len(ls_Filename) - InStrRev(ls_Filename, "\", -1, vbTextCompare))
        If InStrRev(txt_FileName.Text, ".", -1, vbTextCompare) > 0 Then
            txt_IMI_Name.Text = Left(txt_FileName.Text, InStrRev(txt_FileName.Text, ".", -1, vbTextCompare) - 1)
        Else
            txt_IMI_Name.Text = txt_FileName.Text
        End If
        
        mb_ImageChanged = True
        mb_ImageSelectExisting = False
        
        Call ShowImage(-1, ls_Filename)
      
    End If
    Exit Sub
ErrHandler:
    Call ErrorMessage("cmd_BrowseFile_Click")
End Sub

Private Sub cmd_ClearImage_Click()
On Error GoTo ErrHandler

    IMG_Id = 0
    txt_IMI_Id.Text = ""
    txt_IMI_Name.Text = ""
    txt_FileName.Text = ""
    txt_Width.Text = ""
    txt_Height.Text = ""
    txt_FileNamePath = ""
    
    Set pic_ImgBox.Picture = Nothing
    'pic_ImgBox.Cls

    Exit Sub

ErrHandler:
  Call ErrorMessage("cmd_ClearImage_Click")
End Sub

Private Sub cmd_Save_As_Click()
On Error GoTo ErrHandler
    
Dim ls_Filename As String
    
    dlg_Common.Filter = "All files (*.*)|*.*"
    dlg_Common.CancelError = True
    dlg_Common.FileName = txt_FileName.Text
    dlg_Common.ShowSave
    
    If dlg_Common.FileName <> "" Then
        ls_Filename = dlg_Common.FileName
        If mo_FSO.FileExists(ls_Filename) Then
            If MsgBox(mo_Tools.MsgText(mo_Db, ms_Language_Code, C_MSG_ID_BASE + 45, "#A file with this name already exists. Do you want to overwrite it?"), vbOKCancel) = vbCancel Then
                Exit Sub
            End If
        End If
        If Not mo_Db.BlobToFileSQL("SELECT IMG_File FROM DPC_Image WHERE IMG_Id=" & txt_IMI_Id.Text, ls_Filename, True, False) Then
          Call MsgBox(mo_Tools.MsgText(mo_Db, ms_Language_Code, C_MSG_ID_BASE + 43, "#Cannot download the file from db - IMG_Id:" & txt_IMI_Id.Text))
          Exit Sub
        End If
    
    End If
    Exit Sub
ErrHandler:
    If Err.Number = cdlCancel Then  ' this line is not executed on cancel
        Exit Sub
    End If
    Call ErrorMessage("cmd_Save_As_Click")
End Sub

Private Sub cmd_SelectExisting_Click()
On Error GoTo ErrHandler
    
Dim lo_Frm As frmDPC_ImgSel
Dim ls_Class As String
Dim lv_Arrang As Variant
Dim lv_Shape As Variant
    
  Call mo_Tools.LockScreen(Me, True)
  Set lo_Frm = New frmDPC_ImgSel
  
  Load lo_Frm
  
  If me_ImageType = eDPCImageType.itLogo Then
    lo_Frm.Request = "SELECT IMI.IMI_Id,IMI.IMI_Id as IMG_Id,IMI.IMI_Name,IMI.IMI_Name  " & _
    "FROM DPC_ImageInfo IMI " & _
    "WHERE IMI.Drop_Flag='' and IMI.IMI_Id>=0 AND IMI.IMI_Type = " & me_ImageType
  Else
    lo_Frm.Request = "SELECT SUA.SUA_Id,PRC.IMG_Id,PRD.PRD_Name,PRD.PRD_Desc  " & _
    "FROM DPC_SubArticle SUA " & _
    "INNER JOIN DPC_PrdCommon PRC ON (SUA.SUA_Id=PRC.PRD_Id) " & _
    "INNER JOIN DPC_PrdDesc PRD ON (SUA.SUA_Id=PRD.PRD_Id AND PRD.Language_Code=$Language_Code$) " & _
    "WHERE SUA.Drop_Flag='' and PRC.IMG_Id>=0 "
  End If
    
  Set lo_Frm.ArmDb = mo_Db
  Set lo_Frm.Tools = mo_Tools
  lo_Frm.Language_Code = Language_Code
  Call lo_Frm.Load_A_COM
  
  Call mo_Tools.LockScreen(Me, False)
  Call mo_Tools.ShowModalForm(lo_Frm)
  Call mo_Tools.LockScreen(Me, True)
  
  If lo_Frm.Result Then
'    mb_InternalInit = True
    Call ShowImage(lo_Frm.SelectedIMG_Id, "")
    IMG_Id = lo_Frm.SelectedIMG_Id
    
    mb_ImageChanged = True
    mb_ImageSelectExisting = True
    
'    mb_InternalInit = False
  End If
  Unload lo_Frm
  Call mo_Tools.LockScreen(Me, False)
  Exit Sub
ErrHandler:
  Call ErrorMessage("cmd_SelectExisting_Click")
End Sub

