' RQ_DvixPlayer_V1_0.bas for RapidQ
' Coded by Gérald VERDIER - BinoclaR (°-°) software
' February 2005
' email : gerald.verdier@club-internet.fr
' PURPOSE : Dvix player with options
'
$include "rapidq.inc"
Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (lpszLongPath As String, lpszShortPath As long, lBuffer As Long) As Long  
Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (lpstrComd As String, lpstrRStr As Long, uRLength As Long, hwndCallb As Long) As Long
Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (dwError As Long, lpstrBuffer As long, uLength As Long) As Long
Declare Function GetKeyState Lib "user32"  alias "GetKeyState" (nVirtKey As Long) As Integer
Declare Function GetAsyncKeyState Lib "user32" Alias "GetAsyncKeyState" (vKey As Long) As Integer
Declare Function SetActiveWindow LIB "USER32" ALIAS "SetActiveWindow" (hWnd AS INTEGER) AS INTEGER
Declare Sub SetWindowPos Lib "user32" alias "SetWindowPos" ( hwnd As Long, hWndInsertAfter As Long,  X As Long,  Y As Long,  cx As Long, cy As Long,  wFlags As Long)
Declare Function SetFocus Lib "user32" Alias "SetFocus" (hwnd As Long) As Long
Declare Function SetForegroundWindow Lib "user32" Alias "SetForegroundWindow" (ByVal hwnd As Long) As Long
Declare Function DeleteDC Lib "gdi32" Alias "DeleteDC" (ByVal hdc As Long) As Long
Declare Function GetWindowDC LIB "USER32" ALIAS "GetDC" (hWnd AS INTEGER) AS INTEGER
Declare Function ReleaseDC LIB "USER32" ALIAS "ReleaseDC" (hWnd AS INTEGER, hDC AS INTEGER) AS INTEGER
Declare Function BitBlt Lib "gdi32" Alias "BitBlt" ( hDestDC As Long,  x As Long,   y As Long,  nWidth As Long,  nHeight As Long,  hSrcDC As Long,  xSrc As Long,  ySrc As Long, dwRop As Long) As Long
Declare Function StretchBlt Lib "gdi32.dll" Alias "StretchBlt" ( hDestDC As Long,  X As Long,  Y As Long, nWidth As Long,  nHeight As Long, hSrcDC As Long,  XSrc As Long, YSrc As Long,  nSrcWidth As Long, nSrcHeight As Long,  dwRop As Long) As Long
Declare Function GetShortPath(strFileName As String) As String
Declare Function FormatTime(lTime As Long) As String
Declare Sub OpenAVI
Declare Sub Quit
Declare Sub ShortPath
Declare Sub play
Declare Sub stop
Declare Sub pause
Declare Sub close
Declare Sub timerDV
Declare sub totalframes
Declare Sub TotalTime
Declare Sub posBarChg
Declare Sub Mute
Declare Sub volume
Declare Sub init
Declare sub Fullscreen
Declare Sub Nscreen
Declare sub BoxChecked
Declare sub seconds5(sender as QButton)
Declare sub capture
Declare sub findcodec
Declare sub fourcc
Declare sub openIE
Declare sub Speed(sender as QButton)
Declare sub About
declare sub Devcapab
declare sub showControls

CONST clMarine = &H5F1315
CONST clGreyBlue = &H9C7C7B

DIM Tile AS QBitmap
DIM Bitmap AS QBITMAP
Bitmap.PixelFormat = pf24bit
DIM captRect as QRect

DIM MemF as QMemoryStream
DIM Nfile as QFileStream

Dim cdg as QOpendialog
Dim LogoFont as QFont
LogoFont.name = "Webdings"
LogoFont.size = 18
Dim Logo2Font as QFont
Logo2Font.name = "Webdings"
Logo2Font.size = 16
Logo2Font.color = clGreyBlue
Dim Bfont as QFont
Bfont.name = "Arial"
Bfont.AddStyles(fsBold)
Bfont.size = 14
BFont.Color = clMarine
Dim Sfont as QFont
Sfont.AddStyles(fsBold)
Sfont.size = 11
Dim dvTimer as QTimer
dvTimer.onTimer = TimerDV
dvTimer.interval = 1000
dvTimer.enabled = false

