Draw to PB image without 2DDrawing functions

Share your advanced PureBasic knowledge/code with the community.
sverson
Enthusiast
Enthusiast
Posts: 286
Joined: Sun Jul 04, 2004 12:15 pm
Location: Germany

Draw to PB image without 2DDrawing functions

Post by sverson »

Code updated For 5.20+

Code: Select all

    ;/ sverson 06/06 | PB4 final
    ;/ Draw to PB image without 2DDrawing lib

    Global MainWindowNo.l, MainWindowID.l
    Global ImageNo.l, ImageID.l, ImWidth.l, ImHeight.l, ImBytes.l, ImLine.l, *Image
    Global ImageGG.l

    Structure RGB
      Blue.c
      Green.c
      Red.c
    EndStructure

    Procedure.l InitImage()
      *Image = 0
      ;ImageNo.l = LoadImage(#PB_Any,"C:\test.bmp") ; load your own image
      ImageNo.l = CatchImage(#PB_Any,?BitMap_bmp_Start) : ResizeImage(ImageNo,400,400,#PB_Image_Raw)
      ImageID.l = ImageID(ImageNo)
      If GetObject_(ImageID, SizeOf(BITMAP), @ImageInfo.BITMAP)
        ImWidth  = ImageInfo\bmWidth
        ImHeight = ImageInfo\bmHeight
        ImBytes  = ImageInfo\bmBitsPixel/8
        ImLine   = ImWidth*ImBytes
        *Image   = ImageInfo\bmBits
      EndIf
      ProcedureReturn *Image
    EndProcedure

    Procedure ImageColorXor()
      Protected ImRow.l, ImCol.l, *Point.RGB
      For ImRow=0 To ImHeight-1
        For ImCol=0 To ImWidth-1
          *Point = *Image + (ImCol*ImBytes) + (ImRow*ImLine)
          *Point\Red   ! *Point\Green
          *Point\Green ! *Point\Blue
          *Point\Blue  ! *Point\Red
        Next
      Next
    EndProcedure

    Procedure OpenMainWindow()
      MainWindowNo = OpenWindow(#PB_Any,0,0,0,0,"click on image to change color!",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
      If MainWindowNo
        MainWindowID = WindowID(MainWindowNo)
;         If CreateGadgetList(MainWindowID)
          If InitImage()
            ImageGG = ImageGadget(#PB_Any,10,10,0,0,ImageID)
            ResizeWindow(MainWindowNo,#PB_Ignore,#PB_Ignore,ImageWidth(ImageNo)+20,ImageHeight(ImageNo)+20)
            ProcedureReturn #True
          EndIf
;         EndIf
      EndIf
      ProcedureReturn #False
    EndProcedure

    Procedure CloseMainWindow()
      If IsImage(ImageNo) : FreeImage(ImageNo) : EndIf
      If IsWindow(MainWindowNo) : CloseWindow(MainWindowNo) : EndIf
    EndProcedure

    Procedure MainEventHandler()
      Protected ImageWindowEvent.l
      Repeat
        ImageWindowEvent = WaitWindowEvent()
        If ImageWindowEvent = #PB_Event_Gadget
          If EventGadget() = ImageGG
            ImageColorXor()
            SetGadgetState(ImageGG,ImageID)
          EndIf
        EndIf
      Until ImageWindowEvent = #PB_Event_CloseWindow
    EndProcedure

    If OpenMainWindow()
      MainEventHandler()
    EndIf
    CloseMainWindow()

    End

    DataSection
    BitMap_bmp_Start:
    Data.l $04E84D42,$00000000,$00360000,$00280000,$00140000,$00140000,$00010000,$00000018,$00000000,$0B120000,$0B120000,$00000000
    Data.l $00000000,$FFFF0000,$00FFFFFF,$FFFFFFFF,$FFFF00FF,$00FFFFFF,$FFFFFFFF,$FFFF00FF,$00FFFFFF,$FFFFFFFF,$FFFF00FF,$00FFFFFF
    Data.l $FFFFFFFF,$FFFF00FF,$00FFFFFF,$FFFFFFFF,$FFFF00FF,$FFFFFF00,$FF00FFFF,$FFFFFFFF,$FFFFFF00,$FF00FFFF,$FFFFFFFF,$FFFFFF00
    Data.l $FF00FFFF,$FFFFFFFF,$FFFFFF00,$FF00FFFF,$FFFFFFFF,$FFFFFF00,$FF00FFFF,$FFFFFFFF,$00FF00FF,$00FFFFFF,$FFFF00FF,$00FF00FF
    Data.l $00FFFFFF,$FFFF00FF,$00FF00FF,$00FFFFFF,$FFFF00FF,$00FF00FF,$00FFFFFF,$FFFF00FF,$00FF00FF,$00FFFFFF,$FF0000FF,$FFFFFF00
    Data.l $FF00FF00,$FF00FFFF,$FFFFFF00,$FF00FF00,$FF00FFFF,$FFFFFF00,$FF00FF00,$FF00FFFF,$FFFFFF00,$FF00FF00,$FF00FFFF,$FFFFFF00
    Data.l $FF00FF00,$FFFFFFFF,$0000FFFF,$FFFFFFFF,$FFFF0000,$0000FFFF,$FFFFFFFF,$FFFF0000,$0000FFFF,$FFFFFFFF,$FFFF0000,$0000FFFF
    Data.l $FFFFFFFF,$FFFF0000,$0000FFFF,$FFFFFFFF,$00FF0000,$FFFFFF00,$FF0000FF,$00FFFFFF,$FFFFFF00,$FF0000FF,$00FFFFFF,$FFFFFF00
    Data.l $FF0000FF,$00FFFFFF,$FFFFFF00,$FF0000FF,$00FFFFFF,$FFFFFF00,$FF0000FF,$FFFFFFFF,$FF0000FF,$00FFFFFF,$FFFFFF00,$FF0000FF
    Data.l $00FFFFFF,$FFFFFF00,$FF0000FF,$00FFFFFF,$FFFFFF00,$FF0000FF,$00FFFFFF,$FFFFFF00,$FF0000FF,$00FFFFFF,$0000FF00,$FFFFFFFF
    Data.l $FFFF0000,$0000FFFF,$FFFFFFFF,$FFFF0000,$0000FFFF,$FFFFFFFF,$FFFF0000,$0000FFFF,$FFFFFFFF,$FFFF0000,$0000FFFF,$FFFFFFFF
    Data.l $FFFF0000,$FFFFFFFF,$FFFF00FF,$00FFFFFF,$FFFFFFFF,$FFFF00FF,$00FFFFFF,$FFFFFFFF,$FFFF00FF,$00FFFFFF,$FFFFFFFF,$FFFF00FF
    Data.l $00FFFFFF,$FFFFFFFF,$FFFF00FF,$00FFFFFF,$FF00FFFF,$FFFFFFFF,$FFFFFF00,$FF00FFFF,$FFFFFFFF,$FFFFFF00,$FF00FFFF,$FFFFFFFF
    Data.l $FFFFFF00,$FF00FFFF,$FFFFFFFF,$FFFFFF00,$FF00FFFF,$FFFFFFFF,$FFFFFF00,$FFFFFFFF,$FF00FFFF,$FFFFFFFF,$FFFFFF00,$FF00FFFF
    Data.l $FFFFFFFF,$FFFFFF00,$FF00FFFF,$FFFFFFFF,$FFFFFF00,$FF00FFFF,$FFFFFFFF,$FFFFFF00,$FF00FFFF,$FFFFFFFF,$00FFFF00,$FFFFFFFF
    Data.l $FFFF00FF,$00FFFFFF,$FFFFFFFF,$FFFF00FF,$00FFFFFF,$FFFFFFFF,$FFFF00FF,$00FFFFFF,$FFFFFFFF,$FFFF00FF,$00FFFFFF,$FFFFFFFF
    Data.l $FFFF00FF,$FFFFFFFF,$00FFFFFF,$FFFFFFFF,$FFFF00FF,$00FFFFFF,$FFFFFFFF,$FFFF00FF,$00FFFFFF,$FFFFFFFF,$FFFF00FF,$00FFFFFF
    Data.l $FFFFFFFF,$FFFF00FF,$00FFFFFF,$FFFFFFFF,$FFFF00FF,$FFFFFF00,$FF00FFFF,$FFFFFFFF,$FFFFFF00,$FF00FFFF,$FFFFFFFF,$FFFFFF00
    Data.l $FF00FFFF,$FFFFFFFF,$FFFFFF00,$FF00FFFF,$FFFFFFFF,$FFFFFF00,$FF00FFFF,$FFFFFFFF,$00FF00FF,$00FFFFFF,$FFFF00FF,$00FF00FF
    Data.l $00FFFFFF,$FFFF00FF,$00FF00FF,$00FFFFFF,$FFFF00FF,$00FF00FF,$00FFFFFF,$FFFF00FF,$00FF00FF,$00FFFFFF,$FF0000FF,$FFFFFF00
    Data.l $FF00FF00,$FF00FFFF,$FFFFFF00,$FF00FF00,$FF00FFFF,$FFFFFF00,$FF00FF00,$FF00FFFF,$FFFFFF00,$FF00FF00,$FF00FFFF,$FFFFFF00
    Data.l $FF00FF00,$FFFFFFFF,$0000FFFF,$FFFFFFFF,$FFFF0000,$0000FFFF,$FFFFFFFF,$FFFF0000,$0000FFFF,$FFFFFFFF,$FFFF0000,$0000FFFF
    Data.l $FFFFFFFF,$FFFF0000,$0000FFFF,$FFFFFFFF,$00FF0000,$FFFFFF00,$FF0000FF,$00FFFFFF,$FFFFFF00,$FF0000FF,$00FFFFFF,$FFFFFF00
    Data.l $FF0000FF,$00FFFFFF,$FFFFFF00,$FF0000FF,$00FFFFFF,$FFFFFF00,$FF0000FF,$FFFFFFFF,$FF0000FF,$00FFFFFF,$FFFFFF00,$FF0000FF
    Data.l $00FFFFFF,$FFFFFF00,$FF0000FF,$00FFFFFF,$FFFFFF00,$FF0000FF,$00FFFFFF,$FFFFFF00,$FF0000FF,$00FFFFFF,$0000FF00,$FFFFFFFF
    Data.l $FFFF0000,$0000FFFF,$FFFFFFFF,$FFFF0000,$0000FFFF,$FFFFFFFF,$FFFF0000,$0000FFFF,$FFFFFFFF,$FFFF0000,$0000FFFF,$FFFFFFFF
    Data.l $FFFF0000,$0000FFFF
    BitMap_bmp_End:
    EndDataSection
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Post by rsts »

Nice!
Shannara
Addict
Addict
Posts: 1808
Joined: Thu Oct 30, 2003 11:19 pm
Location: Emerald Cove, Unformed

Post by Shannara »

Im sorry, but I have to ask ... Does this save on executable size?
sverson
Enthusiast
Enthusiast
Posts: 286
Joined: Sun Jul 04, 2004 12:15 pm
Location: Germany

Post by sverson »

Shannara wrote:Does this save on executable size?
I'm sorry, but I don't understand your question. :?

The example shows a pointer to the memory, where PB stored the image in memory.
When you save via SaveImage(ImageNo,...) the changed image will be saved. (modified pixels and new size (original: 20x20 / new: 400x400))

Try this:

Code: Select all

Procedure CloseMainWindow()
  If IsImage(ImageNo) : SaveImage(ImageNo,"c:\demo1.bmp") : FreeImage(ImageNo) : EndIf
  If IsWindow(MainWindowNo) : CloseWindow(MainWindowNo) : EndIf
EndProcedure
I hope this will help a little...

:wink: sverson

P.S.

This will center the window on screen:

Code: Select all

Procedure OpenMainWindow()
  Protected WinPosX.l, WinPosY.l
  ExamineDesktops()
  MainWindowNo = OpenWindow(#PB_Any,0,0,0,0,"click on image to change color!",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  If MainWindowNo
    MainWindowID = WindowID(MainWindowNo)
    If CreateGadgetList(MainWindowID)
      If InitImage()
        ImageGG = ImageGadget(#PB_Any,10,10,0,0,ImageID)
        WinPosX = Int((DesktopWidth(0)-(ImageWidth(ImageNo)+20))/2) : If WinPosX<0 : WinPosX=0 : EndIf
        WinPosY = Int((DesktopHeight(0)-(ImageHeight(ImageNo)+20))/2) : If WinPosY<0 : WinPosY=0 : EndIf
        ResizeWindow(MainWindowNo,WinPosX,WinPosY,ImageWidth(ImageNo)+20,ImageHeight(ImageNo)+20)
        ProcedureReturn #True
      EndIf
    EndIf
  EndIf
  ProcedureReturn #False
EndProcedure
Sorry, I can't modify the code of my first post without error :cry:
Post Reply