VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form Media_dsp 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Media"
   ClientHeight    =   6735
   ClientLeft      =   570
   ClientTop       =   1530
   ClientWidth     =   7905
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   NegotiateMenus  =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   6735
   ScaleWidth      =   7905
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.OptionButton rd_hires 
      Caption         =   "Option2"
      Enabled         =   0   'False
      Height          =   255
      Left            =   5520
      TabIndex        =   16
      Top             =   120
      Width           =   195
   End
   Begin VB.VScrollBar sbv_Frame 
      Height          =   4800
      LargeChange     =   3555
      Left            =   6840
      Min             =   1
      SmallChange     =   50
      TabIndex        =   14
      Top             =   600
      Value           =   1
      Width           =   255
   End
   Begin VB.HScrollBar sbh_Frame 
      Height          =   255
      LargeChange     =   4875
      Left            =   600
      Min             =   1
      SmallChange     =   50
      TabIndex        =   13
      Top             =   5760
      Value           =   1
      Width           =   6075
   End
   Begin VB.Frame Frame1 
      BorderStyle     =   0  'None
      Height          =   4800
      Left            =   600
      TabIndex        =   12
      Top             =   600
      Width           =   6075
      Begin VB.Image ImagN1 
         Height          =   4800
         Left            =   480
         Top             =   360
         Width           =   6200
      End
   End
   Begin VB.OptionButton rd_Thumbnail 
      Caption         =   "Option1"
      Enabled         =   0   'False
      Height          =   195
      Left            =   540
      TabIndex        =   10
      Top             =   120
      Width           =   255
   End
   Begin MSComDlg.CommonDialog dlg_save 
      Left            =   60
      Top             =   615
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      InitDir         =   "C:\"
   End
   Begin VB.OptionButton rd_Full 
      Caption         =   "Option2"
      Enabled         =   0   'False
      Height          =   255
      Left            =   3810
      TabIndex        =   8
      Top             =   120
      Width           =   195
   End
   Begin VB.OptionButton rd_Preview 
      Caption         =   "Option1"
      Enabled         =   0   'False
      Height          =   195
      Left            =   2145
      TabIndex        =   6
      Top             =   120
      Width           =   255
   End
   Begin VB.PictureBox pic_pic 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      ClipControls    =   0   'False
      ForeColor       =   &H80000008&
      Height          =   5800
      Left            =   7200
      ScaleHeight     =   5775
      ScaleWidth      =   630
      TabIndex        =   0
      Top             =   0
      Width           =   665
      Begin VB.PictureBox pic_quit 
         Appearance      =   0  'Flat
         AutoRedraw      =   -1  'True
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   0  'None
         DragIcon        =   "MEDIA_DS.frx":0000
         DrawStyle       =   5  'Transparent
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   480
         Left            =   60
         ScaleHeight     =   480
         ScaleWidth      =   480
         TabIndex        =   3
         Top             =   2400
         Width           =   480
      End
      Begin VB.PictureBox pic_Save 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   0  'None
         DragIcon        =   "MEDIA_DS.frx":030A
         DrawStyle       =   5  'Transparent
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   480
         Left            =   60
         ScaleHeight     =   480
         ScaleWidth      =   480
         TabIndex        =   2
         Top             =   600
         Width           =   480
      End
      Begin VB.PictureBox pic_Print 
         Appearance      =   0  'Flat
         AutoRedraw      =   -1  'True
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   0  'None
         DrawStyle       =   5  'Transparent
         Enabled         =   0   'False
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   480
         Left            =   60
         ScaleHeight     =   480
         ScaleWidth      =   480
         TabIndex        =   1
         Top             =   60
         Visible         =   0   'False
         Width           =   480
      End
   End
   Begin VB.Label lbl_hires 
      Caption         =   "HiRes"
      Height          =   255
      Left            =   5820
      TabIndex        =   15
      Top             =   120
      Width           =   1290
   End
   Begin VB.Label lbl_Thumbnail 
      Caption         =   "Thumbnail"
      Height          =   255
      Left            =   840
      TabIndex        =   11
      Top             =   120
      Width           =   1290
   End
   Begin VB.Label lbl_Full 
      Caption         =   "lbl_Option2"
      Height          =   255
      Left            =   4110
      TabIndex        =   9
      Top             =   120
      Width           =   1290
   End
   Begin VB.Label lbl_Preview 
      Caption         =   "lbl_Option1"
      Height          =   255
      Left            =   2445
      TabIndex        =   7
      Top             =   120
      Width           =   1290
   End
   Begin VB.Label lbl_Hide 
      Caption         =   "lbl_Hide"
      Enabled         =   0   'False
      Height          =   132
      Left            =   60
      TabIndex        =   4
      Top             =   4200
      Visible         =   0   'False
      Width           =   432
   End
   Begin VB.Label lbl_Title 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "lbl_Title"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   600
      TabIndex        =   5
      Top             =   6120
      Width           =   6075
   End