Dim cTimer as QTimer
cTimer.onTimer = showControls
cTimer.interval = 1
cTimer.enabled = false

Dim ff$
Dim f$
Dim file$
Dim mvalue as string * 256
Dim sTime$
Dim sPos$
Dim top$
Dim w$
Dim h$
Dim fourcc$
Dim codec$
Dim fscreen as Byte
Dim playing as Byte
Dim open as Byte

Application.ShowHint = 1

CREATE FormC AS QFORM
    Caption = "Trouver le codec du fichier AVI et ouvrir un site internet concerné"
    Width = 400
    Height = 100
    BorderStyle = 4
    Center    
    Borderstyle = 4
    CREATE PanelC AS QPANEL
        Caption = "Vérifier à  : www.fourcc.org  pour informations sur codec"
        Left = 5
        Top = 4
        Caption = ""
        Width = 386
        Height = 70     
        CREATE LabelC AS QLABEL
            Caption = "FourCC - Codec = "
            Left = 8
            Top = 8
            Width = 100
            Height = 21
            Transparent = 1
        END CREATE 
        CREATE infoCodecLbl AS QLABEL
            Caption = ""
            font = sfont
            Left = 142
            Top = 8
            Width = 256
            Height = 21
            Transparent = 1
        END CREATE
        CREATE ieBt as QCoolBtn 
            left = 280
            height = 20
            top = 8
            Width = 100
            Caption = "Internet !"
            ShowHint = 1
            hint = "Cliquer pour ouvrir www.fourcc.org"            
            onClick = openIE
        END CREATE 
    END CREATE
END CREATE    

CREATE DVForm AS QFORM
    color = 0
    Borderstyle = 0  
END CREATE         

CREATE captForm AS QFORM
    color = 0
    Borderstyle = 0 
    top = 2000
    left = 3000 
    width = 124
    height = 124
    visible = false       
END CREATE

