Layout Programm im CanvasGadget

Du brauchst Grafiken, gute Programme oder Leute die dir helfen? Frag hier.
Benutzeravatar
TroaX
Beiträge: 659
Registriert: 08.03.2013 14:27
Computerausstattung: PC: Ryzen 9 3950X, 96 GB RAM, RX6800XT, 2.5 TB SSD, 21:9 Display, Pop_OS! | Lappi: Ryzen 7 5800H, 16 GB RAM, 1 TB SSD, Pop_OS!
Wohnort: NRW
Kontaktdaten:

Re: Layout Programm im CanvasGadget

Beitrag von TroaX »

Phil hat geschrieben:Selektieren ja, mit LinksKlick, aber es geht um die Aktualisierung der farblichen Markierung, welches Objekt bei Klick ausgewählt wird.
Und diese ändert sich ja auch nur, wenn geklickt wird oder wenn ein anderes Event den Wechsel hervorruft. Und genau dann würde ich auch nur neu zeichnen. Alles andere kommt mir da doch etwas seltsam vor.
Phil hat geschrieben:Was meinst du mit Delay? Hab es mit 5 ms Timeout in WaitWindowEvent und Delay(5) in der EventLoop versucht.
Bringt bei mir eine Verbesserung von 15% auf 11%. Bei Delay(10) auf 8% gesamt.
Mit Delay Prozessorzeit freigeben. Mit 10ms zeichnet das ganze bis zu 100mal die Sekunde, wobei in der Zwischenzeit die Prozessorzeit freigegeben wird und die Auslastung erheblich sinkt. Die Zahlen deines Versuchs sagen allerdings nichts, da wir nicht wissen, was für ein Prozessor diese Werte zu Grunde liegen. Aber durch das Verdoppeln der Delay-Zeit sagt es mir, das dieser Starke Einbruch der Auslastung schon bedeutet, das der Delay ordentlich was bringt. Ich würde es mit 30 machen.

Aber wie gesagt wäre es sinnvoller nur dann zu zeichnen, wenn Änderungen auch zu erwarten sind und nicht einfach immer, wenn sich die Maus bewegt.
PC: Ryzen 9 3950X | 96 GB RAM | RX6800XT | 2,5 TB NVMe | Pop_OS!
Notebook: 16" 3:2 | Ryzen 7 5800H | 16 GB RAM | Radeon Vega | 1TB NVMe | Pop_OS!
NAS: Fritz.Box :lol:
Coding: Purebasic 6.04 | PHP | HTML | CSS | Javascript
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Layout Programm im CanvasGadget

Beitrag von mk-soft »

Ein Delay hat in einer WaitWindowEvent Loop nichts zu suchen.
Führt nur irgendwann zu einer "Fenster regiert nicht mehr" Meldung...

P.S.
Die Events MouseMove und alle anderen Events werden dadurch auch nicht weniger. Diese werden durch das Delay nur verzögert abgearbeitet...
Zuletzt geändert von mk-soft am 26.10.2018 20:20, insgesamt 2-mal geändert.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Layout Programm im CanvasGadget

Beitrag von mk-soft »

Hier mal mit ein WindowTimer das nur alle 100ms das CanvasGadget bei bedarf (CanvasUpdate) neu zeichnet.

Code: Alles auswählen

; ------------------------------------------------------------
;
;   Layout Software - Canvas Vector Test
;
;    (c) Phil
;
; ------------------------------------------------------------
;



EnableExplicit

;- Constants

#testImage = 7
#Handle_Radius=3.0


Enumeration Mode
  #Mode_None
  #Mode_Move
EndEnumeration


;- Gadgets
#G_Canvas=5


;- Structures

Structure Object
  name.s
  image.i
  text.s
  x.f
  y.f
  w.f
  h.f
  flag_selected.b
EndStructure

;- Global 

Global Event.i
Global EventGadget.i
Global EventType.i

Global gMouseX.f
Global gMouseY.f
Global gRelativeSelObjMouseX.f
Global gRelativeSelObjMouseY.f

Global gScaleKoords.f = 1.0

Global gMode.i

Global NewList objList.Object()
Global NewList mouseOverList.i()
Global gUpMouseOverObj.i 
Global gSelectedObject.i = 3
Global gFlgMouseOverHandle.i
Global gFlgMouseOverSelObj.i

;- Procedures

Procedure CreateObject()
  
  AddElement(objList())
  
  With objList()
    \name = "test"
    \image = #testImage
    \x = Random(100,10)
    \y = Random(100,10)
    \w = Random(100,10)
    \h = Random(100,10)
  EndWith
  
EndProcedure

