Scanner + imprimante = photocopieur

Télécharger le projet
Commenter

Description

Alors je vous explique : j'ai une zolie imprimante+scanner mais en plus j'ai une laser N&B et quand je veux faire une copie couleur le soft me permet pas de faire directement la copie du scan vers ma laser ... du coup un petit prog sympa qui permet de faire des copies si vous avez un scanner (compatible TWAIN) et une imprimante ... Plus des paramètres en ligne de commande pour créer un raccourci bureau de copie en automatique. Le code est open a vous de jouer !!!

Source / Exemple : 


Option Explicit
Public PARAM_Couleur As Boolean
Public PARAM_Brouillon As Boolean
Public PARAM_Reduction As Boolean
Public AUTONB As Boolean
Public AUTOCOLOR As Boolean

Public PRN_IDX As Integer

Public Sub Imprime()
Dim i As Integer
Dim Done As Boolean

Done = False
For i = 0 To Printers.Count
    If i = PRN_IDX Then
        
        Done = True
        Set Printer = Printers(i)
        Printer.ScaleMode = 6
        
        Select Case PARAM_Couleur
        Case True
        'Couleur
        Printer.ColorMode = vbPRCMColor
            Select Case PARAM_Brouillon
            Case True
            'Brouillon
                Printer.PrintQuality = -1
                Select Case PARAM_Reduction
                Case True
                'Reduit
                    Printer.Orientation = vbPRORLandscape
                    Printer.PaintPicture frm_main.PrevPic.Picture, 0, 0, 145, 200
                Case False
                'Normal
                    Printer.Orientation = vbPRORPortrait
                    Printer.PaintPicture frm_main.PrevPic.Picture, 0, 0, 200, 290
                End Select
            Case False
            'Normal
                Printer.PrintQuality = -4
                Select Case PARAM_Reduction
                Case True
                'Reduit
                    Printer.Orientation = vbPRORLandscape
                    Printer.PaintPicture frm_main.PrevPic.Picture, 0, 0, 145, 200
                Case False
                'Normal
                    Printer.Orientation = vbPRORPortrait
                    Printer.PaintPicture frm_main.PrevPic.Picture, 0, 0, 200, 290
               End Select
            End Select
        Case False
        'NB
        Printer.ColorMode = vbPRCMMonochrome
            Select Case PARAM_Brouillon
            Case True
            'Brouillon
                Printer.PrintQuality = -1
                Select Case PARAM_Reduction
                Case True
                'Reduit
                    Printer.Orientation = vbPRORLandscape
                    Printer.PaintPicture frm_main.PrevPic.Picture, 0, 0, 145, 200
                Case False
                'Normal
                    Printer.Orientation = vbPRORPortrait
                    Printer.PaintPicture frm_main.PrevPic.Picture, 0, 0, 200, 290
                End Select
            Case False
            'Normal
                Printer.PrintQuality = -4
                Select Case PARAM_Reduction
                Case True
                'Reduit
                    Printer.Orientation = vbPRORLandscape
                    Printer.PaintPicture frm_main.PrevPic.Picture, 0, 0, 145, 200
                Case False
                'Normal
                    Printer.Orientation = vbPRORPortrait
                    Printer.PaintPicture frm_main.PrevPic.Picture, 0, 0, 200, 290
                End Select
            End Select
        End Select
        
        'Impression
        Printer.EndDoc
    End If
Next

'Impression par défaut
If Done = False Then
    Printer.Orientation = vbPRORPortrait
    Printer.ColorMode = vbPRCMMonochrome
    Printer.ScaleMode = 6
    Printer.PaintPicture frm_main.PrevPic.Picture, 0, 0, 200, 290
    Printer.EndDoc
End If

End Sub

Public Sub Affiche()

Dim LePrev As Image
Set LePrev = frm_main.PrevPic
LePrev.Stretch = True
LePrev.Picture = LoadPicture(App.Path & "\scan.bmp")

End Sub

Public Sub Recup_Param()

Select Case frm_main.chk_brouillon.Value
Case vbChecked
    PARAM_Brouillon = True
Case vbUnchecked
    PARAM_Brouillon = False
End Select

Select Case frm_main.chk_reduc.Value
Case vbChecked
    PARAM_Reduction = True
Case vbUnchecked
    PARAM_Reduction = False
End Select

If frm_main.opt_col(1).Value = True Then
    PARAM_Couleur = False
ElseIf frm_main.opt_col(0).Value = True Then
    PARAM_Couleur = True
Else
    PARAM_Couleur = False
End If

On Error Resume Next
If Trim(UCase(Command())) = "-AUTONB" Then
    AUTONB = True
Else
    AUTONB = False
End If

If Trim(UCase(Command())) = "-AUTOCOLOR" Then
    AUTOCOLOR = True
Else
    AUTOCOLOR = False
End If

On Error GoTo 0

End Sub

Private Sub ListePRN()
Dim LePrn As String
Dim i As Integer

On Error Resume Next
If Printers.Count > 0 Then
    frm_main.cmb_prn.Clear
    For i = 0 To Printers.Count - 1
        frm_main.cmb_prn.AddItem Printers(i).DeviceName
        If Printers(i).DeviceName = Printer.DeviceName Then
            LePrn = Printers(i).DeviceName
            PRN_IDX = i
        End If
    Next
    frm_main.cmb_prn.Text = LePrn
Else
    MsgBox "Pour faire une copie vous devez avoir une imprimante installée", vbCritical, "Vous ne pouvez pas continuer"
    End