CREATE Form AS QFORM
    color = clGreyBlue
    Caption = "RQ Lecteur de Divx v1.0"
    Width = 605
    Height = 124
    top = screen.height - 170
    left = (screen.width/2) - (form.width/2)
    Borderstyle = 4  
    onShow = init
    onClose = Quit
    'onClick = record
    CREATE Panel1 AS QPANEL
        Left = 2
        Top = 1
        Width = 595
        Height = 48
        CREATE lblSpide AS QCoolBTN
            Caption = chr$(184) '"!"
            font = Logofont
            Left = 1
            Top = 2
            Width = 20
            height = 20
            ShowHint = 1
            hint = "Visualisations de possibilités du périphérique"
            onClick = Devcapab
        END CREATE        
        CREATE lblTime AS QLABEL
            Caption = "-"
            font = Bfont
            Left = 30
            Top = 2
            Width = 100
            LabelStyle = 2
        END CREATE
        CREATE lblTotalT AS QLABEL
            Caption = "-"
            font = Bfont
            Left = 120
            Top = 2
            Width = 100
            LabelStyle = 2
        END CREATE
        CREATE lblFrmTotal AS QLABEL
            Caption = "-"
            font = Sfont
            Left = 240
            Top = 5
            Width = 200
            Transparent = 1
            LabelStyle = 2
        END CREATE
        CREATE lblWatch AS QLABEL
            Caption = chr$(161)
            font = Logo2Font
            Left = 210
            Top = 1
            Width = 25
        END CREATE
        CREATE PositionGauge AS QGauge
            Left = 24
            Top = 25
            Width = 548
            Height = 9
        kind = gkHorizontalBar
        ShowText = false
        BackColor = clGreyBlue
        ForeColor = clYellow
        END CREATE
        CREATE DVslide AS QSCROLLBAR
            Left = 7
            Top = 35
            Width = 582
            Height = 9
            onChange = posBarChg
            SmallChange = 10
            LargeChange = 100
        END CREATE
        CREATE volumeSlide AS QSCROLLBAR
            Left = 450
            Top = 8
            Width = 140
            Height = 9
            Max = 100
            onChange = volume
        END CREATE
        CREATE lblvolume AS QLABEL
            Left = 378
            Top = 6
            Width = 50
            Height = 29
        END CREATE
        CREATE lblEar AS QLABEL
            Caption = "X"
            font = Logo2Font
            Left = 350
            Top = 1
            Width = 25
        END CREATE
    END CREATE
    CREATE Panel2 AS QPANEL
        Left = 2
        Top = 50
        Width = 595
        Height = 40
        CREATE lblcodec as QLabel
            caption = "Codec"
            Left = 505
            Top = 3
            Width = 50
            ShowHint = 1
            hint = "Codec utilisé"            
        END CREATE        
        CREATE codecB AS QButton
            caption = "?"
            font = sFont
            Left = 540
            Top = 2
            Width = 50
            Height = 18
            ShowHint = 1
            hint = "Cliquez pour des informations sur le Codec"            
            onClick = fourcc
        END CREATE
        CREATE lblspeed as QLabel
            caption = "Vitesse"
            Left = 505
            Top = 23
            Width = 50
            ShowHint = 1
            hint = "Ralentir/accélérer"            
        END CREATE        
        CREATE Speed1B AS QButton
            caption = "-"
            font = sFont
            Left = 540
            Top = 22
            Width = 16
            Height = 15
            ShowHint = 1
            hint = "Vitesse -"            
            onClick = Speed
            Tag = 101
        END CREATE   
        CREATE Speed2B AS QButton
            caption = "+"
            font = sFont
            Left = 574
            Top = 22
            Width = 16
            Height = 15
            ShowHint = 1
            hint = "Vitesse +"            
            onClick = Speed
            Tag = 102
        END CREATE   
        CREATE SpeedNB AS QButton
            caption = "I"
            font = sFont
            Left = 557
            Top = 22
            Width = 16
            Height = 15
            ShowHint = 1
            hint = "Vitesse normale"            
            onClick = Speed
            Tag = 100
        END CREATE                   
    END CREATE

    CREATE RewB AS QBUTTON
        Caption = "7"
        font = LogoFont 'Bfont
        Left = 43
        Top = 52
        Width = 35
        Height = 33
        Tag = 2
        ShowHint = 1
        hint = "-5 seconds"
        onClick = seconds5
    END CREATE
    CREATE PauseB AS QBUTTON
        Caption = ";"
        font = LogoFont
        Left = 78
        Top = 52
        Width = 35
        Height = 33
        Tag = 0
        ShowHint = 1
        hint = "Pause/Lecture"
        onClick = pause
    END CREATE
    CREATE captureB AS QBUTTON
        Caption = chr$(181)
        font = LogoFont
        Left = 8
        Top = 52
        Width = 35
        Height = 33
        ShowHint = 1
        hint = "Capture"       
        onClick = capture
        Tag = 1
    END CREATE    
    CREATE StopB AS QBUTTON
        Caption = "<"
        font = LogoFont
        Left = 113
        Top = 52
        Width = 35
        Height = 33
        ShowHint = 1
        hint = "Stop"        
        onClick = stop
        Tag = 3
    END CREATE
    CREATE FFB AS QBUTTON
        Caption = "8"
        font = LogoFont
        Left = 148
        Top = 52
        Width = 35
        Height = 33
        ShowHint = 1
        hint = "+5 secondes"        
        Tag = 4
        onClick = seconds5
    END CREATE
    CREATE CloseB AS QBUTTON
        Caption = "r"
        font = LogoFont
        Left = 183
        Top = 52
        Width = 35
        Height = 33
        ShowHint = 1
        hint = "Fermer le Dvix"        
        onClick = close
        Tag = 5
    END CREATE
    CREATE OpenB AS QBUTTON
        Caption = "5"
        font = LogoFont
        Left = 218
        Top = 52
        Width = 35
        Height = 33
        onClick = OpenAVI
        ShowHint = 1
        hint = "Ouvrir un Dvix"
        Tag = 6
    END CREATE
    CREATE QuitB AS QBUTTON
        Caption = chr$(211)
        font = LogoFont
        Left = 253
        Top = 52
        Width = 35
        Height = 33
        ShowHint = 1
        hint = "Quitter"        
        onClick = Quit
        Tag = 7
    END CREATE
    CREATE RadioButton1 AS QRADIOBUTTON
        Caption = "Temps passé"
        Left = 300
        Top = 70
        Width = 100
    END CREATE
    CREATE RadioButton2 AS QRADIOBUTTON
        Caption = "Temps restant"
        Left = 405
        Top = 70
        Width = 100
    END CREATE
    CREATE MuteBox AS QCHECKBOX
        Caption = "Mute"
        Left = 300
        Top = 52
        Width = 100
        onClick = mute
    END CREATE
    CREATE VisibleBox AS QCHECKBOX
        Caption = "Plein écran"
        Left = 405
        Top = 52
        Width = 100
        ShowHint = 1
        hint = "En plein écran : clic gauche sur l'écran pour faire disparaitre les controles, droit pour les voir"        
        onClick = BoxChecked
    END CREATE