Procedure RedrawObjects()
  
  Protected x.f, y.f
  
  x = gMouseX
  y = gMouseY
  
  ;Make list of all Objects with MouseOver by silently drawing the frames.
  ForEach objList()
    With objList()
      
      AddPathBox(\x, \y,\w ,\h)
      If IsInsidePath(x, y, #PB_Coordinate_User)
        VectorSourceColor(RGBA(255, 255, 0, 255))
        AddElement(mouseOverList())
        mouseOverList()=ListIndex(objList())
      Else
        VectorSourceColor(RGBA(0, 255, 0, 255))
      EndIf
      
      ResetPath()
      ;       StrokePath(0.4)       
    EndWith
  Next
  
  ;select upmost object and draw all objects.
  If LastElement(mouseOverList())
    Protected upObj.i= mouseOverList()+1
    ResetList(mouseOverList())
  Else
    upObj=0
    gUpMouseOverObj=0
  EndIf
  
  Protected curObjNr.i
  
  ForEach objList()
    curObjNr = ListIndex(objList())+1
    
    With objList()
      
      ;If Mode_Move, set new position of selObj
      If curObjNr=gSelectedObject 
        Select gMode            
          Case #Mode_Move
            \x=x-gRelativeSelObjMouseX
            \y=y-gRelativeSelObjMouseY
            ;Make it eventually snap to a grid??
            \x=Round(\x,#PB_Round_Nearest)
            \y=Round(\y,#PB_Round_Nearest)
            
        EndSelect
      EndIf
      
      ;Draw Image and PathBox
      MovePathCursor(\x,\y)
      DrawVectorImage(ImageID(\image),255,\w,\h)
      
      AddPathBox(\x, \y,\w ,\h)
      
      ;Check selObj for MouseOver
      If curObjNr=gSelectedObject 
        If IsInsidePath(x, y, #PB_Coordinate_User)
          gFlgMouseOverSelObj=#True
        Else
          gFlgMouseOverSelObj=#False
        EndIf
      EndIf
      
      If IsInsidePath(x, y, #PB_Coordinate_User)
        
        If curObjNr=upObj ; Wenn das Object das oberste ist, durchgeben und färben
          gUpMouseOverObj=upObj
          VectorSourceColor(RGBA(255, 50, 0, 255))
        Else
          VectorSourceColor(RGBA(255, 255, 0, 255))
        EndIf
      Else
        VectorSourceColor(RGBA(0, 255, 0, 255))
      EndIf
      
      StrokePath(ConvertCoordinateX(0.4,0,#PB_Coordinate_Output,#PB_Coordinate_User))     
    EndWith
  Next
  
  ClearList(mouseOverList())
  
EndProcedure

Procedure RedrawSelection()
  
  Protected hR.f
  Protected x.f, y.f
  
  x = gMouseX
  y = gMouseY
  
  hR = ConvertCoordinateX(#Handle_Radius,0,#PB_Coordinate_Output,#PB_Coordinate_User)
  
  gFlgMouseOverHandle.i=#False
  
  If gSelectedObject
    
    SelectElement(objList(),gSelectedObject-1)
    
    With objList()
      
      
      ;Draw Box around Object.
      AddPathBox(\x,\y,\w,\h)
      VectorSourceColor(RGBA(50,50,255,100))
      DashPath(ConvertCoordinateX(0.6,0,#PB_Coordinate_Output,#PB_Coordinate_User),2.0)
      
      
      ;Draw HandleCircles round selectedObject and check for MouseOver.
      AddPathCircle(\x,\y,hR)
      If Not gFlgMouseOverHandle And IsInsidePath(x, y, #PB_Coordinate_User) : gFlgMouseOverHandle=1 : EndIf     
      AddPathCircle(\x+\w,\y,hR)
      If Not gFlgMouseOverHandle And IsInsidePath(x, y, #PB_Coordinate_User) : gFlgMouseOverHandle=2 : EndIf
      AddPathCircle(\x,\y+\h,hR)
      If Not gFlgMouseOverHandle And IsInsidePath(x, y, #PB_Coordinate_User) : gFlgMouseOverHandle=3 : EndIf
      AddPathCircle(\x+\w,\y+\h,hR)
      If Not gFlgMouseOverHandle And IsInsidePath(x, y, #PB_Coordinate_User) : gFlgMouseOverHandle=4 : EndIf
      AddPathCircle(\x+\w/2,\y+\h/2,hR)
      If Not gFlgMouseOverHandle And IsInsidePath(x, y, #PB_Coordinate_User) : gFlgMouseOverHandle=5 : EndIf
      VectorSourceColor(RGBA(50,50,255,150))
      FillPath()
      
      
    EndWith
  EndIf
  
EndProcedure


Procedure RedrawAll(x.f,y.f)
  
  If StartVectorDrawing(CanvasVectorOutput(#G_Canvas,#PB_Unit_Millimeter))
    
    Protected i.i, imgWidth.f, imgHeight.f
    
    ScaleCoordinates(gScaleKoords,gScaleKoords)
    
    
    ;     imgWidth = ConvertCoordinateX(ImageWidth(#testImage),0,#PB_Coordinate_Device,#PB_Coordinate_Output)
    ;     imgHeight =  ConvertCoordinateY(0,ImageHeight(#testImage),#PB_Coordinate_Device,#PB_Coordinate_Output)
    
    ;     gMouseX = ConvertCoordinateX(x,y,#PB_Coordinate_Device,#PB_Coordinate_Output)
    ;     gMouseY = ConvertCoordinateY(x,y,#PB_Coordinate_Device,#PB_Coordinate_Output)
    gMouseX = ConvertCoordinateX(x,y,#PB_Coordinate_Device,#PB_Coordinate_User)
    gMouseY = ConvertCoordinateY(x,y,#PB_Coordinate_Device,#PB_Coordinate_User)
    
    ;Clear whole Canvas and draw sheet of Paper.
    VectorSourceColor(RGBA(100,100,100, 255))
    FillVectorOutput()
    VectorSourceColor(RGBA(50,50,50, 255))
    AddPathBox(10.5,10.5,145,210)
    FillPath()
    VectorSourceColor(RGBA(240,240,240, 255))
    AddPathBox(10,10,145,210)
    FillPath()
    
    
    
    
    ;Draw objects and check for mouseover.
    RedrawObjects()
    
    RedrawSelection()
    
    
    ;     ;Testdraw für Coordinaten.
    ;     AddPathBox(gMouseX, gMouseY, 10,20)
    ;     VectorSourceColor(RGBA(Random(255), Random(255), Random(255), 255))
    ;     FillPath()
    
    
    StopVectorDrawing()
  EndIf
  
EndProcedure

Procedure SetRelMousePos()
  
  Protected selObj.i
  
  SelectElement(objList(),gSelectedObject-1)
  gRelativeSelObjMouseX = gMouseX- objList()\x
  gRelativeSelObjMouseY = gMouseY- objList()\y
  
  ;   Debug gRelativeSelObjMouseX
EndProcedure


If OpenWindow(0, 0, 0, 900, 900, "VectorDrawing", #PB_Window_SystemMenu | #PB_Window_ScreenCentered|#PB_Window_MaximizeGadget)
  CanvasGadget(#G_Canvas, 0, 0, 900, 900)
  UsePNGImageDecoder()
  UseJPEGImageDecoder()
  Define file.s
  file = OpenFileRequester("Wähle Bilddatei (.png) aus.",GetCurrentDirectory(),"png-Image|*.png",0)
  If Not LoadImage(#testImage, file):MessageRequester("Fehler", "Ohne Bild kein Programm! ;-)"):End:EndIf
  ResizeImage(#testImage,250,400)
  
  gMode = #Mode_None
  
  Define i.i
  For i=0 To 8
    CreateObject()
  Next
  
  ;Initial drawing
  RedrawAll(0,0)
  
  Define CanvasUpdate
  Define CanvasMouseX, CanvasMouseY
  
  AddWindowTimer(0, 1, 100)
  
  ;- Event-Loop
  
  Repeat
    Event = WaitWindowEvent()
    
    Select event
        
      Case #PB_Event_Timer
        If EventTimer() = 1 And CanvasUpdate
          ;Refresh Canvas on every move. and check for MouseOver!
          RedrawAll(CanvasMouseX, CanvasMouseY)
          
          ;If Handle MouseOver, show hand symbol.
          If gFlgMouseOverHandle
            SetGadgetAttribute(#G_Canvas,#PB_Canvas_Cursor,#PB_Cursor_Hand)
          Else
            SetGadgetAttribute(#G_Canvas,#PB_Canvas_Cursor,#PB_Cursor_Default)
          EndIf
          CanvasUpdate = 0
        EndIf
        
      Case #PB_Event_Gadget
        Global Gadget = EventGadget()
        Global EventType = EventType()
        
        Select Gadget
          Case #G_Canvas ;Canvas Gadget Event
            
            Select EventType
                
              Case #PB_EventType_MouseMove
                CanvasUpdate = 1
                CanvasMouseX = GetGadgetAttribute(#G_Canvas,#PB_Canvas_MouseX)
                CanvasMouseY = GetGadgetAttribute(#G_Canvas,#PB_Canvas_MouseY)
                
              Case #PB_EventType_LeftButtonDown 
                
                ;Only change selected Object if LeftClick was not on selObj or Handle!
                If Not (gFlgMouseOverHandle Or gFlgMouseOverSelObj)
                  gSelectedObject=gUpMouseOverObj 
                EndIf
                
                ;If clicked on selObj, start move and register rel pos of Cursor.
                If gFlgMouseOverSelObj
                  gMode = #Mode_Move
                  SetRelMousePos()
                EndIf
                
                
                If GetGadgetAttribute(#G_Canvas,#PB_Canvas_Buttons)=#PB_MouseButton_Left
                  
                EndIf
                CanvasUpdate = 1
                
              Case #PB_EventType_LeftButtonUp              
                gMode = #Mode_None
                CanvasUpdate = 1
                
              Case #PB_EventType_MouseWheel
                Define delta.i
                delta =GetGadgetAttribute(#G_Canvas,#PB_Canvas_WheelDelta)
                
                If GetGadgetAttribute(#G_Canvas,#PB_Canvas_Modifiers) = #PB_Canvas_Control
                  gScaleKoords*(1.0+delta*0.1)
                  If gScaleKoords<0.4: gScaleKoords=0.4:EndIf
                  If gScaleKoords>3.0: gScaleKoords=3.0:EndIf
                  ;RedrawAll(GetGadgetAttribute(#G_Canvas,#PB_Canvas_MouseX),GetGadgetAttribute(#G_Canvas,#PB_Canvas_MouseY))
                  CanvasUpdate = 1
                EndIf
                
            EndSelect
            
        EndSelect
    EndSelect
    
    
  Until Event = #PB_Event_CloseWindow
EndIf

Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Phil
Beiträge: 32
Registriert: 05.07.2006 10:46

Re: Layout Programm im CanvasGadget

Beitrag von Phil »

Und diese ändert sich ja auch nur, wenn geklickt wird oder wenn ein anderes Event den Wechsel hervorruft
Das stimmt bei der momentanen Vorgehensweise eben nicht. Die Farbänderung ist vor dem Klick nötig, da für den Benutzer vor dem Klick ersichtlich sein soll, welches Object er dann auswählt.
Momentan zeichne ich alles in einem Aufwasch. Das könnte ich ändern, indem ich nur die Pfade der Objektrahmen "blind" zeichne, um mit IsInsidePath() die Objecte mit MouseOver bestimmen zu können.
Dann könnte ich das "echte" Zeichnen nur bei Änderungen dieser Daten auslösen.


Vielen Dank für das Timer Beispiel! Leider sind 100ms schon deutlich spürbar in der Flüssigkeit und bei 5ms erhalte ich keine niedrigere Auslastung.
PB 5.62 on Win10
Sirius-2337
Beiträge: 71
Registriert: 29.05.2010 20:55

Re: Layout Programm im CanvasGadget

Beitrag von Sirius-2337 »

Da ich grad was ähnliches brauche hier mal ein Beispiel, wie ich es machen würde.
Hier wird nur neu gezeichnet, wenn nötig.

Code: Alles auswählen

EnableExplicit

Enumeration Gadgets
  #G_Canvas
EndEnumeration

EnumerationBinary
  #Highlight_Hover ;Maus ist über dem Objekt
  #Highlight_HoverHighest ;Von den gehoverten Objekten ist dieses das oberste
  #Highlight_Selected ;Objekt wurde angeklickt
  #Highlight_Drag ;Objekt wird mit Maus festgehalten
EndEnumeration

#HandleSize = 4 ;= (Größe der Anfasser in den Ecken) / 2

Structure posXY
  x.i
  y.i
EndStructure

Structure object
  image.i
  x.i
  y.i
  w.i
  h.i
  highlight.i
EndStructure

Global gQuit ;Wenn True endet das Programm

Global NewList gObject.object()
Global *gObjectSelected.object ;Pointer zum aktuell ausgewählten Objekt

;Callbacks für Bind(Gadget)Event
Declare cbMainWinClose()
Declare cbCanvasMouseMove()
Declare cbCanvasLeftButtonDown()
Declare cbCanvasLeftButtonUp()

Declare.i setHighlights(x, y, click = #False) ;Prüft ob ein Objekt gehovert oder geklickt wird
Declare redraw() ;Zeichnet alles neu

If OpenWindow(0, 0, 0, 900, 900, "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MaximizeGadget)
  CanvasGadget(#G_Canvas, 0, 0, 900, 900)
  SetGadgetData(#G_Canvas, AllocateMemory(SizeOf(posXY))) ;Ein bisschen Speicher um später die relative Mausbewegung zu berechnen
Else
  End
EndIf

; Testobjekte erstellen
Define x
For x = 0 To 5
  AddElement(gObject())
  With gObject()
    \x = Random(700)
    \y = Random(700)
    \w = Random(400, 100)
    \h = Random(400, 100)
    \image = CreateImage(#PB_Any, \w, \h, 32, #PB_Image_Transparent)
    If StartDrawing(ImageOutput(\image))
      DrawingMode(#PB_2DDrawing_AlphaBlend)
      Box(0, 0, \w, \h, RGBA(255, Random(255), Random(255), 125))
      StopDrawing()
    EndIf
  EndWith
Next

BindEvent(#PB_Event_CloseWindow, @cbMainWinClose())
BindGadgetEvent(#G_Canvas, @cbCanvasMouseMove(), #PB_EventType_MouseMove)
BindGadgetEvent(#G_Canvas, @cbCanvasLeftButtonDown(), #PB_EventType_LeftButtonDown)
BindGadgetEvent(#G_Canvas, @cbCanvasLeftButtonUp(), #PB_EventType_LeftButtonUp)

;Initiales Zeichnen
redraw()

Repeat
  WaitWindowEvent()
Until gQuit = #True

End

;Proceduren

Procedure cbMainWinClose()
  gQuit = #True
EndProcedure

Procedure cbCanvasMouseMove()
  
  Protected *MouseXY.posXY = GetGadgetData(#G_Canvas)
  Protected NewMouseXY.posXY
  Protected doRedraw = #False
  
  ;Akutuelle Mausposition ermitteln
  NewMouseXY\x = GetGadgetAttribute(#G_Canvas, #PB_Canvas_MouseX)
  NewMouseXY\y = GetGadgetAttribute(#G_Canvas, #PB_Canvas_MouseY)
  
  ;Highlight-Flags ermitteln und merken ob neu gezeichnet werden müsste
  doRedraw = setHighlights(NewMouseXY\x, NewMouseXY\y)
  
  ;Wenn ein Objekt ausgewählt ist und Maus noch gedrückt ist, Objekt mit Maus bewegen
  If *gObjectSelected And *gObjectSelected\highlight & #Highlight_Drag
    If GetGadgetAttribute(#G_Canvas, #PB_Canvas_Buttons) & #PB_Canvas_LeftButton
      *gObjectSelected\x - (*MouseXY\x - NewMouseXY\x)
      *gObjectSelected\y - (*MouseXY\y - NewMouseXY\y)
      *MouseXY\x = NewMouseXY\x
      *MouseXY\y = NewMouseXY\y
      doRedraw = #True ;Merken, dass neu gezeichnet werden muss
    EndIf
  EndIf
  
  ;Wenn nötig, neu zeichnen
  If doRedraw
    redraw()
  EndIf
  
EndProcedure

Procedure cbCanvasLeftButtonDown()
  
  Protected *MouseXY.posXY = GetGadgetData(#G_Canvas)
  
  With *MouseXY
    
    ;Aktuelle Mausposition speichern, um später die relative Bewegung zu berechnen
    \x = GetGadgetAttribute(#G_Canvas, #PB_Canvas_MouseX)
    \y = GetGadgetAttribute(#G_Canvas, #PB_Canvas_MouseY)
    
    ;Prüfen ob ein Objektes geklickt wurde und evtl. neu zeichnen
    If setHighlights(\x, \y, #True)
      redraw()
    EndIf
    
  EndWith
  
EndProcedure

Procedure cbCanvasLeftButtonUp()
  
  ;Wenn die Maustaste losgelassen wird, das draggen beenden
  If *gObjectSelected
    With *gObjectSelected
      \highlight & ~#Highlight_Drag
    EndWith
  EndIf
  
EndProcedure

Procedure.i setHighlights(x, y, click = #False)
  
  Protected oldHighlight
  Protected updated = #False
  
  If Not ListSize(gObject()) ;Wenns keine Objekte gibt kann man sich den Rest sparen
    ProcedureReturn updated
  EndIf
  
  ForEach gObject()
    With gObject()
      
      oldHighlight = \highlight ;bisherige Highlight-Flags dieses Objekts speichern um später auf eine Änderung prüfen zu können
      \highlight & ~(#Highlight_Hover | #Highlight_HoverHighest) ;'Hover'- und 'HoverHighest'-Flag löschen
      
      ;Wenn Mausposition über Objekt 'Hover'-Flag setzen, sonst entfernen
      If x >= \x And y >= \y And x <= \x + \w And y <= \y + \h
        \highlight | #Highlight_Hover
      Else
        \highlight & ~#Highlight_Hover
      EndIf
      
      ;Wenn der 'Hover'-Flag geändert wurde, merken
      If oldHighlight & #Highlight_Hover <> \highlight & #Highlight_Hover
        updated = #True
      EndIf
      
    EndWith
  Next
  
  ;Oberstes gehovertes Objekt ermitteln
  LastElement(gObject())
  Repeat
    With gObject()
      If \highlight & #Highlight_Hover
        
        \highlight | #Highlight_HoverHighest
        
        ;Wenn geklickt wird 'Selected'- und 'Drag'-Flag setzen und bei bisher selektiertem Objekt (wenn vorhanden) 'Selected'- und 'Drag'-Flag entfernen
        If click = #True
          \highlight | (#Highlight_Selected | #Highlight_Drag)
          If *gObjectSelected And *gObjectSelected <> gObject()
            *gObjectSelected\highlight & ~(#Highlight_Selected | #Highlight_Drag) ;'Drag' dürfte sowiso nie gesetzt sein, weil er bei ButtonUp gelöscht wird, aber sicher ist sicher
          EndIf
          *gObjectSelected = gObject()
          updated = #True ;Merken, dass was geändert wurde
        EndIf
        
        Break
        
      EndIf
    EndWith
  Until Not PreviousElement(gObject())
  
  ProcedureReturn updated ;Zurückgeben ob es Änderungen gab, damit entsprechend neu gezeichnet werden kann, oder halt nicht
  
EndProcedure

Procedure redraw()
  
  If Not ListSize(gObject()) ;Wenns keine Objekte gibt kann man sich den Rest sparen
    ProcedureReturn
  EndIf
  
  If StartDrawing(CanvasOutput(#G_Canvas))
    
    ;Alte Grafik übermalen
    DrawingMode(#PB_2DDrawing_Default)
    Box(0, 0, OutputWidth(), OutputHeight(), $FFFFFF)
    
    ;Alle Objekt zeichnen
    ForEach gObject()
      With gObject()
        DrawAlphaImage(ImageID(\image), \x, \y)
        
        ;Rahmen entsprechen des Flags zeichnen
        DrawingMode(#PB_2DDrawing_Outlined)
        If \highlight & #Highlight_Selected
          Box(\x    , \y     , \w   , \h    , $00FFFF)
          Box(\x + 1, \y + 1, \w - 2, \h - 2, $00FFFF)
        ElseIf \highlight & #Highlight_HoverHighest
          Box(\x    , \y    , \w    , \h    , $0000FF)
          Box(\x + 1, \y + 1, \w - 2, \h - 2, $0000FF)
        ElseIf \highlight & #Highlight_Hover
          Box(\x    , \y    , \w    , \h    , $FF0000)
          Box(\x + 1, \y + 1, \w - 2, \h - 2, $FF0000)
        Else
          Box(\x    , \y    , \w    , \h    , $000000)
          Box(\x + 1, \y + 1, \w - 2, \h - 2, $000000)
        EndIf
        
        ;Anfasser zeichnen
        DrawingMode(#PB_2DDrawing_Default)
        Box(\x - #HandleSize     , \y - #HandleSize     , #HandleSize * 2, #HandleSize * 2, $CDCDCD)
        Box(\x + \w - #HandleSize, \y - #HandleSize     , #HandleSize * 2, #HandleSize * 2, $CDCDCD)
        Box(\x - #HandleSize     , \y + \h - #HandleSize, #HandleSize * 2, #HandleSize * 2, $CDCDCD)
        Box(\x + \w - #HandleSize, \y + \h - #HandleSize, #HandleSize * 2, #HandleSize * 2, $CDCDCD)
        
      EndWith
    Next
    
    StopDrawing()
  EndIf
  
EndProcedure
Phil
Beiträge: 32
Registriert: 05.07.2006 10:46

Re: Layout Programm im CanvasGadget

Beitrag von Phil »

Es ist immer interessant zu sehen, wie andere so ein Problem lösen. :D
Du hast eine Möglichkeit, das Hovern ohne Drawing zu checken. Das möchte ich jedoch nur im Notfall machen, da es wohl fürchterlich aufwendig wird,wenn die Objekte gedreht werden oder einmal nicht rechteckig sind. Da ist die VectorBibliothek schon sehr komfortabel.
Was mich in dieser Sache jetzt schon sehr zuverlässig stimmt, ist ein Belastungstest ohne Images:
Wenn ich alles so lasse (bis auf ein Delay(1)) und 100 Objekte bei jedem MouseMove zeichne, ist die Auslastung bei nur ca 10%!
Ich werde das noch ein bisschen austüfteln und dann zum Testen hier posten. Aber wenn das Vectordrawing so schnell ist, wäre das Klasse.
PB 5.62 on Win10
Phil
Beiträge: 32
Registriert: 05.07.2006 10:46

Re: Layout Programm im CanvasGadget

Beitrag von Phil »

Hallo,
nun hat es doch etwas gedauert und an dem eigentlichen Problem habe ich nicht allzuviel gemacht :oops: , aber die Funktionalität hat sich etwas erweitert:
- Verschieben ist nun ohne vorherige Auswahl möglich. (Der Mittlere Anfasser ist z. Zt. nur Zierde)
- Skalieren mit den Anfassern
- Verschieben mit gedrückter mittlerer Maustaste
- Zoomen mit festem Zentrum

Ansonsten habe ich geändert, dass nun die Grafiken nicht während dem Verschieben etc. gezeichnet werden und die Testgrafik automatisch erstellt wird.
Beim Skalieren passieren noch seltsame Dinge, wenn man die Ecken übereinander zieht...

Würde mich freuen, wenn es jemand testet und bin für jeden guten Rat dankbar. :D

Grüße,
Phil

Code: Alles auswählen

; ------------------------------------------------------------
;
;   Layout Software - Canvas Vector Test
;
;    (c) Phil
;
; ------------------------------------------------------------
;

;- ToDo Liste

; Resize begrenzen bei Übergang zu 0 Breite oder Höhe
; kein Testbild laden, sondern einen Screenshot der Fenster als Testimage verwenden.
; Nur gefüllte Rahmen zeichnen in DrawAll() ermöglichen, ohne Images.besser nur selObj zeichnen.
; wenn kein mousemove, nach 500ms neu ganz zeichnen, sonst nur Rahmen.
; Textdraw testen in Objekt. Evtl mit Bild im Hintergrund.
; Ausdruck ermöglichen in PrintAll()
; Linien hinter Text setzen.



; Erledigt:

; Mausposition global direct bei Draw abfragen. vorallem bei flgCheck.
; Bei RedrawAll Check statt Blank als Zusatzoption auswählen können, nicht alternativ, also flgQuick.b=#False, flgCheck.b=#True
; Bei RedrawSelection check von drawing trennen.
; Bei Resize die Position der Maus auf dem Handle beibehalten.



EnableExplicit

UsePNGImageDecoder()


;- Constants

#TestObjCnt=10
#FlgDrawImages=#True



#testImage = 7
#Handle_Radius=3.0

#Paper_Width=210
#Paper_Height=297



Enumeration DrawMode
  #DrawMode_Blank
  #DrawMode_NoImages
  #DrawMode_OnlySelection
  #DrawMode_All
EndEnumeration


Enumeration Mode
  #Mode_None
  #Mode_Move
  #Mode_Resize
  #Mode_Pan
  #Mode_Zoom
EndEnumeration


;- Gadgets
#G_Canvas=5


;- Structures

Structure Object
  name.s
  image.i
  text.s
  x.f
  y.f
  w.f
  h.f
  flgMouseover.b
  flgSelected.b
EndStructure


;- Global 


Global Event.i
Global EventGadget.i
Global EventType.i
Global EventTimer.i

Global gWidth.f
Global gHeight.f
Global gViewWidth.f
Global gViewHeight.f
Global gOldViewMiddleX.f
Global gOldViewMiddleY.f
Global gViewMiddleX.f
Global gViewMiddleY.f


Global gMouseX.f
Global gMouseY.f
Global gOldMouseX.f
Global gOldMouseY.f

Global gRelativeSelObjMouseX.f
Global gRelativeSelObjMouseY.f

Global gScaleKoords.f = 1.0

Global gPanKoordsX.f = 0.0
Global gPanKoordsY.f = 0.0
Global gRelPanKoordsX.f = 0.0
Global gRelPanKoordsY.f = 0.0

Global gCurHandleX.f 
Global gCurHandleY.f 
Global gRelHandleX.f = 0.0
Global gRelHandleY.f = 0.0

Global gMode.i

Global NewList objList.Object()
Global *gHighestMouseOverObj


Global *gOldSelectedObj.Object ; Hier wird die Adresse des ListenElements gespeichert.
Global *gSelectedObject.Object ; Hier wird die Adresse des ListenElements gespeichert.
Global gFlgSelectedObj.b
Global gFlgMouseOverSelectedObj.b

Global gFlgMouseOverAnyObj.b
Global gFlgMouseOverHandleNb.b


Global gFlgGridSnap.i=#False

Global gOldObj.Object


;- Procedures

Procedure CreateObject()
  
  AddElement(objList())
  
  With objList()
    \name = "test"
    \image = #testImage
    \x = Random(100,10)
    \y = Random(100,10)
    \w = Random(100,10)
    \h = Random(100,10)
  EndWith
  
EndProcedure

Procedure MoveObj()
  
  Protected x.f, y.f
  
  x = gMouseX
  y = gMouseY

  
  With objList()
  \x=x-gRelativeSelObjMouseX
  \y=y-gRelativeSelObjMouseY
  If gFlgGridSnap
    ;Make it eventually snap to a grid??
    \x=Round(\x,#PB_Round_Nearest)
    \y=Round(\y,#PB_Round_Nearest)
  EndIf
  EndWith
  
EndProcedure

Procedure ResizeObj(HandleNb.i)
  
  Protected x.f, y.f
  
  x = gMouseX-gRelHandleX
  y = gMouseY-gRelHandleY

  
  With objList()
    
    Select HandleNb
      Case 1
        \x = x
        \y = y
        \w = (gOldObj\x - x + gOldObj\w)
        \h = (gOldObj\y - y + gOldObj\h)        
        If \w < 10: \w = 10 :EndIf
      Case 2
        \x = gOldObj\x
        \y = y
        \w = (x-gOldObj\x)
        \h = (gOldObj\y - y + gOldObj\h)        
      
      Case 3
        \x = gOldObj\x
        \y = gOldObj\y
        \w = (x-gOldObj\x)
        \h = (y-gOldObj\y)
      
      Case 4
        \x = x
        \y = gOldObj\y
        \w = (gOldObj\x - x + gOldObj\w)
        \h = (y-gOldObj\y)        
      
        
    EndSelect
    
  EndWith
  
EndProcedure

Procedure RedrawBackground(drawMode.b)
  
  Select drawMode
    Case #DrawMode_All,#DrawMode_OnlySelection,#DrawMode_NoImages
      ;Clear whole Canvas and draw sheet of Paper.
      VectorSourceColor(RGBA(100,100,100, 255))
      FillVectorOutput()
      
      VectorSourceColor(RGBA(50,50,50, 255))
      AddPathBox(1.5,1.5,#Paper_Width,#Paper_Height)
      FillPath()
      VectorSourceColor(RGBA(240,240,240, 255))
      AddPathBox(0,0,#Paper_Width,#Paper_Height)
      FillPath()
      
    Case #DrawMode_Blank
  EndSelect
  
EndProcedure

Procedure RedrawObjects(drawMode.b, flgCheck.b)
  
  Protected x.f, y.f, result.b
  Protected colorNorm.l, colorMO.l, colorHigh.l,curColor.l
  
  colorNorm=RGBA(0, 255, 0, 255)
  colorMO = RGBA(255, 255, 0, 255)
  colorHigh= RGBA(255, 50, 0, 255)
  
  x = gMouseX
  y = gMouseY
  
  ;Here starts checking.
  If flgCheck
    gFlgMouseOverAnyObj = #False
    
    ;Check all Objects for MouseOver by silently drawing the frames.
    ForEach objList()
      With objList()
        
        
        
        AddPathBox(\x, \y,\w ,\h)
        
        ;If Mode_Move, set new position of selObj
        If @objList()=*gSelectedObject
          Select gMode            
            Case #Mode_Move
              MoveObj()
            Case #Mode_Resize
              ResizeObj(gFlgMouseOverHandleNb)
          EndSelect
        EndIf
        
        If IsInsidePath(x, y, #PB_Coordinate_User)
          \flgMouseover=#True
          *gHighestMouseOverObj=@objList()
          gFlgMouseOverAnyObj=#True
        Else
          \flgMouseover=#False
        EndIf
        
        ResetPath(); No drawing, just checking.
      EndWith
    Next
  EndIf

  
  ;Here starts real drawing.
  If DrawMode<>#DrawMode_Blank
    
    ForEach objList()
      
      With objList()
        
        
        
        ;Draw frame around Object according to Mouseover state.
        AddPathBox(\x, \y,\w ,\h)
        
        If \flgMouseover
          If @objList()=*gHighestMouseOverObj ; If Object is highest, colour differently.
            curColor=colorHigh
          Else
            curColor=colorMO
          EndIf
        Else
          curColor=colorNorm
        EndIf
        VectorSourceColor(RGBA(200,200,200,255))
        FillPath(#PB_Path_Preserve)
        VectorSourceColor(curColor)
        StrokePath(ConvertCoordinateX(0.4,0,#PB_Coordinate_Output,#PB_Coordinate_User)-ConvertCoordinateX(0,0,#PB_Coordinate_Output,#PB_Coordinate_User))  
        
        ;Draw Image and PathBox
        If DrawMode=#DrawMode_All
          MovePathCursor(\x,\y)
          DrawVectorImage(ImageID(\image),255,Abs(\w),Abs(\h))    
        EndIf
      EndWith
    Next
  EndIf
  
  
EndProcedure

Procedure RedrawSelection(DrawMode.b,flgCheck.b)
  
  Protected hR.f
  Protected x.f, y.f
  
  PushListPosition(objList())
  
  x = gMouseX
  y = gMouseY
  
  hR = ConvertCoordinateX(#Handle_Radius,0,#PB_Coordinate_Output,#PB_Coordinate_User)-ConvertCoordinateX(0,0,#PB_Coordinate_Output,#PB_Coordinate_User)
  
  gFlgMouseOverHandleNb=#False
  
  If gFlgSelectedObj
    
    ChangeCurrentElement(objList(),*gSelectedObject)
    
    With objList()
      
      If  flgCheck
        ;BlankDraw HandleCircles around selectedObject and check for MouseOver.
        AddPathCircle(\x,\y,hR)
        If Not gFlgMouseOverHandleNb And IsInsidePath(x, y, #PB_Coordinate_User) : gFlgMouseOverHandleNb=1 : EndIf     
        AddPathCircle(\x+\w,\y,hR)
        If Not gFlgMouseOverHandleNb And IsInsidePath(x, y, #PB_Coordinate_User) : gFlgMouseOverHandleNb=2 : EndIf
        AddPathCircle(\x+\w,\y+\h,hR)
        If Not gFlgMouseOverHandleNb And IsInsidePath(x, y, #PB_Coordinate_User) : gFlgMouseOverHandleNb=3 : EndIf
        AddPathCircle(\x,\y+\h,hR)
        If Not gFlgMouseOverHandleNb And IsInsidePath(x, y, #PB_Coordinate_User) : gFlgMouseOverHandleNb=4 : EndIf
        AddPathCircle(\x+\w/2,\y+\h/2,hR)
        If Not gFlgMouseOverHandleNb And IsInsidePath(x, y, #PB_Coordinate_User) : gFlgMouseOverHandleNb=5 : EndIf
        ResetPath()
      EndIf
      
      If DrawMode<>#DrawMode_Blank
        ;Draw frame around Object.
        AddPathBox(\x,\y,\w,\h)
        VectorSourceColor(RGBA(50,50,255,100))
        DashPath(ConvertCoordinateX(0.6,0,#PB_Coordinate_Output,#PB_Coordinate_User)-ConvertCoordinateX(0,0,#PB_Coordinate_Output,#PB_Coordinate_User),2.0)
        
        ;Draw HandleCircles round selectedObject and check for MouseOver.
        AddPathCircle(\x,\y,hR)
        AddPathCircle(\x+\w,\y,hR)
        AddPathCircle(\x+\w,\y+\h,hR)
        AddPathCircle(\x,\y+\h,hR)
        AddPathCircle(\x+\w/2,\y+\h/2,hR)
        
        VectorSourceColor(RGBA(50,50,255,150))
        FillPath()
      EndIf
      
      
    EndWith
  EndIf
  
  PopListPosition(objList())
  
EndProcedure
  

Procedure.b RedrawAll(drawMode=#DrawMode_All,flgCheck.b=#True); Gives #True, if Changes were made while checking.
  
  Protected x.f,y.f,result.b = #False, start.i

  start = ElapsedMilliseconds()
  
  x=GetGadgetAttribute(#G_Canvas,#PB_Canvas_MouseX)
  y=GetGadgetAttribute(#G_Canvas,#PB_Canvas_MouseY)
  
  If StartVectorDrawing(CanvasVectorOutput(#G_Canvas,#PB_Unit_Millimeter))
    
    Protected i.i, imgWidth.f, imgHeight.f
    
    ;Scale everything according to ScaleKoords (by Mousewheel).
    ScaleCoordinates(gScaleKoords,gScaleKoords) 
    
    ; Prepare to pan, so the middle of the Canvas stays where it is, when zooming.
    If gMode=#Mode_Zoom
      gPanKoordsX=(ConvertCoordinateX(450,450,#PB_Coordinate_Device,#PB_Coordinate_User)-gViewMiddleX) ;neue gviewMiddle - alte gviewMiddle
      gPanKoordsY=(ConvertCoordinateY(450,450,#PB_Coordinate_Device,#PB_Coordinate_User)-gViewMiddleY)
      gMode=#Mode_None  
    EndIf
    
    ;Pan to the right spot.
    TranslateCoordinates(gPanKoordsX+gRelPanKoordsX,gPanKoordsY+gRelPanKoordsY)    
    
    ;Refresh the mousePos in mm on the canvas.
    gMouseX = ConvertCoordinateX(x,y,#PB_Coordinate_Device,#PB_Coordinate_User)
    gMouseY = ConvertCoordinateY(x,y,#PB_Coordinate_Device,#PB_Coordinate_User)
    
    
    If gMode=#Mode_Pan
      gRelPanKoordsX=gMouseX-ConvertCoordinateX(gOldMouseX,gOldMouseY,#PB_Coordinate_Device,#PB_Coordinate_User)
      gRelPanKoordsY=gMouseY-ConvertCoordinateY(gOldMouseX,gOldMouseY,#PB_Coordinate_Device,#PB_Coordinate_User)
    EndIf
    
    
;     gWidth = VectorOutputWidth()
;     gHeight = VectorOutputHeight()
    
    ;Refresh the new middle of the Canvas in mm.
    gViewMiddleX = ConvertCoordinateX(450,450,#PB_Coordinate_Device,#PB_Coordinate_User)
    gViewMiddleY = ConvertCoordinateY(450,450,#PB_Coordinate_Device,#PB_Coordinate_User)
    
    
    RedrawBackground(drawMode)
    
    ;Draw objects and check for mouseover.
    RedrawObjects(drawMode,flgCheck)
    
    
    RedrawSelection(drawMode,flgCheck)
    
    
    StopVectorDrawing()
  EndIf
  
  
  ;If changes there, then result is #True.
  If flgCheck
    Static NewList oldObjList.Object()
    ResetList(oldObjList())
    If ListSize(objList())<>ListSize(oldObjList())
;       Debug "ungleiche Listsize"
    Else
      
      ForEach objList()
        With objList()
          NextElement(oldObjList())
          If \flgMouseover<>oldObjList()\flgMouseover Or \x<>oldObjList()\x Or \y<>oldObjList()\y Or \w<>oldObjList()\w Or \h<>oldObjList()\h 
            result=#True
            Break
          EndIf
        EndWith
      Next
    EndIf
    
    If *gSelectedObject<>*gOldSelectedObj
      result=#True
;       Debug "selObj"
    EndIf
    *gOldSelectedObj=*gSelectedObject 
    CopyList(objList(),oldObjList())
  EndIf
  
  Debug "DrawZeit: " + Str(ElapsedMilliseconds()-start)
  ProcedureReturn result
  
EndProcedure

Procedure SetRelHandle()
  
  ChangeCurrentElement(objList(),*gSelectedObject)
  With objList()
    
    Select gFlgMouseOverHandleNb
      Case 1
        gRelHandleX=gMouseX-\x
        gRelHandleY=gMouseY-\y
        
      Case 2
        gRelHandleX=gMouseX-\x-\w
        gRelHandleY=gMouseY-\y
        
      Case 3
        gRelHandleX=gMouseX-\x-\w
        gRelHandleY=gMouseY-\y-\h
        
      Case 4
        gRelHandleX=gMouseX-\x
        gRelHandleY=gMouseY-\y-\h
        
    EndSelect
    
  EndWith
  
EndProcedure

Procedure SetRelMousePos()
    
  ChangeCurrentElement(objList(),*gSelectedObject)
  gRelativeSelObjMouseX = gMouseX- objList()\x
  gRelativeSelObjMouseY = gMouseY- objList()\y
  
EndProcedure

Procedure PrintAll()
  
  Debug "PrintAll"

  
EndProcedure


;- Main

Define file.s
Define i.i


If OpenWindow(0, 0, 0, 900, 900, "VectorDrawing", #PB_Window_SystemMenu | #PB_Window_ScreenCentered|#PB_Window_MaximizeGadget)
  CanvasGadget(#G_Canvas, 0, 0, 900, 900,#PB_Canvas_Keyboard|#PB_Canvas_Container)
  AddWindowTimer(0,0,500)
  
  
  
  ;   file = OpenFileRequester("Wähle Bilddatei (.png) aus.",GetCurrentDirectory(),"png-Image|*.png",0)
;   file = "image.png"
;   If Not LoadImage(#testImage, file):MessageRequester("Fehler", "Ohne Bild kein Programm! ;-)"):End:EndIf
;   ResizeImage(#testImage,500,700)
;   
  gMode = #Mode_None
  
  CreateImage(#testImage,500,700,24,RGB(255,255,255))
  
  For i=0 To #TestObjCnt-1
    CreateObject()
  Next
  
  RedrawAll()
  StartDrawing(ImageOutput(#testImage))
  
  DrawImage(GetGadgetAttribute(#G_Canvas,#PB_Canvas_Image),0,0)
  StopDrawing()
  
  
  
  ;Initial drawing
  RedrawAll()
  
  ;- Event-Loop
   
  Repeat
    Event = WaitWindowEvent()
    
    EventGadget = EventGadget()
    EventType = EventType()
    EventTimer= EventTimer()
    
;     If Event=#PB_Event_Timer
;       Select EventTimer
;         Case 0
;           RedrawAll(GetGadgetAttribute(#G_Canvas,#PB_Canvas_MouseX),GetGadgetAttribute(#G_Canvas,#PB_Canvas_MouseY),#True,#False)
;           RedrawAll(GetGadgetAttribute(#G_Canvas,#PB_Canvas_MouseX),GetGadgetAttribute(#G_Canvas,#PB_Canvas_MouseY),#False,#False)
;           
;       EndSelect
;     EndIf
;     
    
    
    If Event=#PB_Event_Gadget
      
      Select EventGadget
        Case #G_Canvas ;CanvasGadget Event
          Select EventType
              
            Case #PB_EventType_MouseMove

              ;Refresh Canvas on every move. and check for MouseOver!
              If RedrawAll(#DrawMode_Blank,#True)
                ;                 Debug FormatDate("%hh:%ii:%ss", Date())
;                 RedrawAll(#DrawMode_All,#False)
              EndIf
;               RedrawAll(#DrawMode_NoImages)
              
              ;If Handle MouseOver, show hand symbol.
              If gFlgMouseOverHandleNb
                SetGadgetAttribute(#G_Canvas,#PB_Canvas_Cursor,#PB_Cursor_Hand)
                
              Else
                SetGadgetAttribute(#G_Canvas,#PB_Canvas_Cursor,#PB_Cursor_Default)
              EndIf
              
              ;If MouseLeftButton, redrawAll for moved object
              If GetGadgetAttribute(#G_Canvas,#PB_Canvas_Buttons) = #PB_Canvas_LeftButton
                RedrawAll(#DrawMode_NoImages)
              EndIf
              
              ;If MouseMiddleButton, redrawAll for panned view
              If GetGadgetAttribute(#G_Canvas,#PB_Canvas_Buttons) = #PB_Canvas_MiddleButton
                RedrawAll(#DrawMode_NoImages)
              EndIf
              
              
            Case #PB_EventType_LeftButtonDown 
              
                ;Only set new selected Object if LeftClick was not on selObj or Handle!              
                If Not gFlgSelectedObj Or Not(gFlgMouseOverHandleNb Or *gSelectedObject\flgMouseOver)
                  *gSelectedObject=*gHighestMouseOverObj 
                  gFlgSelectedObj=#True
                EndIf
                
                ;If clicked outside of Objects and Handles, unselect Objects.
                If gFlgSelectedObj And Not gFlgMouseOverAnyObj And Not gFlgMouseOverHandleNb
                  *gSelectedObject=0
                  gFlgSelectedObj=#False
                EndIf
                
                
                ;If clicked on selObj, start move and register rel pos of Cursor.
                If gFlgSelectedObj And *gSelectedObject\flgMouseOver
                  gMode = #Mode_Move
                  SetRelMousePos()
                EndIf
                
                If gFlgMouseOverHandleNb And gFlgSelectedObj
                  ChangeCurrentElement(objList(),*gSelectedObject)
                  gOldObj=objList(); alte Pos und Dim merken für Resize
                  SetRelHandle()
                  gMode = #Mode_Resize
                EndIf
              

            Case #PB_EventType_LeftButtonUp              
              gMode = #Mode_None
              RedrawAll()
              
            Case #PB_EventType_MiddleButtonDown
              gMode = #Mode_Pan
              gRelPanKoordsX=0
              gRelPanKoordsY=0
              gOldMouseX=GetGadgetAttribute(#G_Canvas,#PB_Canvas_MouseX)
              gOldMouseY=GetGadgetAttribute(#G_Canvas,#PB_Canvas_MouseY)
              
            Case #PB_EventType_MiddleButtonUp
              gMode = #Mode_None
              gPanKoordsX+gRelPanKoordsX
              gRelPanKoordsX=0
              gPanKoordsY+gRelPanKoordsY
              gRelPanKoordsY=0
              RedrawAll()
              
            Case #PB_EventType_MouseWheel
              Define delta.i
              delta =GetGadgetAttribute(#G_Canvas,#PB_Canvas_WheelDelta)
              If GetGadgetAttribute(#G_Canvas,#PB_Canvas_Modifiers) = #PB_Canvas_Control
                gMode = #Mode_Zoom
                gScaleKoords*(1.0+delta*0.2)
                If gScaleKoords<0.3: gScaleKoords=0.3:EndIf
                If gScaleKoords>3.0: gScaleKoords=3.0:EndIf
                RedrawAll();#DrawMode_NoImages)
              EndIf
              
                            
            Case #PB_EventType_KeyDown
              If GetGadgetAttribute(#G_Canvas,#PB_Canvas_Modifiers) = #PB_Canvas_Control And GetGadgetAttribute(#G_Canvas,#PB_Canvas_Key) = #PB_Shortcut_P
                PrintAll()
              EndIf
                  
          EndSelect
            
        EndSelect
      EndIf
      
      Delay(5)

    Until Event = #PB_Event_CloseWindow
  EndIf
  
PB 5.62 on Win10
Antworten