End
Attribute VB_Name = "Media_dsp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim ms_Path As String
Dim ms_PreviewFile As String
Dim ms_FullFile As String
Dim ms_SourcePreviewFile As String
Dim ms_SourceFullFile As String
Dim ms_ParamReqCsts As String
Dim mi_NormalFormHeight As Integer
Dim mi_NormalFormWidth As Integer
Dim mi_NormalToolbarLeft As Integer
Dim mi_NormalTitleLeft As Integer
Dim mi_NormalTitleTop As Integer
Dim mi_NormalTitleWidth As Integer
Dim mi_NormalImagN1Width As Integer
Dim mi_NormalImagN1Height As Integer
Dim mi_NormalImagN1Top As Integer
Dim mi_NormalImagN1Left As Integer

'armsyscom
Private Const SEP = "ой"                  'standard armstrong separator
Private Const FForm = "Media_Dsp: "


Private ms_Server As String
'name of database to connect
Private ms_Db As String
'user name when opening connection to sql server
Private ms_User As String
'user passwrod
Private ms_Pwd As String
'application name displayed in connection row in sql server manager
Private ms_App As String

' Module caller
Public ms_Caller As String
Public ms_Title As String
Public mZipCode As Integer

Dim ms_MediaName As String
Dim ms_MediaToDisplay As String
Dim mExtension As String

'Blob info
Dim mBlob() As MediaBlob
Private Type MediaBlob
'    NewZip As Long
    OldZip As Long
    MD_Type As String
'    SrcSize As Long
'    CprSize As Long
'    CprName As String
'    MD_File As String
'    FileName As String
End Type

'Has a media already been displayed ?
Dim mb_ImageLoadOK As Boolean
Dim mb_RunFileOK As Boolean

Private Function DownloadBlob(aiZipcode As Integer) As Boolean
Dim lb_Blob As Boolean

On Error GoTo Err_DownloadBlob

DownloadBlob = False

    If Not UnzipBlob(aiZipcode) Then Exit Function

    DownloadBlob = True

    
Exit Function

Err_DownloadBlob:
    UploadSQLError aDb, adb_err, FForm & "/DownloadBlob"
End Function

Private Function GetBlob(aZip As Long) As Boolean
Dim lTry As Long

On Error GoTo Err_GetBlob

GetBlob = False

' download blob
For lTry = 1 To 3
    If Not aDb.BlobToFileSQL("exec Media_Zip_sel " & aZip, App.Path & REP_DOWNLOAD & aZip & "." & mExtension, True) Then
        Err.Raise C_ERRORRAISE + 236, aDb.LastErrorCode & " : " & aDb.LastErrorMessage & ", " & vbCrLf & "Cannot download file from server : Media_Dsp/DownBlob"
    Else
        Exit For
    End If
Next

ms_MediaToDisplay = aZip & "." & mExtension
GetBlob = True
    
Exit Function

Err_GetBlob:
    UploadSQLError aDb, adb_err, FForm & "/DownloadBlob"
End Function

Private Function UnzipBlob(aiZipcode As Integer) As Boolean
Dim ls_req As String
Dim ll_Cursor As Long
Dim ls_ext As String
Dim ll_SourceSize As Long
Dim ll_ZippedSize As Long

On Error GoTo Err_UnzipBlob

UnzipBlob = False

'ls_Req = "EXEC Media_BlobLink_sel '" & gs_MediaCode & "'"
ls_req = "SELECT Src_Size,Zip_Size,FE_desc from  Media_BlobLink MBL " _
    & "join    Media M on M.MD_code=MBL.MD_code  and MBL.language_code ='E' " _
    & "join    Media_File_Ext FE on FE.FE_code=M.FE_code and FE.language_code ='E' " _
    & "where   MBL.Zip_code = " & aiZipcode

ll_Cursor = aDb.OpenSQL(ls_req, -1, 0)

ll_SourceSize = aDb.GetFields(ll_Cursor, "Src_Size")
ll_ZippedSize = aDb.GetFields(ll_Cursor, "Zip_Size")
ls_ext = LCase(aDb.GetFields(ll_Cursor, "FE_desc"))
ms_MediaName = gs_MediaCode & "." & ls_ext

