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 = nichtspezifizierter Fehler
-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 )