Dialog Ausschneiden (VBS)

Der Dialog gehört zu den Multidialogen. Er wird aufgerufen mit:

FF_MultiDialog "MultiCanvas",2

Um eine Information über den Ablauf zu erhalten, beispielsweise ob der Dialog abgebrochen wurde, kann der Dialog auch wie folgt aufgerufen werden:

  Dim Antwort
 
  Antwort = FF_MultiDialog ("MultiCanvas",2)
  if Antwort < 0 then
      msgbox "Das Bild wurde nicht beschnitten!",vbInformation,"Hinweis"
  end if

Die genauen Rückgabewerte sind:

1. 1 = nichtspezifizierter Fehler
2. 2 = Abbruch

Will man Schnittmarken vorgeben, ist das und weiteres mit FF_SetParam möglich:

  Dim Antwort,Array
 
  Dim SchnittabstandX,SchnittabstandY
  Dim Schnittbreite,Schnitthoehe
  Dim Bildbreite,Bildhoehe
  Dim Markierung,Proportional
 
  'Beispielswerte
  Schnittbreite      = 800
  Schnitthoehe       = 600
  Bildbreite         = FF_GetImageWidth
  Bildhoehe          = FF_GetImageHeight
  Markierung         = 0        'Erläuterung siehe unten '### Markierungsauswahl
  Proportional       = 1        '0 bedeutet 'nicht proportional'
 
  '### Markierungsauswahl (bis Version 3.02.24 - nur zur Erläuterung):
  '0 - Markierung "Aus", Beschnitt nicht proportional (hier nicht zulässig)
  '1 - Markierung "Goldener Schnitt", Beschnitt proportional
  '2 - Markierung "Drittel", Beschnitt proportional
  '3 - Markierung "Deutschland ab 10", Beschnitt proportional
  '4 - Markierung "Deutschland bis 9", Beschnitt proportional
  '5 - Markierung "Aus", Beschnitt proportional
 
  '### Markierungsauswahl (ab Version 3.02.25 - nur zur Erläuterung):
  '0 - Markierung "Aus"
  '1 - Markierung "Goldener Schnitt"
  '2 - Markierung "Goldene Spirale l. ob."
  '3 - Markierung "Goldene Spirale r. ob."
  '4 - Markierung "Goldene Spirale r. un."
  '5 - Markierung "Goldene Spirale l. un."
  '6 - Markierung "Drittel"
  '7 - Markierung "Deutschland ab 10"
  '8 - Markierung "Deutschland bis 9"
 
  'Berechnung der Schnittabstände, wenn die Markierung mittig sein soll
  SchnittabstandX    = int((Bildbreite - Schnittbreite) / 2)    '| erst ab Version 3.10.23 kann der Schnittabstand als x- und y-Wert vorgegeben werden
  SchnittabstandY    = int((Bildhoehe - Schnitthoehe) / 2)      '| bis dahin werden die Schnittmarkierungen immer mittig angeordnet
 
  'Beschnitt
  FF_SetParam SchnittabstandX & "," & SchnittabstandY & "," & Schnittbreite & "," & _
              Schnitthoehe & "," & Bildbreite & "," & Bildhoehe & "," & Markierung & "," & Proportional
  Antwort = FF_MultiDialog ("MultiCanvas",2)
  if Antwort < 0 then
      msgbox "Das Bild wurde nicht beschnitten!",vbInformation,"Hinweis"
  else
      msgbox "Das Bild wurde erfolgreich beschnitten!",vbInformation,"Hinweis"
      FF_Reload
  end if
 
  'Ermittlung der benutzten Markierung
  Array = split(FF_GetParam,",")
  Markierung = Array(6)
  msgbox "Der benutzte Markierungscode ist " & Markierung,vbInformation,"Hinweis"

Nach Durchführung des Beschnitts kann man mit FF_GetParam die benutzten Einstellungen des Dialogs ermitteln, z.B. welche Markierung verwendet wurde (siehe Ende des Beispielcodes).

Ein Problem mit dem Dialog Ausschneiden gibt es, wenn ein querformatiger Beschnitt bei einem hochformatigen Bild oder ein hochformatiger Beschnitt bei einem querformatigen Bild erfolgen soll. Schnittbreite und Schnitthöhe müssen dann vertauscht werden und der Benutzer muss darauf hingewiesen werden, dass er im Dialog die Taste "Hoch/Quer" betätigen muss.