aDb.Close ll_Cursor
If ls_ext = "" Or ll_SourceSize = 0 Then
    Err.Raise C_ERRORRAISE + 161, aDb.LastErrorCode & " : " & aDb.LastErrorMessage & ", " & vbCrLf & "Failed to decompress blob : Media_Dsp/UnZipBlob #1"
End If

If Not aDb.BlobToFileSQL("select  ZipFile from Media_Zip where zip_code=" & aiZipcode, App.Path & REP_DOWNLOAD & aiZipcode & "." & ls_ext, True) Then
    Err.Raise C_ERRORRAISE + 161, aDb.LastErrorCode & " : " & aDb.LastErrorMessage & ", " & vbCrLf & "Failed to decompress blob : Media_Dsp/UnZipBlob #2"
End If

ms_MediaToDisplay = aiZipcode & "." & ls_ext
UnzipBlob = True

Exit Function

Err_UnzipBlob:
    UploadSQLError aDb, adb_err, FForm & "/UnzipBlob: " & ls_req
    Err.Raise C_ERRORRAISE + 161, aDb.LastErrorCode & " : " & aDb.LastErrorMessage & ", " & vbCrLf & "Failed to decompress blob : Media_Dsp/UnZipBlob #3"
    aDb.Close ll_Cursor
End Function

Private Sub InitAspect()
'------------------------------------------------------------------
' Name : ReadConstants()
'
' Purpose : Specify the default likeness of the window
'
'
' review : Dec/17/1999 by JJB
'------------------------------------------------------------------

    mi_NormalFormHeight = 6900 '5460
    mi_NormalFormWidth = 8000 '6705
    Media_dsp.Height = mi_NormalFormHeight
    Media_dsp.Width = mi_NormalFormWidth
    mi_NormalToolbarLeft = 7200 '5940
    pic_pic.Left = mi_NormalToolbarLeft
    mi_NormalTitleLeft = 600
    mi_NormalTitleTop = 4680
    mi_NormalTitleWidth = 4875
    lbl_Title.Left = mi_NormalTitleLeft
    lbl_Title.Top = mi_NormalTitleTop
    lbl_Title.Width = mi_NormalTitleWidth
    mi_NormalImagN1Width = 6100 '4875
    mi_NormalImagN1Height = 5200 '3555
    mi_NormalImagN1Top = 540
    mi_NormalImagN1Left = 600
    ImagN1.Width = mi_NormalImagN1Width
    ImagN1.Height = mi_NormalImagN1Height
    ImagN1.Top = 0
    ImagN1.Left = 0
End Sub

Private Sub ReadConstants()
'------------------------------------------------------------------
' Name : ReadConstants()
'
' Purpose : Read all label in a specific language
'
'
' review : Nov/23/1999 by JJB
' review : Jan/28/2000 by JJB We don't save anymore the constants in a file because now, we cache the stored procedure
'------------------------------------------------------------------

'initialize the different temporary files
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ls_Field, ls_Text As String

    If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ms_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 = ODBCData(ll_Statement, 2)
            Select Case ls_Field
                Case "rd_Option1": lbl_Preview.Caption = ls_Text
                Case "rd_Option2": lbl_Full.Caption = ls_Text
                Case "rd_Option3": lbl_Thumbnail.Caption = ls_Text
                Case "Title": Media_dsp.Caption = 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 Sub Form_Load()
Dim ll_Statement As Long, lIdx As Long
Dim ls_req As String
Dim li_Status As Integer
Dim liZipCode As Integer

On Error GoTo Err_Form_Load
    
    MouseOff
    
    If gl_CodePage <> 1252 And gl_CodePage <> 0 Then ChangeCharset Me

    ReDim mBlob(4)
    
    InitAspect
    
    rd_Thumbnail.Visible = False
    rd_Preview.Visible = False
    rd_Full.Visible = False
    rd_hires.Visible = False                ' JN task810
    lbl_Thumbnail.Visible = False
    lbl_Preview.Visible = False
    lbl_Full.Visible = False
    lbl_hires.Visible = False               ' JN task810
    
    pic_print.Picture = LoadResPicture(RES_PRINT, 1)
    pic_Save.Picture = LoadResPicture(RES_FLOPPY, 1)
    pic_quit.Picture = LoadResPicture(RES_QUIT, 1)
    
    ms_ParamReqCsts = "EXEC Screen_Csts 'Media_Dsp', '" & gut_LangLogin.Code & "'"
    ReadConstants
    ImagN1.Visible = OK

If LCase(ms_Caller) = "testdoc" Or LCase(ms_Caller) = "media" Then
    ClearDirectoryDownLoad
