Schnelles Drag & Zoom ohne Fokus Verlusst

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
GlassJoe
Beiträge: 108
Registriert: 11.06.2017 20:25
Computerausstattung: 2 x AMD Phenom II x4 945,2x Dell Latitude X300, Dell Latitude D410, Hp Compaq NC4400

Schnelles Drag & Zoom ohne Fokus Verlusst

Beitrag von GlassJoe »

War die Hölle das ohne Hilfe hinzukriegen. Das erste mal hab ich vor fast 4 Jahren herum probiert.

Ich schätze weil ich mich erst mit dem beknackten lahmen ScrollArea Gadget (der 90% der Zeit) herum geschlagen habe, komme ich ingesammt auf 3 Monate (nicht 90 Tage mit schlappen 2 Std hier und da oder so. Alles zusammen genommen locker 2000+ Std) in diesen ca 4 Jahren, in denen ich zum Teil 18 Std am Stück nichts anderes probiert habe, als einen Zoom hinzukriegen der nicht abdriftet, keine Ahnung warum aber mit Sprites und die - Start Positionen die Sprites erlauben komme ich viel besser klar (hat nur ne Woche damit gedauert)

Code sollte mit jeder Größe die PB verarbeiten kann, und die nicht zu winzig ^^ ist funzen.

Irgendwohin scrollen, drauf achten wo der kleine Popel vom Scrollbalken ist, zoomen, und siehe da der beknackte Balken und der Fokus (z.B die Mitte eines Apfels) bleibt wo er soll (im Gegensatz zu diesem verfluchten ScrollAreaGadget das mich fast um den Verstand gebracht hat, mit seinem eigenständigen Verhalten :bluescreen: ) egal ob weit innen oder aussen im Bild, egal ob Hochkant, Quer oder Quadratisches Bild, daß abdriften ist minimal.

Am besten merkt mann bei einem rechteckigen Bild im oberen linken Viertel was ich mit nicht abdriften meine.

Wer Wissen will wie nervig das Abdriften sein kann, kann ja mal in Zeile 298 & 299 (oder so)

das

Code: Alles auswählen

BorderL + BorderWQuarter - AbschlagX
BorderU + BorderHQuarter - AbschlagY ;/ Immer BorderL + BorderWQuarter - AbschlagX
zu

Code: Alles auswählen

BorderL = BorderWQuarter - AbschlagX
BorderU = BorderHQuarter - AbschlagY
ändern.

Genug geredet, hier der Code.

Code: Alles auswählen

