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