' using armsyscom and SQL Server blob
    'Init_Connection
    
    If Not GetBlobLink Then
        Err.Raise C_ERRORRAISE + 162, "Media_Dsp/GetBlobLink", "Impossible to get info about this media."
    End If
    
    lbl_Title = ms_Title

Else
' using ODBC and a media server
    Call MsgBox("This function is not accesible since v2.0.94")
    Exit Sub
' REMOVED 13.4.2005 Task remove FTP
'    ls_Req = "EXECUTE media_graph_dsp '" & gs_MediaCode & "', '" _
'            & gut_LangLogin.Code & "' "
'    If SQLSubmitServer(gl_Environment, gl_Database, ll_Statement, ls_Req) Then
'        li_Status = SQLFetch(ll_Statement)
'        If li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO Then
'            ms_Path = gs_MediaFTPRoot & "/" & ODBCData(ll_Statement, 1) & "/"
'            ms_PreviewFile = ODBCData(ll_Statement, 2)
'            ms_FullFile = ODBCData(ll_Statement, 3)
'            lbl_Title = ODBCData(ll_Statement, 4)
'            ms_SourcePreviewFile = ODBCData(ll_Statement, 5)
'            ms_SourceFullFile = ODBCData(ll_Statement, 6)
'        End If
'    Else
'        SendMessage 110, "Media location not available !", gut_LangLogin.Code
'    End If
'    SQLFreeStatement ll_Statement, SQL_DROP
End If
    
For lIdx = 1 To 4
    Select Case UCase(mBlob(lIdx).MD_Type)
    Case "V"
        rd_Thumbnail.Enabled = True
        rd_Thumbnail.Visible = True
        lbl_Thumbnail.Visible = True
    Case "P"
        rd_Preview.Visible = True
        rd_Preview.Enabled = True
        lbl_Preview.Visible = True
    Case "F"
    'Hide radio buttons for technical tests
        If LCase(ms_Caller) = "media" Then
            rd_Full.Visible = True
            rd_Full.Enabled = True
            lbl_Full.Visible = True
        End If
    Case "H"
        rd_hires.Visible = True
        rd_hires.Enabled = True
        lbl_hires.Visible = True
    End Select
Next

pic_print.Visible = True
pic_print.Enabled = True

' if impossible to draw anything for the first run ==> return to the caller
'  if Media is not an image ==> Do not display the form
mb_ImageLoadOK = False
mb_RunFileOK = False


' Display the biggest picture ~ semaphore
For lIdx = 4 To 1 Step -1
    Select Case UCase(mBlob(lIdx).MD_Type)
    Case "F"
        rd_Full.value = True
        Exit For
    Case "P"
        rd_Preview.value = True
        Exit For
    Case "V"
        rd_Thumbnail.value = True
        Exit For
    End Select
Next

If Not mb_ImageLoadOK Or mb_RunFileOK Then
    Unload Me
    Exit Sub
End If

MouseOn
Exit Sub
    
Err_Form_Load:
    ' we supose that the ocx wasn't installed on the PC,
    MouseOn
    Unload Me
End Sub

Private Function RunFile(ByVal ls_File As String, ls_FilePath As String, li_RunStyle As Integer) As Boolean
' SW_HIDE = 0
' SW_SHOWNORMAL = 1
' SW_NORMAL = 1
' SW_SHOWMINIMIZED = 2
' SW_SHOWMAXIMIZED = 3
' SW_MAXIMIZE = 3
' SW_SHOWNOACTIVATE = 4
' SW_SHOW = 5
' SW_MINIMIZE = 6
' SW_SHOWMINNOACTIVE = 7
' SW_SHOWNA = 8
' SW_RESTORE = 9
'Const MB_ICONSTOP = 16
Dim ls_ActiveWindow As String
Dim li_return As Integer
On Error GoTo Err_RunFile
    
RunFile = False
mb_RunFileOK = False
    
ls_ActiveWindow = GetActiveWindow()
li_return = ShellExecute(ls_ActiveWindow, "Open", ls_File, "", ls_FilePath, li_RunStyle)
If li_return >= 32 Then
    RunFile = True
    mb_RunFileOK = True
Else
    Select Case li_return
    Case 14
        Err.Raise C_ERRORRAISE + 176, FForm & "/RunFile", "Unknown program file type"
    Case 31
        Err.Raise C_ERRORRAISE + 176, FForm & "/RunFile", "No application found for this file"
