vbAccelerator - Contents of code file: frmjpg.frm

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmjpg 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "DIWriteJpg test program"
   ClientHeight    =   10350
   ClientLeft      =   1905
   ClientTop       =   1440
   ClientWidth     =   7785
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   690
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   519
   Begin ComctlLib.ProgressBar pSingle 
      Height          =   255
      Left            =   3600
      TabIndex        =   10
      Top             =   9960
      Width           =   3975
      _ExtentX        =   7011
      _ExtentY        =   450
      _Version        =   327682
      Appearance      =   0
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "Exit"
      Height          =   375
      Left            =   2040
      TabIndex        =   9
      Top             =   9840
      Width           =   1335
   End
   Begin VB.CommandButton cmdSave 
      Caption         =   "Save and Load"
      Height          =   375
      Left            =   360
      TabIndex        =   8
      Top             =   9840
      Width           =   1335
   End
   Begin VB.CheckBox chkProg 
      Caption         =   "Progressive"
      Height          =   255
      Left            =   6240
      TabIndex        =   7
      Top             =   9480
      Value           =   1  'Checked
      Width           =   1215
   End
   Begin VB.TextBox txtQual 
      Height          =   285
      Left            =   5280
      Locked          =   -1  'True
      TabIndex        =   6
      Text            =   "100"
      Top             =   9480
      Width           =   615
   End
   Begin VB.HScrollBar hshQual 
      Height          =   255
      LargeChange     =   5
      Left            =   1320
      Max             =   100
      Min             =   1
      TabIndex        =   5
      TabStop         =   0   'False
      Top             =   9480
      Value           =   100
      Width           =   3855
   End
   Begin VB.PictureBox picJpg 
      AutoSize        =   -1  'True
      DrawMode        =   6  'Mask Pen Not
      Height          =   4380
      Left            =   120
      ScaleHeight     =   288
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   496
      TabIndex        =   2
      Top             =   5040
      Width           =   7500
   End
   Begin VB.PictureBox picSrc 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   4320
      Left            =   120
      ScaleHeight     =   284
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   494
      TabIndex        =   0
      Top             =   360
      Width           =   7470
   End
   Begin VB.Label lblQ 
      BackStyle       =   0  'Transparent
      Caption         =   "Quality :"
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   9480
      Width           =   1095
   End
   Begin VB.Label lblJpg 
      BackStyle       =   0  'Transparent
      Caption         =   "Image loaded from JPEG"
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   4800
      Width           =   1815
   End
   Begin VB.Label lblSrc 
      BackStyle       =   0  'Transparent
      Caption         =   "Original Image :"
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   1095
   End
End
Attribute VB_Name = "frmjpg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function DIWriteJpg Lib "DILib.dll" Alias "#1" (DestPath As
 String, SrcPath As String, ByVal quality As Long, ByVal progressive As Long)
 As Long

Private Const DI_SUCCESS = 0
Private Const DI_ERR_CALL = 1
Private Const DI_ERR_INFILE = 2
Private Const DI_ERR_OUTFILE = 3

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdSave_Click()
    Dim retval As Long
    Dim loadStr As String
    Dim sFIleBmp As String
    Dim sMsg As String
    
    'Initialize input path
    loadStr = AddSep(App.Path) & "/home/Resources/Babbage/JPG_DLL_for_VB/test.jpg"
    sFIleBmp = AddSep(App.Path) & "Test.bmp"
    
    'Enbale the Timer
    CreateTimer 100
    
    'Required by DIjpg.dll
    iPercent = 5
    DoEvents
    SavePicture picSrc.Image, sFIleBmp
    iPercent = 20
    DoEvents
    
    'Save to JPEG
    retval = DIWriteJpg(ByVal loadStr, ByVal sFIleBmp, hshQual.Value,
     Abs(chkProg.Value))
    iPercent = 100
    Progress
    DoEvents
    
    sMsg = "DIWriteJpg did not succeed" & vbCrLf
    Select Case retval
    Case DI_SUCCESS 'Success
        picJpg.Picture = LoadPicture(loadStr)
    Case DI_ERR_CALL 'An error occured
        sMsg = sMsg & "Error Call (0x00000001)"
    Case DI_ERR_INFILE
        sMsg = sMsg & "Error InFile (0x00000002): " & sFIleBmp
    Case DI_ERR_OUTFILE
        sMsg = sMsg & "Error OutFile (0x00000003): " & loadStr
    End Select
    If retval <> DI_SUCCESS Then MsgBox sMsg
    
    'Remove temporary file
    Kill sFIleBmp
    pSingle.Value = 0
End Sub

Private Sub Form_Load()
    Set picSrc.Picture = LoadPicture(App.Path & "/home/Resources/Babbage/JPG_DLL_for_VB/src.jpg")
    iPercent = 0
End Sub

Private Sub hshQual_Change()
    txtQual.Text = Str(hshQual.Value)
End Sub

Private Function AddSep(ByVal p$)
    If Right(p, 1) = "\" Then
        AddSep = p
    Else
        AddSep = p & "\"
    End If
End Function