Zoom per Mausrad

[d'r Bastler]

Moin nochmal,

inzwischen konnte ich feststellen, dass die Scrollbar tatsächlich nicht auf's Mausrad reagierten mag, aber auf Linke Maustaste + Trackball = Mausbewegung.

Und wenn man noch folgenden Code (und natürlich ein Drehfeld) einbaut und die Schrittweite anpasst, dürfte sich in kombinierter Nutzung beider Controls eine lustige Lösung ergeben:

Code: Alles auswählen

Private Sub SpinButton1_SpinDown()
Dim iZoom As Integer
If Frame1.Zoom > 49 Then Exit Sub
Frame1.Zoom = Frame1.Zoom + 5
Debug.Print Frame1.Zoom
End Sub

Private Sub SpinButton1_SpinUp()
Dim iZoom As Integer
On Error Resume Next
Frame1.Zoom = Frame1.Zoom - 5
End Sub

Liebe Grüße!

[Nanu]

Hola Erwin, Hola Bastler,
ich werde beides ausprobieren und dann Rückmeldung geben. Super wie ihr euch für meine Spielereien einsetzt.
Muchisimas gracias
Saludos Nanu

[Wisi82]

Hallo zusammen

erst einmal Grüße in die zentral-amerikanische und zentral-eurpoäische Schweiz

Grüsse zurück )

@ Bastler:
Wenn ich deine Post's lese, bekomme ich den Eindruck, dass du dir nicht die Mühe gemacht hast meine Lösung anzuschauen. Da habe ich nämlich ziemlich genau das was du beschreibst bereits gebaut, Folgendes Unterscheidet deine von meiner Version:

- Die Grösse der Userform ist bei mir nicht fix definiert, sondern Variabel inzwischen auf Basis der Eingabe in einer Tabelle
(Bei V1 noch abhängig vom Zoomfaktor)
Die Rahmengrösse und alles andere was sich auf der Userform befindet, wird an die gewählte Fenstergrösse angepasst.

- Ich habe den Anker nicht zentriert gewählt, sondern oben links.
Grund: so können die Scrollleisten von Frame verwendet werden, Falls der Zoom die Rahmengrösse übersteigt, deinen Ansatz habe ich auch getestet, da gibt es Riesenprobleme, wenn das Bild grösser als die Framegrösse angezeigt wird, ich habe es zumindest nicht geschafft, die Scrollleisten vom Rahmen so einzustellen, dass der Teil des Bildes, welcher über den linken Rand hinaus ragen würde, noch angezeigt werden kann.

- Der Zoomfaktor ist bei dir 100% - 200%, bei mir 10% 400%
Bei mir sind im Code die Werte so Festgelegt wie der maximale Zoombereich von einen Rahmen (können jederzeit angepasst werden)

- Das Drehfeld habe ich auch ausprobiert, aber als nicht praktikabel befunden
Ich kann zum selben Zweck auch einfach auf die Scrollbar klicken, oder die Scrollbar 1x anklicken und mit den Peiltasten jeweils einen Schritt machen.

-Bei mir gibt es zusätzlich 3 Buttons, über welche jeweils direkt ein bestimmter Zoomfaktor eingestellt werden kann, in meinem Beispiel 100%, 150%, 200%.

wäre schön, wenn wir an einer gemeinsamen Lösung arbeiten könnten, anstelle von zwei fast gleichen Varianten parallel.
Mit deinem Wissen, könntest du meinen Ansatz bestimmt noch verbessern.

Meine neuste Variante (noch nicht veröffentlicht ) enthält noch ein Textfeld, in welchem der gewünschte Zoomfaktor direkt eingetragen werden kann.

Und sollte auch über zwei Userforms funktionieren ... aber wozu das?

Ich könnte mir Beispielsweise vorstellen, in einer Userform auszuwählen, welches Bild angezeigt werden soll, und dieses dann in das entsprechende Zoomfenster zu laden.

Beste Grüsse aus der Schweiz
Erwin

[Wisi82]

Hallo alle miteinander

Hier noch die angeteaserte Erweiterung um eine Textbox zur Eingabe des Zoomfaktors:

Als erstes habe in der Userform von Zoomfenster_V2.xlsb eine Textbox mit folgenden Eigenschaften erstellt:
Name: TextBox1
Font: Schriftgrad: 10
Height: 18
Left: 366
MaxLength: 3
Top: 318
Width: 36

Dann habe die Initialisierungs-Routine angepasst.
An der Initialisierungs-Routine habe ich 3 Zeilen hinzugefügt und ein paar Zeilen anders angeordnet. Die neuen Zeilen habe ich hier mit einen * markiert (beim kopieren * entfernen).
Sie sieht inzwischen so aus:

Code: Alles auswählen