'    Case 0
'    Msg = "The file could not be run due to insufficient system memory or a corrupt program file"
'    Case 2
'    Msg = "File Not Found"
'    Case 3
'    Msg = "Invalid Path"
'    Case 5
'    Msg = "Sharing or protection error"
'    Case 6
'    Msg = "Separate data segments are required for each task "
'    Case 8
'    Msg = "Insufficient memory to run the program"
'    Case 10
'    Msg = "Incorrect Windows version"
'    Case 11
'    Msg = "Invalid Program File"
'    Case 12
'    Msg = "Program file requires a different operating System "
'    Case 13
'    Msg = "Program requires MS-DOS 4.0"
'    Case 15
'    Msg = "Windows prgram does not support protected memory mode"
'    Case 16
'    Msg = "Invalid use of data segments when loading a second instance of a program"
'    Case 19
'    Msg = "Attempt to run a compressed program file"
'    Case 20
'    Msg = "Invalid dynamic link library"
'    Case 21
'    Msg = "Program requires Windows 32-bit extensions"
    End Select
End If

Exit Function

Err_RunFile:
    UploadSQLError aDb, adb_err, FForm & "/Runfile: "
    Select Case Err.Number - C_ERRORRAISE
    Case 14
        Err.Raise C_ERRORRAISE + 176, FForm & "/RunFile", "Unknown program file type"
    Case 31
        Err.Raise C_ERRORRAISE + 176, FForm & "/RunFile", "No application found for this file"
    Case Else
        Err.Raise C_ERRORRAISE + 167, FForm & "/RunFile", "Unsupported format of media."
    End Select
End Function

Private Sub ClearDirectoryDownLoad()
Dim ls_File As String
On Error GoTo Err_ClearDirectoryDownLoad
     ls_File = Dir(App.Path & REP_DOWNLOAD & "*.*")
     Do While ls_File <> ""
        If ls_File <> "." And ls_File <> ".." Then
            SetAttr App.Path & REP_DOWNLOAD & ls_File, vbNormal
            Kill App.Path & REP_DOWNLOAD & ls_File
        End If
        ls_File = Dir
     Loop
     Exit Sub
     
Err_ClearDirectoryDownLoad:
    Resume Next
End Sub

Private Function DrawMedia(ByVal ls_File As String) As Boolean
Dim ls_FullName As String

On Error GoTo Err_DrawMedia

DrawMedia = KO
'check for suported file
If (UCase(right(ls_File, 3)) = "JPG") Or (UCase(right(ls_File, 3)) = "GIF") Or (UCase(right(ls_File, 3)) = "BMP") Then
    'Get a temporary file on the local machine
    ls_FullName = App.Path & REP_DOWNLOAD & ls_File
    'Download the file
    ImagN1.Picture = LoadPicture(ls_FullName) 'lo_Picture
    
    'Scroll bar
    If ImagN1.Height - Frame1.Height < 32768 Then
    sbv_Frame.Max = ImagN1.Height - Frame1.Height
    Else
        sbv_Frame.Max = 32767
    End If
    
    If ImagN1.Width - Frame1.Width < 32768 Then
    sbh_Frame.Max = ImagN1.Width - Frame1.Width
    Else
        sbh_Frame.Max = 32767
    End If
    
    If ImagN1.Width <= mi_NormalImagN1Width Then
    'center picture size < frame
        sbh_Frame.Visible = False
        ImagN1.Left = (mi_NormalImagN1Width - ImagN1.Width) / 2
    Else
        sbh_Frame.Visible = True
    End If
    
    If ImagN1.Height <= mi_NormalImagN1Height Then
    'center picture size < frame
        sbv_Frame.Visible = False
        ImagN1.Top = (mi_NormalImagN1Height - ImagN1.Height) / 2
    Else
        sbv_Frame.Visible = True
    End If

    DoEvents
    DrawMedia = OK
Else
    'Download the file
    If Not (RunFile(ls_File, App.Path & REP_DOWNLOAD, 1)) Then
        Err.Raise C_ERRORRAISE + 167, "Media_Dsp/DrawMedia", "Unsupported format of media"
    Else
        DrawMedia = OK
    End If
End If

Exit Function

Err_DrawMedia:
    Err.Raise C_ERRORRAISE + 176, FForm & "/RunFile", "Unknown program file type"
End Function

' REMOVED 13.4.2005 Task remove FTP
'Private Function DrawPicture(ByVal ls_path As String, ByVal ls_File As String) As Boolean
'Dim ls_TempDir As String
'Dim ls_TempLocalFile  As String
'Dim ls_TempLocalPath  As String
'Dim ls_drive As String
'Dim ls_FullTempName As String