End If
On Error GoTo 0

End Sub

Private Sub VireFic()

On Error Resume Next
Kill App.Path & "\scan.bmp"
On Error GoTo 0

End Sub

Private Sub Scanne()

Recup_Param
Me.MousePointer = vbHourglass

Dim LeScan As ScanLibCtl.ImgScan
Set LeScan = frm_main.scanner

VireFic

LeScan.ScanTo = FileOnly
LeScan.Image = App.Path & "\scan"
LeScan.FileType = BMP_Bitmap
LeScan.PageOption = CreateNewFile
LeScan.ShowSetupBeforeScan = False

Select Case PARAM_Brouillon
Case True
    Select Case PARAM_Couleur
    Case True
        LeScan.SetPageTypeCompressionOpts SmallestFile, ColorPal4Bit, Uncompressed, NoCompInfo
    Case False
        LeScan.SetPageTypeCompressionOpts SmallestFile, Gray4Bit, Uncompressed, NoCompInfo
    End Select
Case False
    Select Case PARAM_Couleur
    Case True
        LeScan.SetPageTypeCompressionOpts BestDisplay, Gray8Bit, Uncompressed, NoCompInfo
    Case False
        LeScan.SetPageTypeCompressionOpts BestDisplay, TrueColor24bitRGB, Uncompressed, NoCompInfo
    End Select
End Select

LeScan.OpenScanner
LeScan.StartScan
LeScan.CloseScanner

Me.MousePointer = vbNormal

End Sub

Private Sub cmb_prn_Change()
Dim i As Integer
For i = 0 To Printers.Count - 1
    If Printers(i).DeviceName = frm_main.cmb_prn.Text Then
        PRN_IDX = i
    End If
Next

End Sub

Private Sub cmb_prn_Click()
Dim i As Integer
For i = 0 To Printers.Count - 1
    If Printers(i).DeviceName = frm_main.cmb_prn.Text Then
        PRN_IDX = i
    End If
Next
End Sub

Private Sub cmb_prn_LostFocus()
Dim i As Integer
For i = 0 To Printers.Count - 1
    If Printers(i).DeviceName = frm_main.cmb_prn.Text Then
        PRN_IDX = i
    End If
Next
End Sub

Private Sub cmb_prn_Validate(Cancel As Boolean)
Dim i As Integer
For i = 0 To Printers.Count - 1
    If Printers(i).DeviceName = frm_main.cmb_prn.Text Then
        PRN_IDX = i
    End If
Next
End Sub

Private Sub Cmd_copy_Click()

Scanne
Affiche
Imprime

End Sub

Private Sub cmd_Preview_Click()

Scanne
Affiche

End Sub

Private Sub cmd_quit_Click()
VireFic
End
End Sub

Private Sub Form_Load()
Recup_Param
VireFic
ListePRN

If AUTONB = True Then
    Scanne
    Affiche
    Printer.ColorMode = vbPRCMMonochrome
    Printer.ScaleMode = 6
    Printer.PaintPicture frm_main.PrevPic.Picture, 0, 0, 200, 290
    Printer.EndDoc
    VireFic
    End
End If
If AUTOCOLOR = True Then
    Scanne
    Affiche
    Printer.ColorMode = vbPRCMColor
    Printer.ScaleMode = 6
    Printer.PaintPicture frm_main.PrevPic.Picture, 0, 0, 200, 290
    Printer.EndDoc
    VireFic
    End
End If

End Sub

Private Sub Form_Terminate()
VireFic
End Sub

Private Sub mnu_fic_quit_Click()
VireFic
End
End Sub

Private Sub mnu_fic_saveas_Click()
Dim LeFic As String
LeFic = App.Path & "\scan.bmp"
If Dir(LeFic) <> "" Then
    On Error Resume Next
    frm_main.cdlg.Filter = "Fichier BITMAP|*.bmp"
    frm_main.cdlg.FileName = "Scan"
    frm_main.cdlg.ShowSave
    FileCopy LeFic, frm_main.cdlg.FileName
    On Error GoTo 0
Else
    MsgBox "Vous ne pouvez encore sauvegarder", vbInformation, "Impossible : pas de fichier"
End If

End Sub

Private Sub mnu_ha_about_Click()
frmAbout.Show
End Sub

Private Sub mnu_ha_help_Click()
Dim LeTXT As String

LeTXT = "Je vous avais prévenu ... l'aide est sommaire :" & vbCrLf
LeTXT = LeTXT & "Pour une copie automatique en NOIR et BLANC sur l'imprimate PAR DEFAUT," & vbCrLf
LeTXT = LeTXT & "créer un raccourci en passant le paramètre -AUTONB : " & vbCrLf
LeTXT = LeTXT & "CSM-Copier.exe -AUTONB" & vbCrLf
LeTXT = LeTXT & "Pour de la couleur remplacer -AUTONB par -AUTOCOLOR"
MsgBox LeTXT, vbInformation, "Aide VRAIMENT SOMMAIRE !!!"
End Sub

Private Sub opt_col_Click(Index As Integer)
Select Case Index
Case 0
    PARAM_Couleur = True
Case 1
    PARAM_Couleur = False
End Select
End Sub

Conclusion :


Ce dont vous avez besoin :
- Un scanner et une imprimante coté Matos ...
- Le composant de numérisation Kodak (tm) le bidule compatible TWAIN
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (Clem2k)