Der Tausch und der Hinweis kann durch folgenden Code erzeugt werden, der vor dem Absatz

  'Beschnitt
eingefügt werden muss:
 
  'wenn Hochformat aus Querformat oder Querformat aus Hochformat geschnitten werden soll
  if (Schnittbreite > Schnitthoehe) Xor (Bildbreite > Bildhoehe) then
      'Tausch
      Dim B_temp
      B_temp = Schnittbreite
      Schnittbreite = Schnitthoehe
      Schnitthoehe = B_temp
      'Hinweis
      msgbox "Bitte im folgenden Dialog die Taste 'Hoch/Quer' betätigen!",vbInformation,"Unbedingt beachten!"
  end if

Dieses Problem ist lt. JKS historisch auf eine Forderung der Forumsmitglieder zurück zu führen (siehe Antwort von JKS).

Bis zu einer Lösung kann der Trick angewendet werden die Bildfläche bei Bedarf so zu vergrößern, dass das Bildformat dem Schnittformat entspricht. Dafür wird das Bild zur Erzeugung eines Hochformats nach unten oder zur Erzeugung eines Querformats nach rechts erweitert. Der Code sieht dann so aus:

  Dim Antwort,Array
 
  Dim SchnittabstandX,SchnittabstandY
  Dim Schnittbreite,Schnitthoehe
  Dim Bildbreite,Bildhoehe
  Dim Markierung,Proportional
 
  'Beispielswerte
  Schnittbreite    = 800
  Schnitthoehe    = 600
  Bildbreite        = FF_GetImageWidth
  Bildhoehe        = FF_GetImageHeight
  Markierung        = 0        'Erläuterung siehe oben '### Markierungsauswahl
  Proportional    = 1        '0 bedeutet 'nicht proportional'
 
  'Berechnung der Schnittabstände, wenn die Markierung mittig sein soll
  SchnittabstandX    = int((Bildbreite - Schnittbreite) / 2)    '| erst ab Version 3.10.23 kann der Schnittabstand als x- und y-Wert vorgegeben werden
  SchnittabstandY    = int((Bildhoehe - Schnitthoehe) / 2)    '| bis dahin werden die Schnittmarkierungen immer mittig angeordnet
 
  'wenn Hochformat aus Querformat oder Querformat aus Hochformat geschnitten werden soll,
  'wird das Bild um eine rote Fläche so erweitert, dass das Bildformat dem Schnittformat entspricht.
  if (Schnittbreite > Schnitthoehe) Xor (Bildbreite > Bildhoehe) then
      msgbox "Im folgenden Dialog die rote Erweiterungsfläche nicht in den Schnitt einbeziehen!",vbExclamation,"Hinweis"
      if (Schnittbreite > Schnitthoehe) then
          FF_ExtendCanvas 0,Bildhoehe-Bildbreite+1,0,0,255,0,0
          Bildbreite = Bildhoehe+1
      else
          FF_ExtendCanvas 0,0,0,Bildbreite-Bildhoehe+1,255,0,0
          Bildhoehe = Bildbreite+1
      end if
  end if
 
  'Beschnitt
  FF_SetParam SchnittabstandX & "," & SchnittabstandY & "," & Schnittbreite & "," & _
              Schnitthoehe & "," & Bildbreite & "," & Bildhoehe & "," & Markierung & "," & Proportional
  Antwort = FF_MultiDialog ("MultiCanvas",2)
  if Antwort < 0 then
      msgbox "Das Bild wurde nicht beschnitten!",vbInformation,"Hinweis"
  else
      msgbox "Das Bild wurde erfolgreich beschnitten!",vbInformation,"Hinweis"
      FF_Reload
  end if
 
  'Benutzte Markierung nach dem Beschneiden ermitteln:
  Array = split(FF_GetParam,",")
  Markierung = Array(6)
  msgbox "Der benutzte Markierungscode ist " & Markierung,vbInformation,"Hinweis"

Leider gibt es noch ein Problem mit quadratischen Ausschnitten (siehe dazu diese Fehlermeldung )