'    DrawPicture = KO
'    'check for suported file
'    If (UCase(right(ls_File, 3)) = "JPG") Or (UCase(right(ls_File, 3)) = "GIF") Or (UCase(right(ls_File, 3)) = "BMP") Then
'            'launch FTP activeX
'            Set mo_FTPComponent = New ftpmodule
'            'connect to media server
'            If mo_FTPComponent.ConnectionToFTPServer(1, gs_FTPMediaServerName, gs_FTPMediaServerIP, gs_FTPMediaServerLogin, gs_FTPMediaServerPassword) Then
'                'Get a temporary file on the local machine
'                ls_TempDir = GetTempDir()
'                GetTempName ls_TempDir, "tmp", ls_drive, ls_TempLocalPath, ls_TempLocalFile
'                ls_FullTempName = ls_drive & ":" & ls_TempLocalPath & ls_TempLocalFile
'                'Download the file
'                If mo_FTPComponent.GetFile(1, ls_path & ls_File, ls_FullTempName) Then
'                    ImagN1.Picture = LoadPicture(ls_FullTempName) 'lo_Picture
'
'                    'Scroll bar
'                    sbv_Frame.Max = ImagN1.Height - Frame1.Height
'                    sbh_Frame.Max = ImagN1.Width - Frame1.Width
'
'                    If ImagN1.Width <= mi_NormalImagN1Width Then
'                    'center picture size < frame
'                        sbh_Frame.Visible = False
'                        ImagN1.left = (mi_NormalImagN1Width - ImagN1.Width) / 2
'                    End If
'
'                    If ImagN1.Height <= mi_NormalImagN1Height Then
'                    'center picture size < frame
'                        sbv_Frame.Visible = False
'                        ImagN1.top = (mi_NormalImagN1Height - ImagN1.Height) / 2
'                    End If
'
'                    DoEvents
'                    DrawPicture = OK
'                End If
'                'Kill the temporary File
'                If ls_FullTempName <> "" Then
'                    If Dir(ls_FullTempName) <> "" Then
'                        SetAttr ls_FullTempName, vbNormal
'                        Kill ls_FullTempName
'                    End If
'                End If
'            End If
'            'Close FTP connection
'            Set mo_FTPComponent = Nothing
'    Else
'        'launch FTP activeX
'        Set mo_FTPComponent = New ftpmodule
'        'connect to media server
'        If mo_FTPComponent.ConnectionToFTPServer(1, gs_FTPMediaServerName, gs_FTPMediaServerIP, gs_FTPMediaServerLogin, gs_FTPMediaServerPassword) Then
'                'Download the file
'                If mo_FTPComponent.GetFile(1, ls_path & ls_File, App.Path & REP_DOWNLOAD & ls_File) Then
'                    If Not (RunFile(ls_File, App.Path & REP_DOWNLOAD, 1)) Then
'                        Err.Raise C_ERRORRAISE + 107, "Media_Dsp/DrawPicture #1", "Unsupported format of media"
'                    Else
'                        DrawPicture = OK
'                    End If
'                Else
'                    Err.Raise C_ERRORRAISE + 122, "Media_Dsp/DrawPicture #2", "Error during the process, Please contact your IT support."
'                End If
'        End If
'        Set mo_FTPComponent = Nothing
'    End If
'
'Exit Function

'Err_DrawPicture:
'    UploadSQLError ADB, ADB_Err, FForm & "/DrawPicture: "
'    Err.Raise C_ERRORRAISE + 107, "Media_Dsp/DrawPicture", "Impossible to draw the media"
'End Function

Private Sub Form_Unload(Cancel As Integer)

MouseOn
End Sub


Private Sub sbh_Frame_Change()
    ImagN1.Left = -sbh_Frame.value
End Sub

Private Sub pic_print_Click()
    
    If Printers.Count = 0 Then
        SendMessage 135, "No printer is installed on your computer. Please, contact your system administrator.", gut_LangLogin.Code
        Exit Sub
    End If
    
    If ImagN1.Picture = 0 Then
        SendMessage 666, "This image cannot be printed.", gut_LangLogin.Code
        Exit Sub
    End If
    
    MouseOff
    Printer.ScaleMode = 3
    SetBold 0
    SetFontSize 12
    Printer.Print ""
    If rd_Preview.value = OK Then
        Printer.Print gs_MediaCode; " - "; lbl_Title; " - "; ms_SourcePreviewFile
    Else
        Printer.Print gs_MediaCode; " - "; lbl_Title; " - "; ms_SourceFullFile
    End If
    Printer.Print ""
    Printer.PaintPicture ImagN1.Picture, 15, 200
    Printer.EndDoc
    MouseOn