Private Sub UserForm_Initialize()
    UserForm1.Height = Tabelle1.Cells(2, 5)     'Fensterhöhe aus Tabellenwert definieren
    UserForm1.Width = Tabelle1.Cells(2, 6)      'Fensterbreite aus Tabellenwert definieren
    Scrollbar1.Width = UserForm1.Width - 10     'Schiebebalken Breite anpasssen
    Scrollbar1.Top = UserForm1.Height - 46.5    'Schiebebalken Position senkrecht anpassen
    Label1.Top = Scrollbar1.Top - 18            'Label1 Position senkrecht anpassen
    Label1.Left = (UserForm1.Width - Label1.Width) / 2        'Label1 Position waagrecht anpassen
    Button100.Top = Label1.Top                  'Button100 Position senkrecht anpassen
    Button150.Top = Label1.Top                  'Button150 Position senkrecht anpassen
    Button200.Top = Label1.Top                  'Button200 Position senkrecht anpassen
  * TextBox1.Top = Label1.Top                   'Textbox 1 Position senkrecht anpassen
  * TextBox1.Left = UserForm1.Width - TextBox1.Width - 24       'Textbox1 Position waagrecht anpassen
    Frame1.Height = Label1.Top                  'Rahmenhöhe anpassen
    Frame1.Width = Scrollbar1.Width             'Rahmenbreite anpassen
    Image1.Height = Frame1.Height - 16          'Bildhöhe anpassen
    Image1.Width = Frame1.Width - 16            'Bildbreite anpassen
    
    Scrollbar1.Value = 100                      'Startwert für Schiebebalken definieren
    Scrollbar1.Min = 10                         'Mindestwert für Schiebebalken definieren
    Scrollbar1.Max = 400                        'Maximalwert für Schiebebalken definieren
    Label1.Caption = Scrollbar1.Value & "%"     'aktueller Wert wird in Beschriftung eintragen
  * TextBox1.Value = Scrollbar1.Value           'aktueller Wert wird in Textbox1 eintragen
End Sub

Die «Scrollbar1_Change()» Routine habe ich mit folgender Zeile als vierte Zeile dieser Routine ergänzt:

Code: Alles auswählen

    TextBox1.Value = Scrollbar1.Value               'aktueller Wert wird in Textbox eintragen

Ausserdem muss noch die folgende Routine komplett eingefügt werden:

Code: Alles auswählen

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)    'wird ausgelöst beim verlassen von Textbox1
    On Error GoTo Err_Handler
    Dim Fehlermeldung As String
    
    'Prüfen ob ein gültiger Wert in die Textbox eingegeben wurde
    If IsError(CLng(TextBox1.Value)) = True _
        Or TextBox1.Value < Scrollbar1.Min _
        Or TextBox1.Value > Scrollbar1.Max _
    Then
        GoTo Falscheingabe
    Else
        Scrollbar1.Value = TextBox1.Value       'Zoom anpassen
    End If
Exit Sub

Falscheingabe:
    'Fehlermeldung als Variable setzen:
    Fehlermeldung = "Der gewünschte Wert muss als" & vbCrLf & _
    "Ganzzahl eingegeben werden !" & vbCrLf & _
    vbCrLf & _
    "Minimum:   " & Scrollbar1.Min & vbCrLf & "Maximum: " & Scrollbar1.Max
    
    MsgBox Fehlermeldung, vbExclamation, "Ungültige Eingabe" 'Messagebox wird ausgegeben
    TextBox1.Value = Scrollbar1.Value           'Wert in Textbox wird zurückgesetzt
    Exit Sub                                    'Code wird beendet

Err_Handler:
    Select Case Err.Number
    Case 13                     'Es wurde keine Ganzzahl eingegeben
        GoTo Falscheingabe
    Case Else
        'Messagebox wird ausgegeben
        MsgBox "Fehler Nr. " & Err.Number & " wurde ausgelöst!" & vbCrLf & _
                "Bitte Administrator Informieren", vbCritical, "Unbekannter Fehler"
        TextBox1.Value = Scrollbar1.Value           'Wert in Textbox wird zurückgesetzt
        Exit Sub                                    'Code wird beendet
    End Select
End Sub

wenn dies alles erledigt war, habe ich die Datei «Zoomfenster_V2.1.xlsb» genannt.

Viel Spass beim einbasteln.

Mit freundlichen Grüssen Erwin

[d'r Bastler]

Moin Erwin!

@13 Nicht getestet ...

Du hast Recht. Ich bitte das meines schon erwähnten Zeitmangels zu entschuldigen.

Grüße

[Wisi82]

Hallo Bastler

Du brauchst dich dafür nicht zu entschuldigen, aber bei deinem Zeitmangel hättest du hier einiges an Zeit sparen können

verschlafene Grüsse Erwin

[Nanu]

Hola Erwin,
ich habe gerade mit Erfolg deinen "V2" Code in mein Programm eingebaut und bin begeistert.
Und schon muss ich es wieder ändern
Vielen Dank für die tolle Arbeit und die Zeit die du in meine Spielerei investierst,
Saludos Nanu.

[Wisi82]

Hallo Nanu

Freut mich dass du mein Gebastel verwenden und dies sogar in deine bestehende Datei integrieren konntest.

Nein du musst nicht schon wieder ändern, deine Version funktioniert ja schliesslich.
Falls du jedoch in den Genuss der Zusatzfunktion "Textbox um Zoomfaktor einzustellen" kommen willst, dann kannst du die kleine Anpassung noch in Angriff nehmen

Hab ich gern gemacht. Ausserdem hatte ich Spass daran und mal wieder einiges gelernt.

verregnete Grüsse Erwin