CanvasGadget Catch or Grab

[mk-soft]

Maybe somebody could use it...

To save image, copy to another gadget, etc

Update Example
- Add Save

Update v1.03
- Check StartDrawing

Code: Select all

;-TOP

; Comment : CanvasGadget Catch or Grab
; Author  : mk-soft
; Version : v1.03.0
; Create  : 06.02.2020

Procedure CatchCanvas(Gadget, Image = #PB_Any, Depth = 32, Scale = #False)
  Protected r1, id, dx, dy
  If Scale
    dx = DesktopScaledX(GadgetWidth(Gadget))
    dy = DesktopScaledY(GadgetHeight(Gadget))
  Else
    dx = GadgetWidth(Gadget)
    dy = GadgetHeight(Gadget)
  EndIf
  r1 = CreateImage(Image, dx, dy, Depth)
  If r1
    If Image = #PB_Any
      id = r1
    Else  
      id = Image
    EndIf
    If StartDrawing(ImageOutput(id))
      DrawImage(GetGadgetAttribute(Gadget, #PB_Canvas_Image), 0, 0, dx, dy)
      StopDrawing()
    Else
      FreeImage(r1)
      r1 = 0
    EndIf
  EndIf
  ProcedureReturn r1
EndProcedure

Procedure GrabCanvas(Gadget, Image, x, y, Width, Height, Depth = 32, Scale = #False)
  Protected r1, id, dx, dy
  If Scale
    x = DesktopScaledX(x)
    y = DesktopScaledX(y)
    Width = DesktopScaledX(Width)
    Height = DesktopScaledY(Height)
  EndIf
  r1 = CreateImage(Image, Width, Height, Depth)
  If r1
    If Image = #PB_Any
      id = r1
    Else  
      id = Image
    EndIf
    If StartDrawing(ImageOutput(id))
      DrawImage(GetGadgetAttribute(Gadget, #PB_Canvas_Image), 0 - x, 0 - y)
      StopDrawing()
    Else
      FreeImage(r1)
      r1 = 0
    EndIf
  EndIf
  ProcedureReturn r1
EndProcedure

; ****

;- Example

CompilerIf #PB_Compiler_IsMainFile
  
  Enumeration Windows
    #Main
  EndEnumeration
  
  Enumeration Gadgets
    #Canvas
    #Button_Catch
    #Button_Grab
    #Button_Save
  EndEnumeration
  
  Enumeration Status
    #MainStatusBar
  EndEnumeration
  
  Enumeration Images
    #Image_Canvas
  EndEnumeration
  
  Procedure DrawCanvas(Gadget)
    Protected dx, dy
    If StartDrawing(CanvasOutput(Gadget))
      dx = GadgetWidth(Gadget)
      dy = GadgetHeight(Gadget)
      Box(0, 0, dx, dy, $8B8B00)
      DrawingMode(#PB_2DDrawing_Outlined)
      Box(10 + 1, 10 + 1, dx - 20, dy - 20, #White)
      Box(10, 10, dx - 20, dy - 20, #Black)
      DrawingMode(#PB_2DDrawing_Default)
      DrawText(25, 25, " < I like Purebasic > ", #White, #Blue)
      StopDrawing()
    EndIf
    
  EndProcedure
  
  Procedure SaveCanvasImage(Gadget)
    Protected r1, file.s, image
    file = SaveFileRequester("Save Image", "Image.bmp", "", 0)
    If file
      image = CatchCanvas(Gadget, #PB_Any)
      If image
        r1 = SaveImage(image, file)
        FreeImage(image)
      EndIf
    EndIf
    ProcedureReturn r1
  EndProcedure
  
  Procedure Main()
    
    If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, 600, 400, "Window" , #PB_Window_SystemMenu)
      CanvasGadget(#Canvas, 10, 10, 580, 380, #PB_Canvas_Container)
      ButtonGadget(#Button_Catch, 20, 335, 120, 25, "Catch")
      ButtonGadget(#Button_Grab, 150, 335, 120, 25, "Grab")
      ButtonGadget(#Button_Save, 280, 335, 120, 25, "Save")
      DrawCanvas(#Canvas)
      
      Repeat
        Select WaitWindowEvent()
          Case #PB_Event_CloseWindow
            Break
          Case #PB_Event_Gadget
            Select EventGadget()
              Case #Button_Catch
                If CatchCanvas(#Canvas, #Image_Canvas)
                  ShowLibraryViewer("Image", #Image_Canvas)
                EndIf
              Case #Button_Grab
                If GrabCanvas(#Canvas, #Image_Canvas, 15, 15, 200, 40, 24)
                  ShowLibraryViewer("Image", #Image_Canvas)
                EndIf
              Case #Button_Save
                SaveCanvasImage(#Canvas)
                
            EndSelect
            
        EndSelect
      ForEver
      
    EndIf
    
  EndProcedure : Main()
  
CompilerEndIf

[Mijikai]

Neat idea
You forgot errorhandling for StartDrawing().

[mk-soft]

Update v1.03
- Check StartDrawing

Ok

[hoerbie]

Nice tool,thanks. Actually having someproblems with Canvas, Grab und Draw on Mac, so will give it a try.

[Kwai chang caine]

Thanks for sharing

[davido]

Very nice, thank you.