End Sub

Private Sub pic_quit_Click()

MouseOff
Unload Me

End Sub

Private Sub pic_Save_Click()
Dim ls_FullTempName As String

If rd_hires.value Then
    ' we are in hires => must ask additional question
    If SendMessage(666, "Are you sure - This operation may take a long time", gut_LangLogin.Code, vbYesNo) = vbNo Then Exit Sub

    MouseOff
    ' download the image
    If Not GetBlob(mBlob(4).OldZip) Then
        MouseOn
        Err.Raise C_ERRORRAISE + 162, FForm & "RadioButton #4", "Impossible to get info about this media."
    End If
    MouseOn
End If

dlg_save.InitDir = "c:\"
dlg_save.DialogTitle = "Save " & Caption

If LCase(ms_Caller) <> "testdoc" And LCase(ms_Caller) <> "media" Then
    dlg_save.FileName = ms_SourceFullFile
Else
'    dlg_save.FileName = ms_MediaName
    dlg_save.FileName = ms_MediaToDisplay
End If

dlg_save.flags = cdlOFNHideReadOnly Or cdlOFNOverwritePrompt Or cdlOFNPathMustExist
dlg_save.ShowSave

If dlg_save.FileName <> ms_SourceFullFile Then
    On Error Resume Next
    Kill dlg_save.FileName
    
    On Error GoTo 0
    
    If LCase(ms_Caller) <> "testdoc" And LCase(ms_Caller) <> "media" Then
    
' REMOVED 13.4.2005 Task remove FTP
        Call MsgBox("This function is not accesible since v2.0.94")
'        'launch FTP activeX
'        Set mo_FTPComponent = New ftpmodule
'        'connect to media server
'        If mo_FTPComponent.ConnectionToFTPServer(1, gs_FTPMediaServerName, gs_FTPMediaServerIP, gs_FTPMediaServerLogin, gs_FTPMediaServerPassword) Then
'            'Get a temporary file on the local machine
'            ls_FullTempName = dlg_save.FileName
'            'Download the file
'            mo_FTPComponent.GetFile 1, ms_Path & ms_FullFile, ls_FullTempName
'        End If
'        'Close FTP connection
'        Set mo_FTPComponent = Nothing
    Else
'        FileCopy App.Path & REP_DOWNLOAD & ms_MediaName, dlg_save.FileName
        FileCopy App.Path & REP_DOWNLOAD & ms_MediaToDisplay, dlg_save.FileName
    End If
End If
End Sub

Private Sub rd_Preview_Click()
Dim lZip As Long

On Error GoTo Err_rd1

MouseOff

lZip = mBlob(2).OldZip
If lZip <> 0 Then
    If RadioButton(lZip) Then mb_ImageLoadOK = True
Else
    Err.Raise C_ERRORRAISE + 280, FForm & "rd_Preview_Click", "No media to display"
End If

MouseOn
Exit Sub

Err_rd1:
    MouseOn
    
    Select Case Err.Number - C_ERRORRAISE
    Case 280
        SendMessage 280, "Nothing to display for this type of view.", gut_LangLogin.Code
    Case Else
        SendMessage 167, "Unsupported format of media.", gut_LangLogin.Code
    End Select
End Sub

Private Sub rd_Full_Click()
Dim lZip As Long

On Error GoTo Err_rdfull

MouseOff

lZip = mBlob(3).OldZip
If lZip <> 0 Then
    If RadioButton(lZip) Then mb_ImageLoadOK = True
Else
    Err.Raise C_ERRORRAISE + 280, FForm & "rd_Preview_Click", "No media to display"
End If

MouseOn
Exit Sub

Err_rdfull:
    MouseOn
    
    Select Case Err.Number - C_ERRORRAISE
    Case 280
        SendMessage 280, "Nothing to display for this type of view.", gut_LangLogin.Code
    Case Else
        SendMessage 167, "Unsupported format of media.", gut_LangLogin.Code
    End Select
End Sub
Private Sub rd_hires_Click()
On Error GoTo ErrHandler
    ms_MediaName = ""
    ms_MediaToDisplay = ""
    
    ImagN1.Picture = Nothing
    sbv_Frame.Visible = False
    sbh_Frame.Visible = False
    
    Call SendMessage(666, "High resolution images cannot be previewed - Save to disk only allowed", gut_LangLogin.Code)
Exit Sub
ErrHandler:
End Sub

Private Function GetBlobLink() As Boolean
Dim ls_req As String
Dim ll_Cursor As Long
Dim lMediaType As String, lExtension As String
Dim lOldZip As Long