ShowModal
END CREATE

Sub init
    RadioButton1.Checked = true
    volumeSlide.position = 100
    lblVolume.caption = "Audio = " + str$(int(volumeSlide.position)) + "%"
    f$ = ""
end sub    
    
   
Sub OpenAVI
    cdg.Filter = "Fichiers media|*.avi; *.mpg; *.mpe; *.mpeg"" 
    cdg.FilterIndex = 1
    cdg.Caption = "Sélectionnez un fichier média"
    IF cdg.Execute THEN 
        open = true
        df$=""
        f$ = cdg.filename
        findcodec
        for i = len(f$) to 1 step -1
            a$ = mid$(f$,i,1)
            if a$ = "\" then exit for
            df$ = df$+a$  
        next       
        file$ = reverse$(df$)      
        ff$ = GetShortPath(f$)
        mciSendString ("open " + ff$ + " type MpegVideo " + "parent " + str$(DVform.handle) + " style 1073741824" , 0, 0, 0)
        mciSendString ("set " + ff$ + " file format jpeg", 0, 0, 0) 
        mciSendString ("Where " + ff$ + " destination", varptr(mvalue), len(mvalue)-1,0)
            totaltime
        Nscreen    
            mciSendString ("setaudio " + ff$ + " volume to " + str$(int(volumeSlide.position)), 0, 0, 0)      
      play
      findcodec 
   End If  
End Sub

Sub Quit
   mciSendString ("close all", 0, 0, 0)
   Application.Terminate
End Sub   

Sub Nscreen
cTimer.enabled = false      
if VisibleBox.checked = false then
   mStart = INSTR(1, mValue, " ")
   mPosition = INSTR(mStart + 1, mValue, " ")
   mStart = INSTR(mPosition + 1, mValue, " ")
   Width$ = MID$(mValue, mPosition, mStart - mPosition) 
   Height$ = MID$(mValue, mStart + 1)
   IF dvform.Height <> (VAL(Height$) + 20) THEN  
        dvform.Height = VAL(Height$) + 20
   END IF
   IF dvform.Width <> (VAL(Width$) + 20) THEN  
        dvform.Width = VAL(Width$) + 20
   end if
    DVform.top = screen.height - (int(form.height*1.5) + (VAL(Height$))+5)
    DVform.left = (screen.width/2) - (dvform.width/2)
    mciSendString ("put " + Ff$ + " window at 10 10 " + Width$ + " " + Height$, 0, 0, 0)   
    DVform.show
    fscreen = false
  end if
End sub                  

sub play
    DVtimer.enabled = true
    mciSendString ("play " + Ff$ + " from " + str$(DVslide.position), 0, 0, 0)
    form.caption = file$ + "    Play"
    playing = true
end sub      

sub stop
    if playing = true then
        pauseB.caption = "4"
        form.caption = file$ + "    Stop"
        DVslide.position = 0
        positionGauge.position = 0
        mciSendString ("play " + Ff$ + " from " + str$(DVslide.position), 0, 0, 0)
        mciSendString ("stop " + ff$,0,0,0)
        playing = false
    end if
