form5.frm

Control ocx de una cam de la leche pedrin

VERSION 5.00
Begin VB.Form Form5 
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "Conversor"
   ClientHeight    =   4125
   ClientLeft      =   45
   ClientTop       =   315
   ClientWidth     =   8535
   LinkTopic       =   "Form5"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4125
   ScaleWidth      =   8535
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.PictureBox pr 
      AutoSize        =   -1  'True
      Height          =   1815
      Left            =   0
      ScaleHeight     =   1755
      ScaleWidth      =   2475
      TabIndex        =   13
      Top             =   0
      Width           =   2535
   End
   Begin VB.DriveListBox Drive1 
      Height          =   315
      Left            =   4680
      TabIndex        =   12
      Top             =   2160
      Width           =   2895
   End
   Begin VB.DirListBox Dir1 
      Height          =   1440
      Left            =   4680
      TabIndex        =   11
      Top             =   2520
      Width           =   2895
   End
   Begin VB.CheckBox chkProg 
      Caption         =   "Progressive"
      Height          =   195
      Left            =   2640
      TabIndex        =   5
      Top             =   3480
      Value           =   1  'Checked
      Width           =   1815
   End
   Begin VB.TextBox Text2 
      Height          =   285
      Left            =   1320
      TabIndex        =   3
      Text            =   "0"
      Top             =   3120
      Width           =   1095
   End
   Begin VB.TextBox Text1 
      Height          =   285
      Left            =   1320
      TabIndex        =   1
      Text            =   "0"
      Top             =   3480
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Empezar!"
      Height          =   375
      Left            =   0
      TabIndex        =   0
      Top             =   2640
      Width           =   2415
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   0
      Top             =   0
   End
   Begin VB.Frame Frame2 
      Caption         =   "Grabar en:"
      Height          =   1575
      Left            =   2520
      TabIndex        =   6
      Top             =   2160
      Width           =   2055
      Begin VB.OptionButton Option4 
         Caption         =   "BMP"
         Height          =   255
         Left            =   120
         TabIndex        =   9
         Top             =   240
         Width           =   1815
      End
      Begin VB.OptionButton Option5 
         Caption         =   "JPG"
         Height          =   255
         Left            =   120
         TabIndex        =   8
         Top             =   480
         Value           =   -1  'True
         Width           =   1815
      End
      Begin VB.HScrollBar hshQual 
         Height          =   255
         Left            =   120
         Max             =   100
         TabIndex        =   7
         Top             =   960
         Value           =   100
         Width           =   1815
      End
      Begin VB.Label Label6 
         Caption         =   "Calidad de jpg:"
         Height          =   255
         Left            =   120
         TabIndex        =   10
         Top             =   720
         Width           =   1815
      End
   End
   Begin VB.Label Label2 
      Caption         =   "Imagen Actual:"
      Height          =   255
      Left            =   0
      TabIndex        =   4
      Top             =   3480
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "Empezar desde:"
      Height          =   255
      Left            =   0
      TabIndex        =   2
      Top             =   3120
      Width           =   1335
   End
