PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

simples Scanprogramm

https://www.purebasic.fr/german/viewtopic.php?t=20730

Seite 1 von 1

simples Scanprogramm

Verfasst: 22.08.2009 22:18
von hjbremer
für meine Ebayauktionen scanne ich immer einige Sachen ab und nun hatte ich keine Lust mehr immer das große alles erschlagende Paint Shop zu benutzen.

hier eine kleines simples Tool zum Scannen und zum zurecht schneiden des Bildes ( mit den Pfeiltasten)

ist sicher nicht perfekt, auch der Prog-Stil ist nicht berauschend, halt kurz hingehackt. Ein kleiner Teil des Codes stammt aus der mitgelieferten Demo.

vielleicht kanns ja einer gebrauchen

Code: Alles auswählen

;TwScann.dll from Andreas Miethe 
;http://www.ampsoft.eu/purebasic/dlls.php 

EnableExplicit

UseJPEGImageEncoder() 

Enumeration
#mainwindow
#container1
#bscanstart
#bscansave
#imagenr
#bimagenr
#pastecut
#textinfo
#texthelp
#fontnr
#imgcpy
#imgori
EndEnumeration

;Shared Variablen definieren
Define clip, imgbr, imghh, bhf.f
Define scandllnr, altclipboard$

Procedure.i BildBrightness(wert)
  
   Protected hh = ImageHeight(#imagenr) 
   Protected br = ImageWidth(#imagenr)  
   Protected tmp = CreateImage(#PB_Any, br, hh)
   Protected ca.COLORADJUSTMENT
  
   Protected dc = StartDrawing(ImageOutput(tmp)) 
      DrawImage(ImageID(#imagenr), 0, 0)
      SetStretchBltMode_(dc, #HALFTONE)
      GetColorAdjustment_(dc, ca)
      ca\caBrightness = wert 
      SetColorAdjustment_(dc, ca)
      StretchBlt_(dc,0,0,br,hh, dc,0,0,br,hh, #SRCCOPY)
   StopDrawing() 
   GrabImage(tmp, #imagenr, 0, 0, br, hh) 
   FreeImage(tmp) 
  
EndProcedure

Procedure.i Bilddrehen(rl = 'rechts') 

   Protected hh = ImageHeight(#imagenr) 
   Protected br = ImageWidth(#imagenr) 
   Protected tmp
   
   If hh > br 
      tmp = CreateImage(#PB_Any, hh, hh) 
   Else 
      tmp = CreateImage(#PB_Any, br, br) 
   EndIf 
   
   Dim p.point(2) 
   
   If rl = 'rechts'
      p(0)\x=hh 
      p(0)\y=0 
      p(1)\x=hh 
      p(1)\y=br 
      p(2)\x=0 
      p(2)\y=0 
   Else
      p(0)\x=0
      p(0)\y=br 
      p(1)\x=0
      p(1)\y=0
      p(2)\x=hh  
      p(2)\y=br  
   EndIf
   
   Protected dc = StartDrawing(ImageOutput(tmp)) 
      DrawImage(ImageID(#imagenr), 0, 0) 
      PlgBlt_(dc, p(), dc, 0, 0, br, hh, 0, 0, 0) 
   StopDrawing() 
   GrabImage(tmp, #imagenr, 0, 0, hh, br) 
   FreeImage(tmp) 
   
EndProcedure 

Procedure.i resizeFenster(br = 0, hh = 0)
   
   Shared imgbr, imghh
    
   If br = 0: br = imgbr + 130: EndIf
   If hh = 0: hh = imghh + 20: EndIf
   If hh < 180: hh = 180: EndIf
      
   ResizeWindow(#mainwindow, #PB_Ignore, #PB_Ignore, br, hh)
   ResizeGadget(#container1, #PB_Ignore, #PB_Ignore, br, hh)
   ResizeGadget(#texthelp,   #PB_Ignore, #PB_Ignore, br, hh)

EndProcedure

Procedure.i TextInfo()
   
   Shared imgbr, imghh
  
   SaveImage(#imagenr, "dummy", #PB_ImagePlugin_JPEG) 
  
   Protected txt$
   txt$ = Str(imgbr) + " x " + Str(imghh) + #LF$ 
   txt$ + Str(FileSize("dummy"))
   SetGadgetText(#textinfo, txt$)

EndProcedure

Procedure.i ScannerDllOpen()  
   
   Protected nr = OpenLibrary(#PB_Any, "TwScann.dll") 
   If nr 
      Protected isTwain = CallFunction(nr, "IsTwain") 
      If isTwain = 0 
         MessageRequester("Info", "Scanner mit TWAIN interface! nicht gefunden") 
         End
      Else
         CallFunction(nr, "SelectSource") 
      EndIf 
   Else 
      MessageRequester("Info", "TwScann.dll nicht gefunden!") 
      End
   EndIf 
   
ProcedureReturn nr 
EndProcedure

Procedure.i ScannerStart(flag=0)
   
   Shared clip, imgbr, imghh, bhf.f
   Shared scandllnr, altclipboard$

   altclipboard$ = GetClipboardText() 

   If Not scandllnr: ProcedureReturn: EndIf
           
   CallFunction(scandllnr, "ScanToClip", 0) ; 0=mit Scannerbild
  
   If IsImage(clip): FreeImage(clip): EndIf
  
   clip = GetClipboardImage(#PB_Any) 
   If clip 

      imgbr = ImageWidth(Clip) 
      imghh = ImageHeight(Clip) 
      bhf = imghh / imgbr        ;:Debug bhf     
               
      imgbr / 4  ;:Debug imgbr
      imghh / 4  ;:Debug imghh
     
      CreateImage(#imagenr, imgbr, imghh) 
      StartDrawing(ImageOutput(#imagenr)) 
         DrawImage(ImageID(clip), 0, 0, imgbr, imghh) 
      StopDrawing() 
     
      resizeFenster()
      textInfo()
      SetGadgetState(#bimagenr, ImageID(#imagenr)) 

  Else 
      MessageRequester("Info", "kein Bild in Clipboard!") 
  EndIf 

EndProcedure

Procedure.i imgsave()
   
   Shared clip
   Shared altclipboard$

   Protected vorgabe$ = Left(altclipboard$, 40)
   Protected filename$
   
   If clip 
      filename$ = SaveFileRequester("Bild speichern", vorgabe$, "JPEG (*.jpg)|*.jpg", 0) 
      If filename$ 
         If FindString(filename$, ".jpg", 1) = 0 : filename$ + ".jpg" : EndIf 
         SaveImage(#imagenr, filename$, #PB_ImagePlugin_JPEG) 
      EndIf 
   Else 
      MessageRequester("Info", "kein Bild !") 
   EndIf 
  
EndProcedure

Procedure.i merge()
   
   Shared clip, imgbr, imghh, bhf.f
   
   If Not IsImage(#imagenr): ProcedureReturn: EndIf
   If Not IsImage(#imgcpy): ProcedureReturn: EndIf
   
   CopyImage(#imagenr, #imgori)
   
   imgbr = ImageWidth(#imgori) + ImageWidth(#imgcpy)
   imghh = ImageHeight(#imgori)
   bhf = imghh / imgbr
   
   CreateImage(#imagenr, imgbr, imghh) 
   StartDrawing(ImageOutput(#imagenr))           
     DrawImage(ImageID(#imgori), 0, 0) 
     DrawImage(ImageID(#imgcpy), ImageWidth(#imgori), 0)            
   StopDrawing() 
   
   resizeFenster()
   textInfo()   
   SetGadgetState(#bimagenr, ImageID(#imagenr)) 
   
EndProcedure

Procedure.i paste()
   
   Shared clip, imgbr, imghh, bhf.f

   clip = GetClipboardImage(#PB_Any) 
   If clip 
  
      imgbr = ImageWidth(Clip)   ;:Debug imgbr
      imghh = ImageHeight(Clip)  ;:Debug imghh                        
      bhf = imghh / imgbr        ;:Debug bhf
    
      CreateImage(#imagenr, imgbr, imghh) 
      StartDrawing(ImageOutput(#imagenr)) 
         DrawImage(ImageID(Clip), 0, 0, imgbr, imghh) 
      StopDrawing() 
     
      resizeFenster()
      textInfo()
      SetGadgetState(#bimagenr, ImageID(#imagenr)) 

  Else 
      MessageRequester("Info", "kein Bild in Clipboard!") 
  EndIf 

EndProcedure

Procedure.i cut_etc(taste)
   
   Shared imgbr, imghh, bhf.f
   
   Protected weg, x, y, br, hh, ziel
   
   If IsImage(#imagenr) 
  
      imgbr = ImageWidth(#imagenr) 
      imghh = ImageHeight(#imagenr)
      weg = 5     
     
      Select taste
           Case 38  ;Pfeil oben - Bild nach oben schieben
                   x  = 0
                   y  = weg
                   br = imgbr
                   hh = imghh - weg
                
           Case 40  ;Pfeil unten - Bild nach unten schieben
                   x = 0
                   y = 0
                   br = imgbr
                   hh = imghh - weg
                
           Case 37  ;Pfeil links - Bild nach links schieben
                   x  = 5
                   y  = 0
                   br = imgbr - weg
                   hh = imghh 
                
           Case 39  ;Pfeil rechts - Bild nach rechts schieben
                   x  = 0
                   y  = 0
                   br = imgbr - weg
                   hh = imghh
                
           Case 33  ;Bild oben
                   If bhf = 1: bhf = 1.1: EndIf
                   If bhf < 1: bhf + 1: EndIf
                   imgbr * bhf
                   imghh * bhf
                   ResizeImage(#imagenr, imgbr, imghh)                   
                   x  = 0
                   y  = 0
                   br = imgbr
                   hh = imghh 
           
           Case 34  ;Bild unten
                   If bhf = 1: bhf = 1.1: EndIf
                   If bhf < 1: bhf + 1: EndIf
                   imgbr / bhf
                   imghh / bhf
                   ResizeImage(#imagenr, imgbr, imghh)                                      
                   x  = 0
                   y  = 0
                   br = imgbr
                   hh = imghh 

           Case 13
                   BildDrehen()
                   x  = 0
                   y  = 0
                   br = ImageWidth(#imagenr) 
                   hh = ImageHeight(#imagenr)                   
           
           Case 107
                   BildBrightness(10)
                   x  = 0
                   y  = 0
                   br = ImageWidth(#imagenr) 
                   hh = ImageHeight(#imagenr)
                   
           Case 109
                   BildBrightness(-10)
                   x  = 0
                   y  = 0
                   br = ImageWidth(#imagenr) 
                   hh = ImageHeight(#imagenr)
                   
           Default: ProcedureReturn
             
      EndSelect           
     
      ;                quelle    ziel
      ziel = GrabImage(#imagenr, #PB_Any, x, y, br,hh)

      imgbr = br  ;hier ImageWidth benutzen führt zu Fehlern
      imghh = hh  ; "" 
      x = 0
      y = 0
      GrabImage(ziel, #imagenr, x, y, imgbr, imghh)
     
      SetGadgetState(#bimagenr, ImageID(#imagenr))
      FreeImage(ziel) 
      textInfo()
      resizeFenster()
   
      bhf = imghh / imgbr        
                                          
   EndIf 

EndProcedure

; ---------------------------------------------

LoadFont(#fontnr, "Courier New", 10)

SetClipboardText("bild")

scandllnr = ScannerDllOpen()

OpenWindow(#mainwindow, 100, 100, 120, 150, "Scan 1.04", #PB_Window_SystemMenu) 

AddKeyboardShortcut(#mainwindow, #PB_Shortcut_Control | #PB_Shortcut_S, 1001)
AddKeyboardShortcut(#mainwindow, #PB_Shortcut_Control | #PB_Shortcut_M, 1002)

  ContainerGadget(#container1,  0,   0, 120, 150)
     ButtonGadget(#bscanstart, 10,  10, 100,  30, "Scan") 
     ButtonGadget(#bscansave,  10,  50, 100,  30, "Save") 
     ButtonGadget(#pastecut,   10,  90, 100,  30, "paste") 
       TextGadget(#textinfo,   10, 130, 100,  36, "F1 = Info", #PB_Text_Center) 
      ImageGadget(#bimagenr,  120,  10,   0,   0, 0, #PB_Image_Border) 
  CloseGadgetList()
  
  TextGadget(#texthelp, 0, 0, 120, 140, "") 
  HideGadget(#texthelp,1)
  SetGadgetFont(#texthelp, FontID(#fontnr)) 
  
  Define helptext$
  helptext$ = " Button Start: Scannen" + #LF$
  helptext$ + " Button Save:  Bild speichern" + #LF$
  helptext$ + " Button Paste: kopiertes Bild laden" + #LF$ + #LF$
  helptext$ + " Pfeiltasten:  Rand abschneiden" + #LF$
  helptext$ + " Bild unten:   Bild verkleinern" + #LF$ 
  helptext$ + " Bild oben:    Bild vergrößern" + #LF$
  helptext$ + " Enter:        Bild drehen" + #LF$
  helptext$ + " + -           Bild heller/dunkler" + #LF$
  helptext$ + " Strg S:       Bild intern speichern" + #LF$
  helptext$ + " Strg M:       mit Bild intern mergen" + #LF$

  helptext$ + #LF$ + " ESC: zurück"
  SetGadgetText(#texthelp, helptext$)
  
Define event, taste, altbr, althh
  
Repeat: event = WaitWindowEvent() 
      If event = #PB_Event_Gadget 
        
         Select EventGadget() 
            Case #bscanstart: ScannerStart()
            Case #bscansave: imgsave()
            Case #pastecut:  paste()
         EndSelect 
           
      ElseIf event = #PB_Event_Menu
         Select EventMenu()
            Case 1001: CopyImage(#imagenr, #imgcpy)
            Case 1002: merge()   
         EndSelect
         
      ElseIf event = #WM_KEYDOWN 
           taste = EventwParam()  ;:Debug taste
           Select taste
             Case 16, 17   ;Strg, Shift
             Case 27  ;ESC 
                  resizeFenster(altbr, althh)
                  HideGadget(#texthelp, 1)
                  HideGadget(#container1, 0)
             Case 112 ;F1
                  altbr = WindowWidth(#mainwindow)
                  althh = WindowHeight(#mainwindow)
                  resizeFenster(400, 250) 
                  HideGadget(#texthelp, 0)
                  HideGadget(#container1, 1)
             Default
                cut_etc(taste)
           EndSelect        
      EndIf 

Until Event = #PB_Event_CloseWindow 
  
If scandllnr: CloseLibrary(scandllnr): EndIf 

End
__________________________________________________
Thread wurde verschoben
Anfänger>Code, Tipps und Tricks
22.08.2009
RSBasic

Verfasst: 22.08.2009 22:20
von jojo1541
Eher was für Code, Tipps und Tricks, oder?

Verfasst: 22.08.2009 23:00
von RSBasic
@hjbremer
Wenn du einen Beispielcode posten möchtest, dann bitte im "Code, Tipps und Tricks"-Unterforum posten.
Im "Anfänger"-Unterforum kommen nur Fragen rein.

Re: simples Scanprogramm

Verfasst: 26.09.2009 17:24
von hjbremer
kleines Update mit Minihilfe, Bilddrehen, größer/kleiner, Helligkeit

noch ein kleines Update, Code siehe oben

Re: simples Scanprogramm

Verfasst: 27.07.2010 19:34
von hjbremer
wieder ein kleines Update , Code siehe oben

neu sind die Tasten Strg S um ein Bild intern zu speichern und mit Strg M wird das alte Bild mit dem aktuellen Bild zusammen angezeigt.

PS: mit PB 4.31 ist das Programm ca 45 Kb kleiner als wenn man 4.5 nimmt

Verkleinerung des gescannten Bildes

Verfasst: 28.10.2010 10:20
von ralle
Hallo hjbremer!

Erst mal vielen Dank für deinen Einstieg in PB zum Thema scannen. Viel gibt es dazu ja nicht gerade und diesbezüglich habe ich mal dein Programm und die Funktionen getestet. Dabei ist mir im Vergleich zu MSPaint eines aufgefallen: Bei identischen Einstellungen eines Scans wird dein Bild ca. um den Faktor 4 kleiner. Habe die entsprechende Codezeile mit dem scaling auch gefunden denke ich:

Code: Alles auswählen

152      imgbr / 4  ;:Debug imgbr
153      imghh / 4  ;:Debug imghh
Nun meine Frage dazu: Hat das einen speziellen Grund, warum du explizit verkleinerst, oder waren dir die anderen Bilder ansonsten zu groß? Muss diese Konvertierung sein, oder war das eine reine individuelle Anpassung zur Übersicht halber? Kann ja sein, dass das in einem besonderen Kontext in PB nötig ist.

MfG
Ralle :)

Re: simples Scanprogramm

Verfasst: 30.10.2010 11:21
von kwai chang caine
Danke :allright:
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de