end sub     

sub close
        mciSendString ("close " + ff$, 0, 0, 0)
        playing = false
        form.caption = file$ + "    pas de Dvix"
        DVslide.position = 0
        DVform.close
end sub

Sub Pause
    pausedv = false
    If Playing = true Then
        mciSendString ("pause " + ff$, 0, 0, 0)
        Playing = False
        pausedv = true
        form.Caption = file$ + "    Pause"
        pauseB.caption = "4"
    end if
    if pausedv = false then        
        mciSendString ("resume " + ff$, 0, 0, 0)
        pausedv = false
        playing = true
        form.Caption = file$ + "    Lecture"
        pauseB.caption = ";"
    End If
End Sub    

Function GetShortPath(strFileName As String) As String
    Dim lngRes As Long
    strPath$ = String$(165, 0)
    lngRes = GetShortPathName(strFileName, varptr(strPath$), 164)
    GetShortPath = Left$(strPath$, lngRes)
End Function

Function FormatTime(gpos As Long) As String
   Dim lHour As Long
   Dim lMinute As Long
   Dim lSecond As Long  
   lTime = lTime / 1000
   lHour = Int(lTime / 3600)
   lMinute = Int((lTime - 3600 * lHour) / 60)
   lSecond = lTime - 3600 * lHour - 60 * lMinute
   if lSecond < 10 and lMinute < 10 then
       FormatTime = str$(lHour) + ":0" + str$(lMinute) + ":0" + str$(lSecond)
   end if
   if lSecond < 10 and lMinute > 9 then
       FormatTime = str$(lHour) + ":" + str$(lMinute) + ":0" + str$(lSecond)
   end if
   if lSecond > 9 and lMinute < 10 then
       FormatTime = str$(lHour) + ":0" + str$(lMinute) + ":" + str$(lSecond)
   end if
   if lSecond > 9 and lMinute > 9 then
       FormatTime = str$(lHour) + ":" + str$(lMinute) + ":" + str$(lSecond)   
   end if
End Function  

sub showControls  
    'if GetKeyState (&h02) < 0 and fscreen = true then 
    if (GetAsyncKeyState (&h02) < 0 or GetAsyncKeyState (&h2d) < 0) or (if screen.MouseY > screen.Height) and fscreen = true then
        SetWindowPos(form.handle, -1, 0, 0, 0, 0, &H2 + &H1 + &H40)
        form.show
    end if        
end sub

sub TimerDV    
    if playing = true then
        Dim cpos$ as string * 32
        mciSendString ("status " + ff$ + " position", varptr(cpos$), 32, 0&) '&h2)
        gpos = val(cpos$)
        sPos$ = Left$(cpos$, InStr(cpos$, Chr$(0)) - 1)
        if RadioButton1.checked = true then
            lblTime.caption = FormatTime(val(spos$))
        else
            lblTime.caption = FormatTime(val(sTime$) - val(spos$))
        end if
        lblFrmTotal.caption = "[ " + Time$ + " ]"
        positionGauge.position = int(val(spos$)/1000)
    end if
end sub    

Sub TotalTime
    Dim TTime$ As String * 128
    mciSendString ("set " + ff$ + " time format milliseconds", varptr(TTime$), 128, 0&)  
    mciSendString ("status " + ff$ + " length", varptr(TTime$), 128, 0&)     
    mciSendString ("set " + ff$ + " time format frames", 0&, 0&, 0&)   
    lTTime = Val(TTime$)  
    sTime$ = Left$(TTime$, InStr(TTime$, Chr$(0))-1)
    lblTotalT.caption = FormatTime(Val(sTime$))     
    positionGauge.max = int(lTTime/1000)  
    DVslide.max = int(lTTime/1000) 
End Sub    

Sub posBarChg
    DVpos = DVslide.position
    mciSendString ("pause " + ff$, 0, 0, 0)
    mciSendString ("play " + Ff$ + " from " + str$(DVslide.position*1000), 0, 0, 0)
end sub