End
Attribute VB_Name = "Form5"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public var, i, filepath, filevar
Private Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hDC As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "GDI32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "GDI32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "GDI32" (ByVal hDC As Long) As Long
Private Declare Function BitBlt Lib "GDI32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long
Private Declare Function SetPixel Lib "GDI32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function GetAsyncKeyState Lib "USER32" (ByVal vKey As Long) As Integer
Private Declare Function ShowCursor Lib "USER32" (ByVal bShow As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetPixel Lib "GDI32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
' Functions and constants used to play sounds.
Private Declare Function GetCapture Lib "USER32" () As Long
Private Declare Function StretchBlt Lib "GDI32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
 Private Declare Function ChangeDisplaySettings Lib "USER32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long
Private Declare Function EnumDisplaySettings Lib "USER32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Private Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function DIWriteJpg Lib "DIjpg.dll" (ByVal DestPath As String, ByVal quality As Long, ByVal progressive As Long) As Long
Private Const SW_SHOW = 5
Dim Sortir As Integer
  Const CCDEVICENAME = 32
  Const CCFORMNAME = 32
  Const DM_BITSPERPEL = &H40000
 Const DM_PELSWIDTH = &H80000
  Const DM_PELSHEIGHT = &H100000
 Const CDS_UPDATEREGISTRY = &H1
  Const CDS_TEST = &H4
  Const DISP_CHANGE_SUCCESSFUL = 0
  Const DISP_CHANGE_RESTART = 1
Private Type DEVMODE
     dmDeviceName As String * CCDEVICENAME
     dmSpecVersion As Integer
     dmDriverVersion As Integer
     dmSize As Integer
     dmDriverExtra As Integer
     dmFields As Long
     dmOrientation As Integer
     dmPaperSize As Integer
     dmPaperLength As Integer
     dmPaperWidth As Integer
     dmScale As Integer
     dmCopies As Integer
     dmDefaultSource As Integer
     dmPrintQuality As Integer
     dmColor As Integer
     dmDuplex As Integer
     dmYResolution As Integer
     dmTTOption As Integer
     dmCollate As Integer
     dmFormName As String * CCFORMNAME
     dmUnusedPadding As Integer
     dmBitsPerPel As Integer
     dmPelsWidth As Long
     dmPelsHeight As Long
     dmDisplayFlags As Long
     dmDisplayFrequency As Long
 End Type
Private Type ScoreReg
   Nom As String * 25
   Points As Integer
End Type
Dim Score(10) As ScoreReg
Private Type BallReg
    MoveSW As Integer
    Speed As Single
    X As Single
    Y As Single
    CordX As Single
    CordY As Single
    CordXAnt As Single
    CordYAnt As Single
    MaxSpeed As Integer
End Type
Private Type fichreg
   Activate As Integer
   Speed As Single
   X As Single
   Y As Single
   CordX As Single
   CordY As Single
   XAnt As Single
   Yant As Single
End Type
Dim Fich(10) As fichreg
Private Type CueReg
   Speed As Single
   X As Single
   Y As Single
   XAnt As Single
   Yant As Single
   CordX As Single
   CordY As Single
   Color As Single
End Type
Dim Cue(60) As CueReg
Dim Ball As BallReg
 Const SRCAND = &H8800C6
 Const SRCCOPY = &HCC0020
 Const SRCERASE = &H440328
 Const SRCINVERT = &H660046
 Const SRCPAINT = &HEE0086
Private Type BarReg
 Cords As Integer
 Vel As Single
 CordAnt As Integer
 LongFin As Single
 LongAct As Single
End Type
Dim Bar As BarReg
Private Type POINTAPI
        X As Long
        Y As Long
End Type
Private Type RegExplosion
    PosX As Single
    PosY As Single
    PosYAnt As Single
    PosXAnt As Single
    VelX As Single
    VelY As Single
    
    DireccioX As Single
    Color As Single
    ColorAnt As Long
End Type
Private Type RegScreen
     NumPantalla As Integer
     NumFichas As Integer
     lives As Integer
     
End Type
Dim Screen2 As RegScreen
Dim explosio(300, 21) As RegExplosion
Dim Conta As Integer
Dim PosCurs As POINTAPI
Dim FirstSrcDC As Long
Dim TableDC As Long
Dim BarraDC As Long
Dim pantalla(28) As String
Dim Tpan(14, 28) As Integer
Dim Estat(15) As Integer
Dim SoundIntro As String
Dim SoundEX2 As String
Dim SoundEX As String
Dim SoundBar As String
Dim SoundLOST As String
Dim SoundFich As String
Private Type RegMarcador
   NumActual As Integer
   NumFinal As Integer
   pos(10) As Single
End Type

  Dim Mrc As RegMarcador
   
  Dim VelMovNum As Single
Private Sub Command1_Click()
filepath = Dir1.Path
var = Text2.Text
filevar = Text2.Text
Timer1.Enabled = True
End Sub

Private Sub Drive1_Change()
On Error Resume Next
Dir1.Path = Drive1.Drive

End Sub

Private Sub Form_Click()
Form4.Show
End Sub

Private Sub Form_Load()
res = MsgBox("縇as im醙enes son JPG?", vbYesNo, "Revisi髇")
If res = vbYes Then
i = "1"
End If

End Sub

Private Sub Form_Unload(Cancel As Integer)
i = ""
End Sub

Private Sub pr_Click()
Form4.Show
End Sub

Private Sub Timer1_Timer()
On Error GoTo er
var = (var) + 1
filevar = (filevar) + 1
Text1 = (var)
If i = "1" Then
pr.Picture = LoadPicture(Form1.filepath & "\" & var & ".jpg")
Else
pr.Picture = LoadPicture(Form1.filepath & "\" & var & ".bmp")
End If

If Option5.Value = True Then

SavePicture pr.Image, "C:\tmp.bmp"
loadStr = (filepath) & "\" & filevar & ".jpg"

'Required by DIjpg.dll

retval = DIWriteJpg(loadStr, hshQual.Value, chkProg.Value)

Kill "C:\tmp.bmp"
Else
SavePicture pr.Image, (filepath) & "\" & filevar & ".bmp"
End If
Exit Sub
er:
res = MsgBox("Se ha terminado la conversi髇")
Unload Me
If res = vbYes Then
var = 0
ElseIf res = vbNo Then
Unload Me
ElseIf res = vbCancel Then
var = (var) + 1
filevar = (filevar) + 1
End If



End Sub