0/5 (3 avis)
Vue 13 761 fois - Téléchargée 1 571 fois
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
16 juin 2005 à 20:44
Antoine
16 juin 2005 à 17:41
Antoine
27 avril 2004 à 18:54
c'est exactement ce que je desirerai faire mais en C++ avec GTK, comment gerer le scanner et l'imprimante?
y'a t'il des bibliothèques spécifiques pour cette gestion?
je n'ai trouvé aucune source concernant l'impression d'image ou la numerisation...
merci
choupinette83!!!!!!!!!!!!!!!!! ; )
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.