Sub mute
    if muteBox.checked = true then
        mciSendString ("set " + ff$ + " audio all off", 0&, 0&, 0&)
        Form.Caption = file$ + "    Lecture - audio : Mute"
    else
        mciSendString ("set " + ff$ + " audio all on", 0&, 0&, 0&)
        form.caption = file$ + "    Lecture"
    end if
end sub

Sub volume
    mciSendString ("setaudio " + ff$ + " volume to " + str$(volumeSlide.position), 0, 0, 0)
    lblVolume.caption = "Audio = " + str$(volumeSlide.position) + "%"
end sub

Sub seconds5(sender as QButton)
opt = sender.tag
    select case opt
        case 2
            mciSendString ("play " + Ff$ + " from " + str$(val(spos$) - 5000), 0, 0, 0)
        case 4
            mciSendString ("play " + Ff$ + " from " + str$(val(spos$) + 5000), 0, 0, 0)
    end select
end sub

Sub fullscreen
    captForm.visible = false
    cTimer.enabled = true
    if VisibleBox.checked = true then
        mStart = INSTR(1, mValue, " ")
        mPosition = INSTR(mStart + 1, mValue, " ")
        mStart = INSTR(mPosition + 1, mValue, " ")
        Width$ = MID$(mValue, mPosition, mStart - mPosition) 
        Height$ = MID$(mValue, mStart + 1)
        ratio = val(height$) / val(Width$)
        w$ = str$(screen.width)
        h$ = str$(int(screen.width * ratio))
        top = (int(screen.height - val(h$)) / 2)
        top$ = str$(top)
        SetWindowPos(DVform.handle, -1, 0, 0, 0, 0, &H2 + &H1 + &H40)
        'DVform.windowState = 2 'wsMaximized 
        DVform.top = 0
        DVform.left = 0
        DVform.height = screen.height
        DVform.width = screen.width 
        mciSendString ("put " + Ff$ + " window client at 0 " + top$ + " " + W$ + " " + h$, 0, 0, 0) 
        'mciSendString ("put " + Ff$ + " destination at 0 " + top$ + " " + W$ + " " + h$, 0, 0, 0)         
        'form.caption = top$+"/"+w$+"/"+h$
        DVform.show
        fscreen = true
   end if
   form.show
end sub 

sub BoxChecked
    if VisibleBox.checked = true then
        fullscreen
        else
        Nscreen     
    end if
end sub 

Sub speed(sender as QButton)
    rspeed = 1
    speedOpt = sender.tag
    select case speedOpt
        case 101   
        rspeed = 2
        if playing = true Then
            mciSendString ("set " + Ff$ + " speed " + str$(1000 / rspeed), 0, 0, 0)
        End If
        case 102
        rspeed = 2
        if playing = true Then
            mciSendString ("set " + Ff$ + " speed " + str$(1000 * rspeed), 0, 0, 0)
        End If
        case 100
        rspeed = 2
        if playing = true Then
            mciSendString ("set " + Ff$ + " speed 1000", 0, 0, 0)
        End If        
    end select    
end sub 
      
Sub capture
if playing = false then
    showmessage "Rien à capturer" : exit sub