If InitSprite() = 0
    MessageRequester("Error", "Can't open screen & sprite environment!", 0)
    End
  EndIf
 
  UseJPEGImageDecoder()
  UsePNGImageDecoder()
  UseGIFImageDecoder()
  UseTIFFImageDecoder()
 
  Enumeration ;/ GADGETS
    #XBar
    #YBar
    #Z_IN
    #Z_OUT
    #MidX
    #MidY
    #CenterAll
    #ResetZoom
  EndEnumeration
 
  Enumeration ;/ WIN
    #MainWin
  EndEnumeration
 
  Enumeration ;/ Images
    #OrigPic
    #ResPic
  EndEnumeration
 
  Procedure.S CalcImageSize(ProtTmpPic.i,MaximumW,MaximumH,JustCalcNoIMGInput = #False, IMG_XW = 0, IMG_XH = 0)
   
    Debug ""
    Debug "-->COMMAND=CalcImageSize()"
   
    If JustCalcNoIMGInput
      IMG_W = IMG_XW : IMG_H = IMG_XH
      Debug "USE W & H INPUT"
    Else
      IMG_W = ImageWidth(ProtTmpPic) : IMG_H = ImageHeight(ProtTmpPic) 
    EndIf
   
    Debug "ProtTMPPic="+ProtTmpPic
   
    Debug "IMG_W @ ProtTmpPic="+IMG_W+" | IMG_H @ ProtTmpPic="+IMG_H
    Debug "Max Border W="+MaximumW+" | Max Border H="+MaximumH
   
   
    If IMG_W > IMG_H
     
      ;Debug "BILD -> BREITER ALS HÖHER"
     
      ASPECT.f=IMG_W/IMG_H
      ; Debug "ASPECT RATIO" : Debug ASPECT
      ;
      New_H=MaximumW/ASPECT
      ;
      ; Debug "MAXIMUM WIDTH"
      ; Debug MaximumW
      ;
      ; Debug "NEW HEIGHT"
      ; Debug New_H
      ;
      If New_H > MaximumH
       
        Differenz=New_H-MaximumH
       
        New_H=New_H-Differenz
        New_W=MaximumW-Differenz
       
        ; Debug "NEUE HÖHE IST HÖHER ALS DER RAHMEN"
        ; Debug "DIFFERENZ="+Str(Differenz)
        ;
        ; Debug "NEUE MASSE NACH DER DIFFERENZ BERECHNUNG"
        ; Debug "W"+Str(New_W)+"xH"+Str(New_H)
      Else
        New_W=MaximumW
      EndIf
     
      ;Debug "--RETURN FROM CalcImageSize()"
     
      ProcedureReturn Str(New_W)+":"+Str(New_H)
     
    ElseIf IMG_W < IMG_H
     
      ;Debug "BILD -> HÖHER ALS BREITER"
     
      ;Debug "MAXIMUM HEIGHT"
      ;Debug MaximumH
      ;
     
      ASPECT.f=IMG_H/IMG_W
      ;Debug "ASPECT RATIO" : Debug ASPECT
     
      New_W=MaximumH/ASPECT
     
      ;Debug "MAXIMUM HEIGHT"
      ;Debug MaximumH
      ;
      ;Debug "NEW WIDTH"
      ;Debug New_W
     
      If New_W > MaximumW
        Differenz=New_W-MaximumW
       
        New_W=New_W-Differenz
        New_H=MaximumH-Differenz
       
        ;Debug "NEUE BREITE IST BREITER ALS DER RAHMEN"
        ;Debug "DIFFERENZ="+Str(Differenz)
        ;
        ;Debug "NEUE MASSE NACH DER DIFFERENZ BERECHNUNG"
        ;Debug "W"+Str(New_W)+"xH"+Str(New_H)
      Else
        New_H=MaximumH
        ;Debug "JOA="+New_H
      EndIf
     
      ;Debug "--RETURN FROM CalcImageSize()"
     
      ProcedureReturn Str(New_W)+":"+Str(New_H)
     
    Else
     
      ;Debug "BILD -> HAT SELBE HÖEHE UND BREITE"
     
      If MaximumW > MaximumH
        ;Debug "RAHMEN BREITER ALS HOCH"
       
        ;Debug "--RETURN FROM CalcImageSize()" 
        ProcedureReturn Str(MaximumH)+":"+Str(MaximumH)
       
      ElseIf MaximumW < MaximumH
        ;Debug "RAHMEN HÖHER ALS BREIT"
        ;Debug "--RETURN FROM CalcImageSize()" 
        ProcedureReturn Str(MaximumW)+":"+Str(MaximumW)
      Else
        ; Debug "RAHMEN BREITE = HÖHE"
        ;Debug "--RETURN FROM CalcImageSize()" 
        ProcedureReturn Str(MaximumW)+":"+Str(MaximumH)
      EndIf
     
    EndIf
   
  EndProcedure
 
  Procedure MouseFollow(egal)
   
    Shared MouseFollow
   
    Debug ""
    Debug "-->COMMAND=MouseFollow()"
   
    src_mx = WindowMouseX(#MainWin) : src_my = WindowMouseY(#MainWin) 
    src_x = GetGadgetState(#XBar) : src_y = GetGadgetState(#YBar)
   
    Debug "src_x (VOR MouseMove)="+src_x
    Debug "src_y (VOR MouseMove)="+src_y   
   
    Repeat
     
      mx = WindowMouseX(#MainWin) : my = WindowMouseY(#MainWin)
     
      If mx <> -1 And my <> -1
       
        If src_mx <> mx Or src_my <> my
         
          If mx > src_mx
            diff_x = mx - src_mx
            SetGadgetState(#XBar,src_x - diff_x)
          ElseIf mx < src_mx
            diff_x = src_mx - mx
            SetGadgetState(#XBar,src_x + diff_x)
            ;Else ; Nicht benutzen sonst gibt es ein kurzes Flimmern
           
          EndIf
         
          If my > src_my
            diff_y = my - src_my
            SetGadgetState(#YBar,src_y - diff_y) 
          ElseIf my < src_my
            diff_y = src_my - my
            SetGadgetState(#YBar,src_y + diff_y)
            ;Else ; Nicht benutzen sonst gibt es ein kurzes Flimmern
           
          EndIf 
         
        EndIf
       
      Else
        MouseFollow = 0
        Break
      EndIf 
     
      Delay(5) ; 10 Ist selbst auf dem alten Dell 1,2GHZ Optimal
     
    Until MouseFollow = 0 
   
    Debug "EXIT MOUSE FOLLOW"   
   
  EndProcedure
 
  Procedure AntiBullShit(XP,YP)
   
    Shared CenterX, CenterY, IMG_W, IMG_H, BorderW, BorderH
   
    ; Wir übermalen den Bullshit der am ""Rand"" entsteht
   
    If XP < CenterX
      diff_x = CenterX - XP
      Box(0, 0 , diff_x, BorderH,0)   
    ElseIf XP > CenterX
      diff_x = XP - CenterX
      Box(IMG_W - diff_x ,0, diff_x, BorderH,0)
    EndIf
   
    If YP < CenterY 
      diff_y = CenterY - YP
      Box(0,0, BorderW, diff_y,0)
    ElseIf YP > CenterY 
      diff_y = YP - CenterY 
      Box(0, IMG_H - diff_y ,BorderW, diff_y,0)
    EndIf
   
  EndProcedure
 
  Procedure BindScrollDatas()
   
    Debug ""
    Debug "BAR SCROLL EVENT"
    Debug ""
   
    ;Müssen direkt hier ausführen ! Geht nicht anders, da das BindGadgetEvent die Event Schleife blockiert
   
    Shared one_w.f, one_h.f, Level, BorderL, BorderU, BarWHalf, BarHHalf, PicStartX, PicStartY, MouseFollow, CenterX ,CenterY
   
    MouseFollow = 0 
   
    tmp_x = GetGadgetState(#XBar) : tmp_y = GetGadgetState(#YBar) 
   
    If Level <> 100
      ZoomSprite(0,one_w,one_h)
    EndIf
    StartDrawing(SpriteOutput(0)) 
      DrawImage(ImageID(#ResPic),BarWHalf - tmp_x, BarHHalf - tmp_y)
      AntiBullShit(tmp_x,tmp_y)
    StopDrawing() 
   
    DisplaySprite(0, -BorderL +PicStartX, -BorderU +PicStartY) 
    FlipBuffers() 
   
  EndProcedure
 
  Procedure.w MouseWheelDelta()
    Protected x.w
    x.w = ((EventwParam()>>16)&$FFFF)
    Debug -(x / 120)
   
    ProcedureReturn -(x / 120)
  EndProcedure
 
  Procedure Zoom(Mode)
   
    Shared Level, one_w, one_h, IMG_W, IMG_H, PosX, PosY, PicStartX, PicStartY, AbschlagX, AbschlagY, BarWHalf, BarHHalf, BorderL, BorderU
    Shared BorderWQuarter, BorderHQuarter, BarW, BarH
   
    If Mode = 1 ;/ Zoom IN
     
      ;[
     
      Level + 50
     
      one_w.f = IMG_W / 100 : one_h.f = IMG_H / 100
      one_w.f * Level : one_h.f * Level
      one_w.f=Round(one_w,#PB_Round_Down) : one_h.f=Round(one_h,#PB_Round_Down)
     
      CreateSprite(0,IMG_W,IMG_H)
      ZoomSprite(0,one_w,one_h)
      PosX = GetGadgetState(#XBar)  : PosY = GetGadgetState(#YBar)
     
      ; HIER ABschlag ! Nicht AUFschlag
     
      If PicStartX > 0
        AbschlagX = (PicStartX / 2)
      Else
        AbschlagX = 0
      EndIf
      If PicStartY > 0
        AbschlagY = (PicStartY / 2)
      Else
        AbschlagY = 0
      EndIf
     
      StartDrawing(SpriteOutput(0))
        DrawImage(ImageID(#ResPic),BarWHalf - PosX, BarHHalf - PosY)
      StopDrawing()
     
      BorderL + BorderWQuarter - AbschlagX ;/ AUF Keinen Fall BorderL = BorderWQuarter - AbschlagX sonst driftet der Zoom ab.
      BorderU + BorderHQuarter - AbschlagY ;/ Immer BorderL + BorderWQuarter - AbschlagX
     
      Debug ""
      Debug PicStartY / 2
      BarW = GetGadgetAttribute(#XBar,#PB_ScrollBar_Maximum) : BarH = GetGadgetAttribute(#YBar,#PB_ScrollBar_Maximum)
      Debug "BarW MAX="+BarW : Debug "BarH MAX="+BarH
      ;]
     
    Else
     
      ;[
      Level - 50
     
      one_w.f = IMG_W / 100 : one_h.f = IMG_H / 100
      one_w.f * Level : one_h.f * Level
      one_w.f=Round(one_w,#PB_Round_Down) : one_h.f=Round(one_h,#PB_Round_Down)
     
      CreateSprite(0,IMG_W,IMG_H)
      ZoomSprite(0,one_w,one_h)
     
      PosX = GetGadgetState(#XBar) : PosY = GetGadgetState(#YBar)
     
      ; HIER AUFschlag ! Nicht ABschlag
     
      If PicStartX > 0
        AufschlagX = (PicStartX / 2)
      Else
        AufschlagX = 0
      EndIf
      If PicStartY > 0
        AufschlagY = (PicStartY / 2)
      Else
        AufschlagY = 0
      EndIf
     
      StartDrawing(SpriteOutput(0))
        DrawImage(ImageID(#ResPic),BarWHalf - PosX,BarHHalf - PosY)
      StopDrawing()
     
      BorderL - BorderWQuarter + AufschlagX ;/ AUF Keinen Fall BorderL = BorderWQuarter + AufschlagX sonst driftet der Zoom ab.
      BorderU - BorderHQuarter + AufschlagY ;/ Immer BorderL + BorderWQuarter + AufschlagX
     
      Debug ""
      BarW = GetGadgetAttribute(#XBar,#PB_ScrollBar_Maximum) : BarH = GetGadgetAttribute(#YBar,#PB_ScrollBar_Maximum)
      Debug "BarW MAX="+BarW  : Debug "BarH MAX="+BarH
     
      ;]
     
    EndIf
   
   
  EndProcedure
 
  Procedure ChangeBarPos(Mode, Steps = 10)
   
    PosX = GetGadgetState(#XBar) : PosY = GetGadgetState(#YBar)
   
    If Steps = 0
      Steps = 10
    EndIf
   
    If Mode = 0 ; LEFT KEY
      SetGadgetState(#XBar,PosX - Steps)
    ElseIf Mode = 1 ; RIGHT KEY
      SetGadgetState(#XBar,PosX + Steps)
    ElseIf Mode = 2 ; UP KEY
      SetGadgetState(#YBar,PosY - Steps)
    ElseIf Mode = 3 ; DOWN KEY
      SetGadgetState(#YBar,PosY + Steps)
    EndIf 
   
  EndProcedure
 
  BorderW = 700 ; Sichtbarer Rahmen
  BorderH = 700 ; Sichtbarer Rahmen
 
  ;pic$ = "d:\FOTOS\GIF\roflcopter.gif"
  pic$ = "c:\PutYourDirtyJpgFileHere.jpg"
 
  If LoadImage(#OrigPic,pic$)
    ;Bildmaße mit Seitenverhältniss anpassen an Sichtbaren Rahmen
    tmp_size$ = CalcImageSize(#OrigPic,BorderW,BorderH,0,0,0)
    IMG_W = Val(StringField(tmp_size$,1,":")) : IMG_H = Val(StringField(tmp_size$,2,":")) 
    Debug IMG_W : Debug IMG_H
    Debug ""
    CopyImage(#OrigPic,#ResPic) ; Wollen ja keinen Generationen Verlusst
    ; IMG_H = IMG_W ; Falls mann testen will wie es sich bei einem Quadratischen Bild verhält
    ResizeImage(#ResPic,IMG_W,IMG_H)
    Debug "PIC LOADED"
    StartDrawing(ImageOutput(#ResPic))
      Line(IMG_W / 2,0,1,IMG_H,#red) ; Senkrechte Mittel Linie
      Line(0,IMG_H / 2,IMG_W,1,#cyan) ; Waagrechte Mittel Linie
    StopDrawing()
  Else
    Debug "No Image Loaded"
    End
  EndIf
 
  PicStartX = IMG_W - BorderW
  PicStartY = IMG_H - BorderH
 
  If PicStartX = 0
    Debug "OK Bild W gleich groß wie BorderW"
    Debug "PicStartX=0"
  ElseIf PicStartX < 0
    Debug "OK Bild W kleiner als BorderW"
    PicStartX = BorderW - IMG_W
    PicStartX / 2
    Debug "PicStartX="+PicStartX
  Else
    Debug "BAD - Bild W größer als BorderW - Irgendwas muss bei CalcImageSize schiefgangen sein."
  EndIf
  If PicStartY = 0
    Debug "OK Bild H gleich groß wie BorderH"
    Debug "PicStartY=0"
  ElseIf PicStartY < 0
    Debug "OK Bild H kleiner als BorderH"
    PicStartY = BorderH - IMG_H
    PicStartY / 2
    Debug "PicStartY="+PicStartY
  Else
    Debug "BAD - Bild H größer als BorderH - Irgendwas muss bei CalcImageSize schiefgangen sein."
  EndIf
 
  AbstandL = 100
  AbstandOb = 20
 
  BorderWQuarter = BorderW / 4
  BorderHQuarter = BorderH / 4
 
  InitBarW = (BorderW * 3) + 1 ; 2101 - Mitte ist also genau 1051
  BarWHalf = (InitBarW / 2) ; Kein + 1 sonst 1051 -> Schlecht teilbar
 
  InitBarH = (BorderH * 3) + 1 ; 2101 - Mitte ist also genau 1051
  BarHHalf = (InitBarH / 2) ; Kein + 1 sonst 1051 -> Schlecht teilbar
 
  CenterX = (InitBarW / 2) + 1
  CenterY = (InitBarH / 2) + 1
 
  Debug ""
  Debug "InitBarW="+InitBarW
  Debug "BarWHalf="+BarWHalf
  Debug ""
  Debug "InitBarH="+InitBarH
  Debug "BarHHalf="+BarHHalf 
  Debug ""
  Debug "CenterX="+CenterX
  Debug "CenterY="+CenterY
 
  Level = 100
  BorderL = 0
  BorderU = 0
  PgLen = 0
 
  UseLButtonDrag = #True ; Wenn TRUE. Hin und her schieben vom Bild per Links gehaltener Mouse Taste, ansonsten Rechte Taste
  If UseLButtonDrag = #True
    XBUP = #WM_LBUTTONUP : XBDOWN = #WM_LBUTTONDOWN
  Else
    XBUP = #WM_RBUTTONUP : XBDOWN = #WM_RBUTTONDOWN
  EndIf
 
  If OpenWindow(#MainWin, 0, 0, 820,800, "A screen in a window...", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
   
    CreateStatusBar(0, WindowID(#MainWin))
    AddStatusBarField(420)
    StatusBarText(0, 0, "Bla")
   
    ButtonGadget(#Z_IN,10,20,60,20,"ZoomIN")
    ButtonGadget(#Z_OUT,10,50,60,20,"ZoomOut")
   
    bla$ = "C"+#CRLF$+"e"+#CRLF$+"n"+#CRLF$+"t"+#CRLF$+"e"+#CRLF$+"r"+#CRLF$+" "+#CRLF$+"Y"
   
    ButtonGadget(#MidX, AbstandL, BorderH+42, (BorderW / 2) + 9, 20,"CenterX") 
    ButtonGadget(#MidY, AbstandL - 21, AbstandOb,19, (BorderH / 2) + 1, bla$,#PB_Button_MultiLine)
   
    ButtonGadget(#CenterAll,0,500,80,60,"Center X+Y")
    ButtonGadget(#ResetZoom,0,600,80,60,"Reset Zoom")
   
    ScrollBarGadget(#XBar,AbstandL,BorderH+20,BorderW,20,0,InitBarW,PgLen) 
    ScrollBarGadget(#YBar,AbstandL+BorderW,AbstandOb,20,BorderH,0,InitBarH,PgLen,#PB_ScrollBar_Vertical) 
   
    Debug ""
    Debug "Drecks PageLen="+PgLen
   
    ;/ Wenn mann als BarW z.B 2100 setzt, und eine PgLen von 350, dann wird GetGadgetState am Maximalen Punkt GANZ Rechts aussen
    ;/ 1750 ausgeben ! Das Maximum als Rückgabewert ist >IMMER< so viel weniger wie Page Len ist !
   
    ;/ Und mann kann das >NICHT< ausgleichen mit SetGadgetAttribute(#XBar, 2100+PageLen, #PB_ScrollBar_Maximum)
    ;/ Dann kommt halt bei GetGadgetState als Maximaler Wert 2100 heraus, obwohl die BarBreite eigentlich 2450 ist.
   
    ;/ Lösung -> PageLen auf 0 setzen und gut is.
   
    ;/ Das macht halt einen sehr kleinen Balken. Der aber immer gleich groß bleibt.
    ;/ Ich empfehle jedem die verschissene PageLen auf 0 zu lassen, der Mist verkompliziert nur, weil mann noch eine Variable einplanen muss.
   
    ;/ Wenn einem 1px pro Klick auf Bar zu wenig sind, kann ja immer noch nenn KeyEvent Code benutzen das halt 10 oder mehr
    ;/ Pixel per Cursor gesprungen werden. (hab einen eingebaut)
   
    ;/ In BildScrollDatas() macht es keinen Sinn, da mann so nicht ohne 2 Zusatz Variablen
    ;/ (die den letzten Wert mit der Center Position abgleichen)
    ;/ (oder erechnen ob Mouse Links oder Rechts vom Bar Center Punkt)
    ;/ herausfinden kann in welche Richtung gescrollt wurde. Ausserdem ist das Scrollen mit Mouse immer schnell (egal ob PageLen 0)
    ;/ ausser mann benutzt die beknackten kleinen Pfeile.
   
    ;/ NOCH EINE INFO ! Die ZOOM Berechnung ist vom Pic Verhältniss das das Bild im RAHMEN bei 100% hat !
    ;/ Wenn Pic Original 400x400 wird es im Rahmen 700x700 haben, und das wird der 100% Wert sein. Und von diesem
    ;/ 700x700 Wert aus wird hoch oder runter gerechnett
   
    SetGadgetState(#XBar,CenterX) : SetGadgetState(#YBar,CenterY)
   
    BindGadgetEvent(#XBar, @ BindScrollDatas()) 
    BindGadgetEvent(#YBar, @ BindScrollDatas())   
   
    If OpenWindowedScreen(WindowID(#MainWin),AbstandL,AbstandOb,BorderW,BorderH,#False,0,0)
     
      LimitX = WindowWidth(#MainWin) - 19
      LimitY = (AbstandOb + BorderH) - 1
     
      SpriteQuality(#PB_Sprite_BilinearFiltering) ; Sieht sonst wie Müll aus
     
      CreateSprite(0,IMG_W,IMG_H) ; Erstellt ein leeres Sprites, dies wird komplett schwarz sein
      StartDrawing(SpriteOutput(0))
        DrawImage(ImageID(#ResPic),0,0)
      StopDrawing()
     
      Repeat
        ; Es ist sehr wichtig, alle im Queue befindlichen Ereignisse während jedes Frames abzuarbeiten
        ;
        Repeat
         
          Event = WaitWindowEvent(10)
         
          If Event = XBUP ; Maus Taste wurde released
            MouseFollow = 0
          EndIf
         
          If Event = #WM_MOUSEWHEEL
           
            MouseFollow = 0
           
            MAIN_SCROLL_DIR = MouseWheelDelta()
            If MAIN_SCROLL_DIR = 1
              If Level >= 100
                Zoom(0)
              EndIf
            ElseIf MAIN_SCROLL_DIR = -1
              If Level < 600
                Zoom(1)
              EndIf
            EndIf
           
          EndIf
         
          If Event = #WM_KEYDOWN
           
            ;/ ACHTUNG ! WM_KEYDOWN reagiert so lange gedrückt gehalten wird !
           
            MouseFollow = 0
           
            Main_KeyCode = EventwParam()
           
            If Main_KeyCode = #VK_Left
              ChangeBarPos(0,20)
            ElseIf Main_KeyCode = #VK_Right
              ChangeBarPos(1,20)
            ElseIf Main_KeyCode = #VK_Up
              ChangeBarPos(2,20)
            ElseIf Main_KeyCode = #VK_Down
              ChangeBarPos(3,20) 
            EndIf
           
            If IsSprite(0) = 0
              CreateSprite(0,IMG_W,IMG_H)
            EndIf
           
            PosX = GetGadgetState(#XBar) : PosY = GetGadgetState(#YBar) 
           
            StartDrawing(SpriteOutput(0))
              DrawImage(ImageID(#ResPic),BarWHalf - PosX, BarHHalf - PosY)
              AntiBullShit(PosX,PosY)
            StopDrawing()
           
          EndIf
         
          If Event = #WM_KEYUP
           
            ;/ #WM_KEYUP Reagiert erst beim Release
            If Main_KeyCode <> 0
              Debug "KEY RELEASED"
            EndIf
           
          EndIf
         
          If MouseFollow ; Zeichnen
           
            PosX = GetGadgetState(#XBar) : PosY = GetGadgetState(#YBar)
           
            If IsSprite(0) = 0
              CreateSprite(0,IMG_W,IMG_H)
            EndIf
           
            StartDrawing(SpriteOutput(0))
              DrawImage(ImageID(#ResPic),BarWHalf - PosX, BarHHalf - PosY)
              AntiBullShit(PosX,PosY)
            StopDrawing()
           
          Else ; ansonsten um den anderen Kram kümmern
           
            If Event = XBDOWN ; Mouse Taste wurde gedrückt
             
              mx = WindowMouseX(#MainWin) : my = WindowMouseY(#MainWin)
             
              If mx > AbstandL And mx < LimitX And my > AbstandOb And my < LimitY
                If IsThread(MouseTH) = 0
                  MouseFollow = #True
                  MouseTH=CreateThread(@MouseFollow(),0)
                EndIf
              EndIf
             
            EndIf
           
            If Event = #PB_Event_Gadget
             
              EventGadget = EventGadget()
             
              If EventGadget = #ResetZoom
                Level = 100
                CreateSprite(0,IMG_W,IMG_H)
                StartDrawing(SpriteOutput(0))
                  DrawImage(ImageID(#ResPic),0,0)
                StopDrawing()
                BorderL = 0 : BorderU = 0
                SetGadgetState(#XBar,CenterX) : SetGadgetState(#YBar,CenterY)
              EndIf
             
              If EventGadget = #MidX
                Debug "RESET CENTER X"
                PosY = GetGadgetState(#YBar) 
                CreateSprite(0,IMG_W,IMG_H) ; Erstellt ein leeres Sprites, dies wird komplett schwarz sein 
                StartDrawing(SpriteOutput(0))
                  If Level <> 100
                    ZoomSprite(0,one_w,one_h)
                  EndIf
                  DrawImage(ImageID(#ResPic),BarWHalf - CenterX, BarHHalf - PosY)
                StopDrawing()
                SetGadgetState(#XBar,CenterX)
              EndIf
             
              If EventGadget = #MidY
                Debug "RESET CENTER Y"
                PosX = GetGadgetState(#XBar) 
                CreateSprite(0,IMG_W,IMG_H) ; Erstellt ein leeres Sprites, dies wird komplett schwarz sein 
                StartDrawing(SpriteOutput(0))
                  If Level <> 100
                    ZoomSprite(0,one_w,one_h)
                  EndIf
                  DrawImage(ImageID(#ResPic),BarWHalf - PosX, BarHHalf - CenterY)
                StopDrawing()
                SetGadgetState(#YBar,CenterY)
              EndIf
             
              If EventGadget = #CenterAll
                SetGadgetState(#XBar,CenterX) : SetGadgetState(#YBar,CenterY)
                CreateSprite(0,IMG_W,IMG_H) ; Erstellt ein leeres Sprites, dies wird komplett schwarz sein 
                StartDrawing(SpriteOutput(0))
                  If Level <> 100
                    ZoomSprite(0,one_w,one_h)
                  EndIf
                  DrawImage(ImageID(#ResPic),BarWHalf - CenterX, BarHHalf - CenterY)
                StopDrawing() 
              EndIf
             
              If EventGadget = #Z_IN And Level < 600
                Zoom(1) 
              EndIf
             
             
              If EventGadget = #Z_OUT And Level >= 100
                Zoom(0)
              EndIf
             
            EndIf
           
          EndIf
         
          If Event = #PB_Event_CloseWindow
            End
          EndIf
         
        Until Event = 0
       
        FlipBuffers()
        ClearScreen(RGB(0,0,100)) ; Ein blauer Hintergrund
       
        DisplaySprite(0, -BorderL +PicStartX, -BorderU +PicStartY)
       
      ForEver
     
    Else
      MessageRequester("Error", "Can't open windowed screen!", 0)
    EndIf
  EndIf
EDIT: Kleine Korrektur.

Code: Alles auswählen

    ScrollBarGadget(#YBar,AbstandL+BorderW,AbstandOb,20,BorderH,0,InitBarW,PgLen,#PB_ScrollBar_Vertical)  
auf

Code: Alles auswählen

    ScrollBarGadget(#YBar,AbstandL+BorderW,AbstandOb,20,BorderH,0,InitBarH,PgLen,#PB_ScrollBar_Vertical)  
geändert.
https://www.geek.com/tech/a-commodore-6 ... s-1672510/
٩(̾●̮̮̃̾•̃̾)۶ __̴ı̴̴̡̡̡ ̡͌l̡̡̡ ̡͌l̡*̡̡ ̴̡ı̴̴̡ ̡̡͡|̲̲̲͡͡͡ ̲▫̲͡ ̲̲̲͡͡π̲̲͡͡ ̲̲͡▫̲̲͡͡ ̲|̡̡̡ ̡ ̴̡ı̴̡̡ ̡͌l̡̡̡̡.___٩(- ̮̮̃-̃)۶