On Error GoTo Err_GetBlobLink
  
GetBlobLink = False
  
ls_req = "SELECT Zip_code,MediaType,FE_Desc FROM Media_BlobLink MBL" _
    & " join Media M on M.MD_code=MBL.MD_code and M.language_code ='E'" _
    & " join Media_File_Ext FE on FE.FE_code=M.FE_code and FE.language_code ='E'" _
    & " WHERE MBL.MD_code ='" & gs_MediaCode & "' and M.language_code ='E'"

ll_Cursor = aDb.OpenSQL(ls_req)
If ll_Cursor <= 0 Then
    Err.Raise C_ERRORRAISE + 162, "Media/GetBlobLink 1", "Impossible to get media links"
End If

If aDb.RowCount(ll_Cursor) <= 0 Then
aDb.Close (ll_Cursor)
    Err.Raise C_ERRORRAISE + 162, "Media/GetBlobLink 2", "Impossible to get media links"
End If

Call aDb.First(ll_Cursor)
While Not aDb.EOF(ll_Cursor)
    lOldZip = aDb.GetFields(ll_Cursor, 0)
    lMediaType = aDb.GetFields(ll_Cursor, 1)
    mExtension = aDb.GetFields(ll_Cursor, 2)
    
    Select Case UCase(lMediaType)
    Case "T": mBlob(1).OldZip = lOldZip
        mBlob(1).MD_Type = lMediaType
    Case "V": mBlob(1).OldZip = lOldZip
         mBlob(1).MD_Type = lMediaType
    Case "P": mBlob(2).OldZip = lOldZip
         mBlob(2).MD_Type = lMediaType
    Case "F": mBlob(3).OldZip = lOldZip
         mBlob(3).MD_Type = lMediaType
    Case "H": mBlob(4).OldZip = lOldZip
         mBlob(4).MD_Type = lMediaType
    End Select
    
    Call aDb.Next(ll_Cursor)
Wend

GetBlobLink = True
aDb.Close ll_Cursor
Exit Function

Err_GetBlobLink:
    UploadSQLError aDb, adb_err, FForm & "/GetBlobLink: " & ls_req
    aDb.Close ll_Cursor
End Function

Private Sub rd_Thumbnail_Click()
Dim lZip As Long

On Error GoTo Err_rd1

MouseOff

lZip = mBlob(1).OldZip
If lZip <> 0 Then
    If RadioButton(lZip) Then mb_ImageLoadOK = True
Else
    Err.Raise C_ERRORRAISE + 280, FForm & "rd_Thumbnail_Click", "No media to display"
End If

MouseOn
Exit Sub

Err_rd1:
    MouseOn
    
    Select Case Err.Number - C_ERRORRAISE
    Case 280
        SendMessage 280, "Nothing to display for this type of view.", gut_LangLogin.Code
    Case Else
        SendMessage 167, "Unsupported format of media.", gut_LangLogin.Code
    End Select
End Sub

Private Sub sbh_Frame_Scroll()
    ImagN1.Left = -sbh_Frame.value
End Sub

Private Sub sbv_Frame_Change()
    ImagN1.Top = -sbv_Frame.value
End Sub

Private Sub sbv_Frame_Scroll()
    ImagN1.Top = -sbv_Frame.value
End Sub

Private Function RadioButton(ByVal aZip As Long) As Boolean

Dim liZipCode As Integer

On Error GoTo Err_Rdbt

ImagN1.Picture = Nothing
RadioButton = False

Select Case LCase(ms_Caller)
Case "testdoc"
    liZipCode = mBlob(3).OldZip
    If Not DownloadBlob(liZipCode) Then
        Err.Raise C_ERRORRAISE + 162, FForm & "RadioButton #1", "Impossible to get info about this media."
    End If
    
    If Not DrawMedia(ms_MediaToDisplay) Then
        Err.Raise C_ERRORRAISE + 167, FForm & "RadioButton #D", "Impossible to draw this media"
    End If
Case "media"
    If Not GetBlob(aZip) Then
        Err.Raise C_ERRORRAISE + 162, FForm & "RadioButton #2", "Impossible to get info about this media."
    End If
    
    If Not DrawMedia(aZip & "." & mExtension) Then
        Err.Raise C_ERRORRAISE + 167, FForm & "RadioButton #D", "Impossible to draw this media"
    End If
' REMOVED 13.4.2005 Task remove FTP
'Case Else
'    DrawPicture ms_Path, ms_FullFile
End Select

RadioButton = True
Exit Function

Err_Rdbt:
End Function