else
    DVform.show
    SetWindowPos(DVform.handle, -1, 0, 0, 0, 0, &H2 + &H1 + &H40)
    SetFocus(DVform.handle)
    Bitmap.Width = DVform.Width
    Bitmap.Height = DVform.Height
    Win = SetActiveWindow(DVform.handle)
    DC = GetWindowDC(Win)
    if fscreen = false then
        sleep .5
        BitBlt(Bitmap.Handle, 0, 0, DVform.Width, DVform.Height, DC, 0, 0, &HCC0020)
        ReleaseDC(win,DC)   
    else
        form.visible = false
        sleep .5
        BitBlt(Bitmap.Handle, 0, 0, DVform.Width, DVform.Height, DC, 0, 0, &HCC0020)
        ReleaseDC(win,DC)
        form.visible = true        
    end if
    'SetWindowPos(form.handle, -1, 0, 0, 0, 0, &H2 + &H1 + &H40)    
    captPath$ = "c:\CAPTURE"+str$(img)+".BMP"
    Bitmap.SaveToFile(captPath$)
    inc img
    tile.bmp = captPath$
   if (DVForm.width > captForm.width) or (DVForm.height > captForm.height) then
    if DVForm.width > DVForm.height then
        wh = captForm.width/DVForm.width
        WITH captRect
            .Top = 0
            .Left = 0
            .Right = DVForm.width*wh 
            .Bottom = DVForm.height*wh 
        END WITH 
    else
        wh = captForm.height/DVForm.height
        WITH captRect
            .Top = 0
            .Left = 0
            .Right = DVForm.width*wh 
            .Bottom = DVForm.height*wh 
        END WITH 
    end if     
   else
        WITH captRect
            .Top = 0
            .Left = 0
            .Right = DVForm.width
            .Bottom = DVForm.height
        END WITH 
   end if       
        captForm.visible = true
        captForm.top = form.top
        captForm.left = form.left+605
        if fscreen = false then
            captForm.show     
            captform.StretchDraw (captRect,Tile.bmp)
        end if
        captForm.textout(1,1,"CAPTURE"+str$(img)+".bmp",&hff00ff,-1)
end if
end sub

sub Devcapab
    if open = false then showmessage "Ouvrir un fichier d'abord" : exit sub
      dim ret$ as string*128
       mciSendString ("capability " + ff$ + " device type",varptr(ret$),len(ret$)-1,0)
           sret$ = Left$(ret$, InStr(ret$, Chr$(0))-1)
           capab$ = "device type " + sret$ + chr$(13)
       mciSendString ("capability " + ff$ + " can record",varptr(ret$),len(ret$)-1,0)
           sret$ = Left$(ret$, InStr(ret$, Chr$(0))-1)
           capab$ = capab$ + "record possible = " + sret$ + chr$(13)
       mciSendString ("capability " + ff$ + " can save",varptr(ret$),len(ret$)-1,0)
           sret$ = Left$(ret$, InStr(ret$, Chr$(0))-1)
           capab$ = capab$ + "save possible = " + sret$ + chr$(13)
       mciSendString ("capability " + ff$ + " can freeze",varptr(ret$),len(ret$)-1,0)
           sret$ = Left$(ret$, InStr(ret$, Chr$(0))-1)
           capab$ = capab$ + "freeze possible = " + sret$ + chr$(13)           
       mciSendString ("capability " + ff$ + " windows",varptr(ret$),len(ret$)-1,0)
           sret$ = Left$(ret$, InStr(ret$, Chr$(0))-1)
           capab$ = capab$ + "simultaneous windows " + sret$ + chr$(13)
           'error = mciGetErrorString(ret,varptr(ret$),128)
           'showmessage "erreur " + str$(ret) + ret$
       showmessage capab$                 
end sub


sub findCodec   '==============find Codec===========
if ucase$(right$(ff$,3)) = "AVI" then
    f = fileexists("c:\windows\fonts\Webdings.ttf")
        Nfile.Open(f$, FmOpenRead)   
    if f$ = "" or f = false then
        showmessage "Vous devez avoir la police Webdings installée sur votre ordinateur"
        NFile.close
        exit sub
    end if         
        MemF.CopyFrom(NFile,200 )
        NFile.Position = 188   
        MemF.Position = 0
        MemF.position = 188
        codec$=MemF.readStr(4)
        CodecB.caption = codec$
        NFile.close
        memF.close
else
    exit sub
end if
end sub

sub fourcc
    formC.show
    if f$ = "" then
        labelC.caption = "Ouvrez un Divx pour connaitre le codec"
    else
        labelC.caption = "FourCC - Codec = "
        infoCodecLbl.Caption = codec$
    end if
end sub

sub openIE
    Shell ("explorer.exe http://www.fourcc.org/index.php?http%3A//www.fourcc.org/links.php")
end sub
  
sub About
    showmessage "______By  Gérald VERDIER______"+chr$(13)+_
                "______RQ Divix player v1.0_____"+chr$(13)+_
                "_gerald.verdier@club-internet.fr_"+chr$(13)+_
                "____________________________"
end sub