EnableExplicit ; bei Verwendung müssen diese und die folgenden 2 Zeilen erhalten bleiben ; Norbert Freier ; entstanden an der TU Chemnitz #programmname = "Essen zuschneiden" #bild_skalierung = 0.8 #menue_height = 25 #rahmen_size = 25 #fenster = 1 #menu = 2 #menu_item_laden = 3 #menu_item_speichern = 4 #menu_item_auto_crop = 5 #bild = 6 #file = 7 Global image_present.a = 0 Global move_links.a = 0 Global move_rechts.a = 0 Global move_oben.a = 0 Global move_unten.a = 0 Global maus_x.l Global maus_y.l #none = 0 #move = 1 Global aktion.a = #none Structure t_rahmen oben.l unten.l links.l rechts.l EndStructure Global bildpos.t_rahmen Global rahmen.t_rahmen Structure rgb r.a g.a b.a EndStructure Structure hsv h.a s.a v.a EndStructure #feld = 20 ;##################################################################### ;## läd das bild mit dem dateinamen solang es existiert ## ;## geladenes bild wird skaliert, damit es auf den bildschirm passt ## ;##################################################################### Procedure.a load_image(dateiname.s) Protected out.a = 0 Protected breite.l Protected hoehe.l ; abbrechen gedrückt? -> dateiname leer If (dateiname <> "") ; richtiges bildformat? If ((GetExtensionPart(dateiname) = "jpg") Or (GetExtensionPart(dateiname) = "jpeg") Or (GetExtensionPart(dateiname) = "JPG") Or (GetExtensionPart(dateiname) = "JPEG")) ; existiert bild? laden erfolgsreich? If LoadImage(#bild, dateiname) hoehe = ImageHeight(#bild) breite = ImageWidth(#bild) ; bild skalieren wenn zu groß If ((hoehe > (#bild_skalierung * WindowHeight(#fenster))) Or (breite > (#bild_skalierung * WindowWidth(#fenster)))) ; zu hoch -> höhe reduzieren und breite entsprechend anpassen If (hoehe > WindowHeight(#fenster)) hoehe = #bild_skalierung * WindowHeight(#fenster) breite = Round(ImageWidth(#bild) * (hoehe / ImageHeight(#bild)), #PB_Round_Nearest) EndIf ; zu breit -> breite raduzieren und höhe entsprechend anpassen If (breite > WindowWidth(#fenster)) breite = #bild_skalierung * WindowWidth(#fenster) hoehe = Round(ImageHeight(#bild) * (breite / ImageWidth(#bild)), #PB_Round_Nearest) EndIf ; neue breite und hoehe auf das bild anwenden If ResizeImage(#bild, breite, hoehe, #PB_Image_Smooth) out = 1 EndIf Else out = 1 EndIf EndIf Else MessageRequester(#programmname, "Es können nur Bilder in mit den Endungen .jpg | .JPG oder .jpeg | JPEG geladen werden!") EndIf EndIf ProcedureReturn out EndProcedure ;############################## ;## löscht den Fensterinhalt ## ;############################## Procedure clear() StartDrawing(WindowOutput(#fenster)) DrawingMode(#PB_2DDrawing_Default) Box(0, 0, WindowWidth(#fenster), WindowHeight(#fenster), RGB(240, 240, 240)) StopDrawing() EndProcedure ;######################################### ;## gibt das bild passend im window aus ## ;######################################### Procedure paint_image() Protected x.l Protected y.l If (image_present) If StartDrawing(WindowOutput(#fenster)) DrawImage(ImageID(#bild), bildpos\links, bildpos\oben) StopDrawing() EndIf EndIf EndProcedure ;################################################### ;## zeichnet einen rahmen um den zuschnittbereich ## ;################################################### Procedure paint_rahmen() If (image_present) If StartDrawing(WindowOutput(#fenster)) FrontColor(RGB(0, 0, 0)) DrawingMode(#PB_2DDrawing_Outlined) Box(rahmen\links, rahmen\oben, rahmen\rechts - rahmen\links, rahmen\unten - rahmen\oben) Box(rahmen\links + #rahmen_size, rahmen\oben, rahmen\rechts - rahmen\links - 2 * #rahmen_size, rahmen\unten - rahmen\oben) Box(rahmen\links, rahmen\oben + #rahmen_size, rahmen\rechts - rahmen\links, rahmen\unten - rahmen\oben - 2 * #rahmen_size) FrontColor(RGB(255, 0, 0)) Ellipse(Round((rahmen\links + rahmen\rechts) / 2, #PB_Round_Down), Round((rahmen\oben + rahmen\unten) / 2, #PB_Round_Down), Round((rahmen\rechts - rahmen\links) / 2, #PB_Round_Nearest) - 1, Round((rahmen\unten - rahmen\oben) / 2, #PB_Round_Nearest) - 1) StopDrawing() EndIf EndIf EndProcedure Procedure paint() paint_image() paint_rahmen() EndProcedure ;################################################### ;## errechnet und speichert die neue bildposition ## ;################################################### Procedure new_bild_data() If image_present bildpos\links = Round((WindowWidth(#fenster) - ImageWidth(#bild)) / 2, #PB_Round_Nearest) bildpos\rechts = bildpos\links + ImageWidth(#bild) bildpos\oben = Round((WindowHeight(#fenster) - #menue_height - ImageHeight(#bild)) / 2, #PB_Round_Nearest) bildpos\unten = bildpos\oben + ImageHeight(#bild) EndIf EndProcedure ;######################################################### ;## errechnet und speichert die werte des neuen rahmens ## ;######################################################### Procedure new_bild_rahmen() If image_present rahmen\oben = bildpos\oben rahmen\unten = bildpos\unten rahmen\links = bildpos\links rahmen\rechts = bildpos\rechts EndIf EndProcedure ;################################################### ;## gibt das minimum der beiden long-werte zurück ## ;################################################### Procedure.l min_l(a.l, b.l) Protected out.l If (a > b) out = b Else out = a EndIf ProcedureReturn out EndProcedure ;################################################################## ;## speichert das bild zugeschnitten auf den ausgewählten rahmen ## ;################################################################## Procedure save_image(dateiname.s) Protected img_crop.l Protected img_transparent.l Protected img_klein.l Protected size.l Protected x.l Protected y.l Protected radius.l Protected i.l Protected j.l Protected farbe.l ;auf rechteck zuschneiden und zum quadrat skalieren img_crop = GrabImage(#bild, #PB_Any, rahmen\links - bildpos\links, rahmen\oben - bildpos\oben, rahmen\rechts - rahmen\links, rahmen\unten - rahmen\oben) size = min_l(ImageWidth(img_crop), ImageHeight(img_crop)) ; auf ungerade zahl bringen für radius aber nicht größer werden radius = Round((size - 1) / 2, #PB_Round_Down) size = 2 * radius + 1 ResizeImage(img_crop, size, size, #PB_Image_Smooth) ;transparentes bild in der selben größe erstellen img_transparent = CreateImage(#PB_Any, size, size, 32|#PB_Image_Transparent) ; erst altes bild einlesen, erspart abwechselnde startdrawing stopdrawing Protected Dim in.l(size, size) StartDrawing(ImageOutput(img_crop)) DrawingMode(#PB_2DDrawing_AllChannels) For i = 0 To (size - 1) For j = 0 To (size - 1) in(i, j) = Point(i, j) Next Next StopDrawing() ;kopieren der farbigen Beriche If (StartDrawing(ImageOutput(img_transparent))) DrawingMode(#PB_2DDrawing_AllChannels) ;erstmal alles transparent setzen Box(0, 0, size, size, RGBA(255, 255, 255, 0)) ; alle pixel ablaufen und kopieren wenn sie im kreis liegen ; für 1/8 des kreises rahmen berechnen, rest durch spiegelung ; alle x zwischen y-grenzen werden kopiert ; grenzen werden nach dreicksgleichung errechnet: x und radius, hoehe senkrecht auf x gesucht ; xor 11..1100..00 um 24bit fahrbwert auf 32 ohne transparentsetzung zu erweitern x = 0 y = radius Repeat If ((radius - y) >= 0) For i = (radius - x) To (radius + x) farbe = (in(i, radius-y) | %11111111000000000000000000000000) Plot(i, radius-y, farbe) farbe = (in(i, radius+y) | %11111111000000000000000000000000) Plot(i, radius+y, farbe) Next For i = (radius - y) To (radius + y) farbe = (in(i, radius-x) | %11111111000000000000000000000000) Plot(i, radius-x, farbe) farbe = (in(i, radius+x) | %11111111000000000000000000000000) Plot(i, radius+x, farbe) Next EndIf; x = (x + 1) y = Sqr(Pow(radius - 1, 2) - Pow(x, 2)) Until (x > y) StopDrawing() EndIf ; auf endgröße bringen ResizeImage(img_transparent, 350, 350, #PB_Image_Smooth) img_klein = CopyImage(img_transparent, #PB_Any) ResizeImage(img_transparent, 350, 350, #PB_Image_Smooth) ResizeImage(img_klein, 190, 190, #PB_Image_Smooth) SaveImage(img_transparent, dateiname, #PB_ImagePlugin_PNG) dateiname = Left(dateiname, Len(dateiname) - 4) + "_k.png" SaveImage(img_klein, dateiname, #PB_ImagePlugin_PNG) EndProcedure ;################################################### ;## nutzer nach einem validen speicherpfad fragen ## ;################################################### Procedure.s get_save_path() Protected dateiname.s Protected ok.a = 0 Protected requester.l ; wiederholen bis valider speicherort Repeat ; nach speicherort fragen dateiname = SaveFileRequester(#programmname + " - Bild speichern", "", "PNG (*.png)|*.png", 0) ; dateiname ggf berichtigen If (GetExtensionPart(dateiname) <> "png") If (GetExtensionPart(dateiname) = "") dateiname = dateiname + ".png" Else dateiname = Left(dateiname, Len(dateiname) - Len(GetExtensionPart(dateiname))) + "png" EndIf EndIf ; existiert die datei bereits - nutzer informieren If ReadFile(#PB_Any, dateiname) If (#PB_MessageRequester_Yes = MessageRequester(#programmname, "Datei existiert bereits! Wollen Sie diese überschreiben?", #PB_MessageRequester_YesNo)) ok = 1 EndIf Else ok = 1 EndIf Until ok ProcedureReturn dateiname EndProcedure ;############################################ ;## Maximum aus a,b wird auf a gespeichert ## ;############################################ Macro max(a, b) If (a < b) a = b EndIf; EndMacro ;############################################ ;## Minimum aus a,b wird auf a gespeichert ## ;############################################ Macro min(a, b) If (a > b) a = b EndIf; EndMacro ;################################ ;## bitweise in rgb aufspalten ## ;################################ Macro hex_2_rgb(hex, farbe) farbe\r = hex hex >> 8 farbe\g = hex hex >> 8 farbe\b = hex EndMacro ;########################## ;## rgb in hsv umrechnen ## ;########################## Macro rgb_2_hsv(rgb_farbe, hsv_farbe) maximum = rgb_farbe\r max(maximum, rgb_farbe\g) max(maximum, rgb_farbe\b) minimum = rgb_farbe\r min(minimum, rgb_farbe\g) min(minimum, rgb_farbe\b) differenz = (maximum - minimum) If (maximum = 0) hsv_farbe\s = 0 Else hsv_farbe\s = ((differenz * 255) / maximum) EndIf; hsv_farbe\v = maximum EndMacro ;##################################################### ;## am rand fand keine faltung statt - auf 0 setzen ## ;##################################################### Macro randentfernung For i=0 To (hoehe - 1) k_b(i, 0) = 0 k_b(i, breite - 1) = 0 Next For j=1 To (breite - 2) k_b(0, j) = 0 k_b(hoehe - 1, j) = 0 Next EndMacro ;################################# ;## skelettierung nach lue wang ## ;################################# Macro lue_wang(a, b, c) c = c + ((a ! b) & b) EndMacro ;################################## ;## gefaltetes bild skelettieren ## ;################################## Macro skelettierung randentfernung k = 0 Repeat change = 0 For i=1 To (hoehe - 2) For j=1 To (breite - 2) b = (k_b(i-1, j-1) + k_b(i-1, j) + k_b(i-1, j+1) + k_b(i, j+1) + k_b(i+1, j+1) + k_b(i+1, j) + k_b(i+1, j) + k_b(i, j-1)) If ((b >= 3) And (b <= 6)) a = 0 lue_wang(k_b(i-1, j-1), k_b(i-1, j), a) lue_wang(k_b(i-1, j), k_b(i-1, j+1), a) lue_wang(k_b(i-1, j+1), k_b(i, j+1), a) lue_wang(k_b(i, j+1), k_b(i+1, j+1), a) lue_wang(k_b(i+1, j+1), k_b(i+1, j), a) lue_wang(k_b(i+1, j), k_b(i+1, j-1), a) lue_wang(k_b(i+1, j-1), k_b(i, j-1), a) lue_wang(k_b(i, j-1), k_b(i-1, j-1), a) If a = 1 If k If (Not(k_b(i-1, j) & k_b(i, j-1) & (k_b(i+1, j) | k_b(i, j+1)))) k_b(i, j) = 0; EndIf; Else If (Not(k_b(i+1, j) & k_b(i, j+1) & (k_b(i-1, j) | k_b(i, j-1)))) k_b(i, j) = 0 EndIf EndIf EndIf EndIf Next Next k = (k ! 1) Until (change = 0) EndMacro ;#################################################################### ;## bereiche mit rauschen entfernen, linien haben weniger elemente ## ;#################################################################### Macro entferne_rauschen For i = 0 To (hoehe - 1) Step 15 For j = 0 To (breite - 1) Step 15 If (((i + 16) > hoehe) Or ((j + 16) > breite)) For k = i To (hoehe - 1) For l = j To (breite - 1) k_b(k, l) = 0 Next Next Else zaehler = 0 For k = 0 To 14 For l = 0 To 14 zaehler = (zaehler + k_b(k + i, l + j)) Next Next If (zaehler > 65) For k = 0 To 14 For l = 0 To 14 k_b(k + i, l + j) = 0 Next Next EndIf EndIf Next Next EndMacro ;############################### ;## kleine Segmente entfernen ## ;############################### Macro entferne_rest For i=1 To (hoehe - 2) For j=1 To (breite - 2) If (k_b(i, j) = 1) k = counter(i, j) If(k < 250) delete(i,j) EndIf EndIf; Next Next EndMacro ;################################################################### ;## sucht die segmente und benennt die pixel mit dem segmentnamen ## ;################################################################### Macro segmentiere a = 10 For i = 0 To (hoehe - 1) For j = 0 To (breite - 1) If (k_b(i, j) = 2) name_segment(i, j, a) a = (a + 1) EndIf Next Next EndMacro ;######################## ;## mittelpunkt suchen ## ;######################## Macro behandle_punkt(i, j, a) For l = (i - #feld) To (i + #feld) If (a = k_b(l, j-#feld)) berechne_mittelpunkt(i, j, l, j-#feld) EndIf If (a = k_b(l, j+#feld)) berechne_mittelpunkt(i, j, l, j+#feld) EndIf Next For l = (j - (#feld - 1)) To (j + (#feld - 1)) If (a = k_b(i - #feld, l)) berechne_mittelpunkt(i, j, i-#feld, l) EndIf If (a = k_b(i + #feld, l)) berechne_mittelpunkt(i, j, i+#feld, l) EndIf Next EndMacro ;################################################################################# ;## für alle punkte die orthogonale eintragen, auf diesen liegt der mittelpunkt ## ;################################################################################# Macro mittelpunktsuche For i = #feld To (hoehe - (#feld + 1)) For j = #feld To (breite - (#feld + 1)) If (k_b(i, j) > 9) a = k_b(i, j) behandle_punkt(i, j, a) EndIf Next Next EndMacro ;## ;## ;## Macro avg_mittelpunkt Define maximum_m_b.w maximum_m_b = 0 q_i = 0 q_j = 0 k = 0 For i = 0 To (hoehe - 1) For j = #feld To (breite - 1) If (m_b(i, j) > maximum_m_b) maximum_m_b = m_b(i, j) EndIf Next Next For i = 0 To (hoehe - 1) For j = #feld To (breite - 1) If (m_b(i, j) >= (0.97 * maximum_m_b)) k = k + 1 q_i = q_i + i q_j = q_j + j EndIf Next Next If (k) avg_m_i = (q_i / k) avg_m_j = (q_j / k) Else avg_m_i = 0 avg_m_j = 0 EndIf EndMacro ;## ;## ;## Macro berechne_radien Dim k_a.l(hoehe/2) For i = 10 To (hoehe/2) k = Pow(i, 2) k_a(i) = k radien(k) = 0 Next For i = 0 To (hoehe - 1) For j = 0 To (breite - 1) If (k_b(i,j)) k = Pow((i - avg_m_i), 2) + Pow((j - avg_m_j), 2) If (k <= max_quad) radien(k) = (radien(k) + 1) EndIf EndIf Next Next max_k = 0 For i = 12 To ((hoehe/2) - 2) k = (radien(k_a(i-2)) + radien(k_a(i-1)) + radien(k_a(i)) + radien(k_a(i+1)) + radien(k_a(i+2))) If (k > max_k) max_k = k radius = i EndIf Next EndMacro Declare berechne_mittelpunkt(i.w, j.w, a.w, b.w) Declare name_segment(i.w, j.w, a.a) Declare delete(i.w, j.w) Declare.l counter(i.w, j.w) ;####################################################################### ;## gibt einen automatischen zuschnittrahmen aus - ändert rahmendaten ## ;####################################################################### Procedure auto_crop() Global breite.l Global hoehe.l Protected a.a Protected b.a Protected i.l Protected j.l Protected k.l Protected l.w Protected farbe.l Protected rgb_farbe.rgb Protected hsv_farbe.hsv Protected maximum.w Protected minimum.w Protected differenz.w Protected change.a Protected zaehler.l Protected q_i.q Protected q_j.q Protected avg_m_i.w Protected avg_m_j.w Protected max_quad.l Protected max_k.l Protected radius.l breite = ImageWidth(#bild) hoehe = ImageHeight(#bild) Protected Dim weiss_bild.a(hoehe, breite) Global Dim k_b.a(hoehe, breite) Global Dim m_b.w(hoehe, breite) ;auf 0 initialisieren For i = 0 To (hoehe - 1) For j = 0 To (breite - 1) m_b(i, j) = 0 Next Next ;bild einlesen, rgb in hsv umrechen und weise bereiche suchen StartDrawing(ImageOutput(#bild)) For i=0 To (hoehe - 1) For j=0 To (breite - 1) farbe = Point(j, i) hex_2_rgb(farbe, rgb_farbe) rgb_2_hsv(rgb_farbe, hsv_farbe) If ((hsv_farbe\s < 40) And (hsv_farbe\v > 135)) weiss_bild(i, j) = 8; Else weiss_bild(i, j) = 0; EndIf Next Next StopDrawing() ;falten For i=1 To (hoehe - 2) For j=1 To (breite - 2) If (Abs(8*weiss_bild(i,j) - weiss_bild(i-1,j-1) - weiss_bild(i-1,j) - weiss_bild(i-1,j+1) - weiss_bild(i,j+1) - weiss_bild(i+1,j-1) - weiss_bild(i+1,j) - weiss_bild(i+1,j+1) - weiss_bild(i,j-1))) k_b(i, j) = 1 EndIf Next Next skelettierung entferne_rauschen entferne_rest segmentiere mittelpunktsuche avg_mittelpunkt If ((avg_m_i) & (avg_m_j)) max_quad = (Pow((hoehe / 2), 2)) Protected Dim radien.l(max_quad + 1) berechne_radien radius = Round(radius * 0.985, #PB_Round_Nearest) ; neuen rahmen setzen If ((radius > 0) And (avg_m_j > 0) And (avg_m_i > 0)) rahmen\links = bildpos\links + avg_m_j - radius rahmen\rechts = bildpos\links + avg_m_j + radius rahmen\oben = bildpos\oben + avg_m_i - radius rahmen\unten = bildpos\oben + avg_m_i + radius ; prüfen, dass rahmen auf bild liegt ggf berichtigen If (rahmen\links < bildpos\links) rahmen\links = bildpos\links EndIf If (rahmen\rechts > bildpos\rechts) rahmen\rechts = bildpos\rechts EndIf If (rahmen\oben < bildpos\oben) rahmen\oben = bildpos\oben EndIf If (rahmen\unten > bildpos\unten) rahmen\unten = bildpos\unten EndIf MessageRequester(#programmname, "Automatische Auswahl ausgeführt!") Else MessageRequester(#programmname, "Die automatische Auswahl war leider nicht erfolgreich!") EndIf EndIf paint() EndProcedure ;## ;## ;## Procedure berechne_mittelpunkt(i.w, j.w, a.w, b.w) Define d_x.b Define d_y.b Define m_x.w Define m_y.w Define m.f Define x.f Define y.f Define z.w Define r.w d_x = (j - b) d_y = (i - a) m_x = ((j + b) / 2) m_y = ((i + a) / 2) If (Abs(d_x) < Abs(d_y)) ; bresenham antieg < 1 m = (-(d_x / d_y)) y = (m_y + 0.5 - (251 * m)) For z = (m_x - 250) To 0 Step -1 y = (y - m) r = y If ((r > 0) And (r < hoehe)) m_b(r, z) = (m_b(r, z) + 1) EndIf Next y = (m_y + 0.5 + (251 * m)) For z = (m_x + 250) To breite-1 y = (y + m) r = y If ((r > 0) And (r < hoehe)) m_b(r, z) = (m_b(r, z) + 1) EndIf Next Else ; bresenham anstieg > 1 m = (-(d_y / d_x)) x = (m_x + 0.5 - (251 * m)) For z = (m_y - 250) To 0 Step -1 x = (x - m) r = x If ((r > 0) And (r < hoehe)) m_b(z, r) = (m_b(z, r) + 1) EndIf Next x = (m_x + 0.5 + (251 * m)) For z = (m_y + 250) To hoehe-1 x = (x + m) r = x If ((r > 0) And (r < breite)) m_b(z, r) = (m_b(z, r) + 1) EndIf Next EndIf EndProcedure ;############################## ;## vergibt die segmentnamen ## ;############################## Procedure name_segment(i.w, j.w, a.a) Define nachbarn.b Repeat If (k_b(i, j)) k_b(i, j) = a EndIf nachbarn = 0 If (k_b(i-1, j) = 2) nachbarn = (nachbarn + 1) EndIf If (k_b(i+1, j) = 2) nachbarn = (nachbarn + 1) EndIf If (k_b(i, j-1) = 2) nachbarn = (nachbarn + 1) EndIf If (k_b(i, j+1) = 2) nachbarn = (nachbarn + 1) EndIf If (nachbarn = 1) If (k_b(i-1, j) = 2) i = (i - 1) ElseIf (k_b(i+1, j) = 2) i = (i + 1) ElseIf (k_b(i, j-1) = 2) j = (j - 1) ElseIf (k_b(i, j+1) = 2) j = (j + 1) EndIf ElseIf (nachbarn > 1) If (k_b(i-1, j) = 2) name_segment(i-1, j, a) EndIf If (k_b(i+1, j) = 2) name_segment(i+1, j, a) EndIf If (k_b(i, j-1) = 2) name_segment(i, j-1, a) EndIf If (k_b(i, j+1) = 2) name_segment(i, j+1, a) EndIf EndIf Until (nachbarn <> 1) EndProcedure ;############################################ ;## zählt die größe der einzelnen segmente ## ;############################################ Procedure.l counter(i.w, j.w) Define anzahl.l Define nachbarn.b anzahl = 0 Repeat If (k_b(i, j) = 1) anzahl = (anzahl + 1) k_b(i, j) = 2 EndIf nachbarn = (k_b(i-1, j) + k_b(i+1, j) + k_b(i, j-1) + k_b(i, j+1)) If (nachbarn = 1) If (k_b(i-1, j)) i = (i - 1) ElseIf (k_b(i+1, j)) i = (i + 1) ElseIf (k_b(i, j-1)) j = (j - 1) ElseIf (k_b(i, j+1)) j = (j + 1) EndIf ElseIf (nachbarn > 1) If (k_b(i-1, j) = 1) anzahl = anzahl + counter(i-1, j) EndIf If (k_b(i+1, j) = 1) anzahl = anzahl + counter(i+1, j) EndIf If (k_b(i, j-1) = 1) anzahl = anzahl + counter(i, j-1) EndIf If (k_b(i, j+1) = 1) anzahl = anzahl + counter(i, j+1) EndIf EndIf Until (nachbarn <> 1) ProcedureReturn anzahl EndProcedure Procedure delete(i.w, j.w) Define nachbarn.b Repeat If (k_b(i, j)) k_b(i, j) = 0 EndIf nachbarn = (k_b(i-1, j) + k_b(i+1, j) + k_b(i, j-1) + k_b(i, j+1)) If (nachbarn = 1) If (k_b(i-1, j)) i = (i - 1) ElseIf (k_b(i+1, j)) i = (i + 1) ElseIf (k_b(i, j-1)) j = (j - 1) ElseIf (k_b(i, j+1)) j = (j + 1) EndIf ElseIf (nachbarn > 1) If (k_b(i-1, j)) delete(i-1, j) EndIf If (k_b(i+1, j)) delete(i+1, j) EndIf If (k_b(i, j-1)) delete(i, j-1) EndIf If (k_b(i, j+1)) delete(i, j+1) EndIf EndIf Until (nachbarn <> 1) EndProcedure ;####################################### ;## behandelt das übergebene ereignis ## ;####################################### Procedure.a event_handler(event.l) #MY_MOUSE_MOVE = 512 #MY_MOUSE_LEFT_DOWN = 513 #MY_MOUSE_LEFT_UP = 514 Protected repaint.a = 0 Protected dateiname.s Protected d_x.l Protected d_y.l Select event ;####################### Case #PB_Event_Repaint clear() paint() ;####################### Case #PB_Event_Menu Select EventMenu() ; laden geklickt Case #menu_item_laden ; dateiauswahldialog dateiname = OpenFileRequester(#programmname + " - Bild laden", "", "Foto (*.jpg)|*.jpg|Foto(*.jpeg)|*.jpeg|Foto (*.JPG)|*.JPG|Foto (*.JPEG)|*.JPEG|", 0) If load_image(dateiname) image_present = 1 new_bild_data() new_bild_rahmen() clear() paint() EndIf ; speichern geklickt Case #menu_item_auto_crop If image_present auto_crop() EndIf Case #menu_item_speichern If image_present dateiname = get_save_path() save_image(dateiname) image_present = 0 clear() EndIf EndSelect ;####################### Case #MY_MOUSE_LEFT_DOWN move_links = 0 move_rechts = 0 move_oben = 0 move_unten = 0 If image_present ; je nach mausposition andere aktion If ((rahmen\links <= WindowMouseX(#fenster)) And (rahmen\rechts >= WindowMouseX(#fenster)) And (rahmen\oben <= WindowMouseY(#fenster)) And (rahmen\unten >= WindowMouseY(#fenster))) ; links If (WindowMouseX(#fenster) <= (rahmen\links + #rahmen_size)) move_links = 1 EndIf ; rechts If (WindowMouseX(#fenster) >= (rahmen\rechts - #rahmen_size)) move_rechts = 1 EndIf ; oben If (WindowMouseY(#fenster) <= (rahmen\oben + #rahmen_size)) move_oben = 1 EndIf ; unten If (WindowMouseY(#fenster) >= (rahmen\unten - #rahmen_size)) move_unten = 1 EndIf aktion = #move maus_x = WindowMouseX(#fenster) maus_y = WindowMouseY(#fenster) EndIf EndIf Case #MY_MOUSE_LEFT_UP aktion = #none Case #MY_MOUSE_MOVE If (aktion = #move) d_x = WindowMouseX(#fenster) - maus_x d_y = WindowMouseY(#fenster) - maus_y If (move_links Or move_rechts Or move_oben Or move_unten) If move_links rahmen\links = rahmen\links + d_x EndIf If move_rechts rahmen\rechts = rahmen\rechts + d_x EndIf If move_oben rahmen\oben = rahmen\oben + d_y EndIf If move_unten rahmen\unten = rahmen\unten + d_y EndIf Else rahmen\links = rahmen\links + d_x rahmen\rechts = rahmen\rechts + d_x rahmen\oben = rahmen\oben + d_y rahmen\unten = rahmen\unten + d_y EndIf ; bild nicht verlassen If (rahmen\links < bildpos\links) rahmen\links = bildpos\links aktion = #none EndIf If (rahmen\rechts > bildpos\rechts) rahmen\rechts = bildpos\rechts aktion = #none EndIf If (rahmen\oben < bildpos\oben) rahmen\oben = bildpos\oben aktion = #none EndIf If (rahmen\unten > bildpos\unten) rahmen\unten = bildpos\unten aktion = #none EndIf ; rahmenbeeiche für die maus nicht überschneiden oder invertieren lassen If (rahmen\links > (rahmen\rechts - 2 * #rahmen_size - 2)) rahmen\links = (rahmen\rechts - 2 * #rahmen_size - 2) aktion = #none EndIf If (rahmen\rechts < (rahmen\links + 2 * #rahmen_size + 2)) rahmen\rechts = (rahmen\links + 2 * #rahmen_size + 2) aktion = #none EndIf If (rahmen\oben > (rahmen\unten - 2 * #rahmen_size - 2)) rahmen\oben = (rahmen\unten - 2 * #rahmen_size - 2) aktion = #none EndIf If (rahmen\unten < (rahmen\oben + 2 * #rahmen_size + 2)) rahmen\unten = (rahmen\oben + 2 * #rahmen_size + 2) aktion = #none EndIf maus_x = WindowMouseX(#fenster) maus_y = WindowMouseY(#fenster) repaint = 1 EndIf EndSelect ProcedureReturn repaint EndProcedure ;################### ;## hauptprogramm ## ;################### Procedure main() Protected event.l Protected repaint.a If OpenWindow(#fenster, 0, 0, 800, 600, #programmname, #PB_Window_Maximize|#PB_Window_MinimizeGadget|#PB_Window_SystemMenu|#PB_Window_TitleBar|#PB_Window_MaximizeGadget|#PB_Window_SizeGadget) If CreateMenu(#menu, WindowID(#fenster)) MenuItem(#menu_item_laden, "Bild laden") MenuItem(#menu_item_auto_crop, "automatische Auswahl") MenuItem(#menu_item_speichern, "Bild speichern") ; auf ereignisse warten und behandeln lassen clear() Repeat event = WaitWindowEvent() While ((event) And (event <> #PB_Event_CloseWindow)) repaint = event_handler(event) If (repaint) paint() EndIf event = WindowEvent() Wend Until event = #PB_Event_CloseWindow EndIf EndIf EndProcedure ; für das laden von jpg-bildern UseJPEGImageDecoder() UsePNGImageEncoder() main() ; IDE Options = PureBasic 5.10 Beta 2 (Windows - x64) ; CursorPosition = 2 ; Folding = ------ ; EnableXP ; Executable = zuschneider_x64.exe ; EnableCompileCount = 121 ; EnableBuildCount = 4