Animate your selections - like Photoshop!

Share your advanced PureBasic knowledge/code with the community.
Post Reply
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Animate your selections - like Photoshop!

Post by netmaestro »

Just for a bit of fun, I thought I'd try to duplicate Photoshop's animated selections:

Code: Select all

Declare ImageProc(hWnd, Msg, wParam, lParam)
Declare AnimatePen(hwnd)

hatch = CreateImage(#PB_Any, 16,16)
StartDrawing(ImageOutput(hatch))
  For i = 0 To 16 Step 8
    For j = 0 To 16 Step 8
      Box(j,i,4,4,#White)
      Box(j+4,i+4,4,4,#White)
    Next
  Next
StopDrawing()

ExamineDesktops() : Global frequency = DesktopFrequency(0)

hatch1 = GrabImage(hatch, #PB_Any, 0,0,8,1)
hatch2 = GrabImage(hatch, #PB_Any, 1,0,8,1)
hatch3 = GrabImage(hatch, #PB_Any, 2,0,8,1)
hatch4 = GrabImage(hatch, #PB_Any, 3,0,8,1)
hatch5 = GrabImage(hatch, #PB_Any, 4,0,8,1)
hatch6 = GrabImage(hatch, #PB_Any, 5,0,8,1)
hatch7 = GrabImage(hatch, #PB_Any, 6,0,8,1)
hatch8 = GrabImage(hatch, #PB_Any, 7,0,8,1)

hatch10 = GrabImage(hatch, #PB_Any, 0,0,1,8)
hatch11 = GrabImage(hatch, #PB_Any, 0,1,1,8)
hatch12 = GrabImage(hatch, #PB_Any, 0,2,1,8)
hatch13 = GrabImage(hatch, #PB_Any, 0,3,1,8)
hatch14 = GrabImage(hatch, #PB_Any, 0,4,1,8)
hatch15 = GrabImage(hatch, #PB_Any, 0,5,1,8)
hatch16 = GrabImage(hatch, #PB_Any, 0,6,1,8)
hatch17 = GrabImage(hatch, #PB_Any, 0,7,1,8)
                                       
lb1.LOGBRUSH : lb1\lbStyle = #BS_PATTERN : lb1\lbHatch = ImageID(hatch1)
lb2.LOGBRUSH : lb2\lbStyle = #BS_PATTERN : lb2\lbHatch = ImageID(hatch2)
lb3.LOGBRUSH : lb3\lbStyle = #BS_PATTERN : lb3\lbHatch = ImageID(hatch3)
lb4.LOGBRUSH : lb4\lbStyle = #BS_PATTERN : lb4\lbHatch = ImageID(hatch4)
lb5.LOGBRUSH : lb5\lbStyle = #BS_PATTERN : lb5\lbHatch = ImageID(hatch5)
lb6.LOGBRUSH : lb6\lbStyle = #BS_PATTERN : lb6\lbHatch = ImageID(hatch6)
lb7.LOGBRUSH : lb7\lbStyle = #BS_PATTERN : lb7\lbHatch = ImageID(hatch7)
lb8.LOGBRUSH : lb8\lbStyle = #BS_PATTERN : lb8\lbHatch = ImageID(hatch8)
lb10.LOGBRUSH : lb10\lbStyle = #BS_PATTERN : lb10\lbHatch = ImageID(hatch10)
lb11.LOGBRUSH : lb11\lbStyle = #BS_PATTERN : lb11\lbHatch = ImageID(hatch11)
lb12.LOGBRUSH : lb12\lbStyle = #BS_PATTERN : lb12\lbHatch = ImageID(hatch12)
lb13.LOGBRUSH : lb13\lbStyle = #BS_PATTERN : lb13\lbHatch = ImageID(hatch13)
lb14.LOGBRUSH : lb14\lbStyle = #BS_PATTERN : lb14\lbHatch = ImageID(hatch14)
lb15.LOGBRUSH : lb15\lbStyle = #BS_PATTERN : lb15\lbHatch = ImageID(hatch15)
lb16.LOGBRUSH : lb16\lbStyle = #BS_PATTERN : lb16\lbHatch = ImageID(hatch16)
lb17.LOGBRUSH : lb17\lbStyle = #BS_PATTERN : lb17\lbHatch = ImageID(hatch17)

Global pen   = CreatePen_(#PS_DOT, 1, #Black)
Global pen1  = ExtCreatePen_(#PS_GEOMETRIC|#PS_SOLID, 1, lb1, 0, 0)
Global pen2  = ExtCreatePen_(#PS_GEOMETRIC|#PS_SOLID, 1, lb2, 0, 0)
Global pen3  = ExtCreatePen_(#PS_GEOMETRIC|#PS_SOLID, 1, lb3, 0, 0)
Global pen4  = ExtCreatePen_(#PS_GEOMETRIC|#PS_SOLID, 1, lb4, 0, 0)
Global pen5  = ExtCreatePen_(#PS_GEOMETRIC|#PS_SOLID, 1, lb5, 0, 0)
Global pen6  = ExtCreatePen_(#PS_GEOMETRIC|#PS_SOLID, 1, lb6, 0, 0)
Global pen7  = ExtCreatePen_(#PS_GEOMETRIC|#PS_SOLID, 1, lb7, 0, 0)
Global pen8  = ExtCreatePen_(#PS_GEOMETRIC|#PS_SOLID, 1, lb8, 0, 0)
Global pen10 = ExtCreatePen_(#PS_GEOMETRIC|#PS_SOLID, 1, lb10, 0, 0)
Global pen11 = ExtCreatePen_(#PS_GEOMETRIC|#PS_SOLID, 1, lb11, 0, 0)
Global pen12 = ExtCreatePen_(#PS_GEOMETRIC|#PS_SOLID, 1, lb12, 0, 0)
Global pen13 = ExtCreatePen_(#PS_GEOMETRIC|#PS_SOLID, 1, lb13, 0, 0)
Global pen14 = ExtCreatePen_(#PS_GEOMETRIC|#PS_SOLID, 1, lb14, 0, 0)
Global pen15 = ExtCreatePen_(#PS_GEOMETRIC|#PS_SOLID, 1, lb15, 0, 0)
Global pen16 = ExtCreatePen_(#PS_GEOMETRIC|#PS_SOLID, 1, lb16, 0, 0)
Global pen17 = ExtCreatePen_(#PS_GEOMETRIC|#PS_SOLID, 1, lb17, 0, 0)

Structure PENPAIR
  hpen.i
  vpen.i
EndStructure

Global NewList penset.PENPAIR()

AddElement(penset()) : penset()\hpen = pen  : penset()\vpen = pen
AddElement(penset()) : penset()\hpen = pen1 : penset()\vpen = pen10
AddElement(penset()) : penset()\hpen = pen2 : penset()\vpen = pen11
AddElement(penset()) : penset()\hpen = pen3 : penset()\vpen = pen12
AddElement(penset()) : penset()\hpen = pen4 : penset()\vpen = pen13
AddElement(penset()) : penset()\hpen = pen5 : penset()\vpen = pen14
AddElement(penset()) : penset()\hpen = pen6 : penset()\vpen = pen15
AddElement(penset()) : penset()\hpen = pen7 : penset()\vpen = pen16
AddElement(penset()) : penset()\hpen = pen8 : penset()\vpen = pen17
  
Global brush = GetStockObject_(#HOLLOW_BRUSH), tid

UseJPEGImageDecoder()
LoadImage(0, #PB_Compiler_Home + "Examples\Sources\Data\R2Skin.jpg")

OpenWindow(0,0,0,512,512,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
img = ImageGadget(0,0,0,512,512,ImageID(0))
SetProp_(img, "oldproc", SetWindowLongPtr_(img,#GWL_WNDPROC,@ImageProc()))
SetProp_(img, "content", 0)

Repeat:Until WaitWindowEvent() = #PB_Event_CloseWindow

Procedure ImageProc(hWnd, Msg, wParam, lParam)
  Static  sel.RECT, drawing
  oldproc = GetProp_(hWnd, "oldproc")
  content = GetProp_(hwnd, "content")
  
  Select Msg
    Case #WM_NCDESTROY
      RemoveProp_(hWnd, "oldproc")
      RemoveProp_(hWnd, "content")
      
    Case #WM_PAINT
      
      hdc = BeginPaint_(hWnd, ps.PAINTSTRUCT)
      
        tmp = CopyImage(content, #PB_Any)
        dcin = StartDrawing(ImageOutput(tmp))
          SelectObject_(dcin, penset()\hpen)
          SelectObject_(dcin, brush)
          MoveToEx_(dcin, sel\left,sel\top,old.POINT)
          LineTo_(dcin, sel\right,sel\top)
          SelectObject_(dcin, penset()\vpen)
          LineTo_(dcin, sel\right, sel\bottom)
          SelectObject_(dcin, penset()\hpen)
          LineTo_(dcin, sel\left, sel\bottom)
          SelectObject_(dcin, penset()\vpen)
          LineTo_(dcin, sel\left,sel\top)
          BitBlt_(hdc, 0,0,512,512,dcin,0,0,#SRCCOPY)
        StopDrawing()
        FreeImage(tmp)
        
      EndPaint_(hWnd, ps)
     
      ProcedureReturn 0
      
    Case #WM_LBUTTONDOWN
      If IsThread(tid)
        KillThread(tid)
        WaitThread(tid)
      EndIf
      GetWindowRect_(hWnd, @wr.RECT)
      ClipCursor_(@wr) ; Cursor needs to stay in the gadget for drawing
      GetCursorPos_(@cp.POINT)
      ScreenToClient_(hWnd, @CP)
      SetRect_(sel,cp\x,cp\y,cp\x-1,cp\y-1) ; Initialize selection rectangle 
      
      drawing = #True
      FirstElement(penset()) ; use non-animated pen
      SetFocus_(hwnd) ; we'll use arrow keys to bump selection if desired
      
    Case #WM_LBUTTONUP
      If drawing
        ClipCursor_(#Null)
        drawing = #False
        tid = CreateThread(@AnimatePen(), hwnd)
      EndIf
      
    Case #WM_MOUSEMOVE
      If drawing
        GetCursorPos_(@cp.POINT)
        ScreenToClient_(hWnd, @CP)
        sel\right = cp\x                                       
        sel\bottom = cp\y                                      
        InvalidateRect_(hwnd, 0, 0)
      EndIf
      
    Case #WM_KEYDOWN
      Select wParam
        Case #VK_LEFT
          sel\left-1:sel\right-1
          ProcedureReturn 0
        Case #VK_RIGHT
          sel\left+1:sel\right+1
          ProcedureReturn 0
        Case #VK_UP
          sel\top-1:sel\bottom-1
          ProcedureReturn 0
        Case #VK_DOWN
          sel\top+1:sel\bottom+1
          ProcedureReturn 0
      EndSelect
    EndSelect  

  ProcedureReturn CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam)
EndProcedure

Procedure AnimatePen(hwnd)

  SelectElement(penset(), 1) ; first animated pen in list
  Repeat
    InvalidateRect_(hwnd, 0,0)
    Delay(frequency)
    If Not NextElement(penset()) : SelectElement(penset(), 1) : EndIf
  ForEver
  
EndProcedure
I'll add ellipses and arbitrary selections to this in the coming days.
BERESHEIT
Top
Mistrel
Addict
Addict
Posts: 3415
Joined: Sat Jun 30, 2007 8:04 pm

Post by Mistrel »

Marching ants! I've always wondered how to do something like that. Did you brainstorm this on your own, netmaestro?

Thanks for sharing! :)
Top
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

You're most welcome.
Did you brainstorm this on your own, netmaestro?
Yes, I came up with this on my own. Which is a bit of a risk, as it's kind of involved. The risk is that someone will point out mildly that there is a single line of API code that will do the whole thing, which happened to me once before and made me wish I'd done a bit of research before plunging in, heh heh.
BERESHEIT
Top
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Post by rsts »

netmaestro wrote: The risk is that someone will point out mildly that there is a single line of API code that will do the whole thing, which happened to me once before and made me wish I'd done a bit of research before plunging in, heh heh.
:D

But it was still quite an acheivement!

And so is this - WOW.
Top
srod
PureBasic Expert
PureBasic Expert
Posts: 10589
Joined: Wed Oct 29, 2003 4:35 pm
Location: Beyond the pale...

Post by srod »

What you mean you've not encountered the AnimateSelectionRect_() api function?

Come on Netty, get a grip lad!

:)

(Very nice by the way!)
I may look like a mule, but I'm not a complete ass.
Top
akj
Enthusiast
Enthusiast
Posts: 668
Joined: Mon Jun 09, 2003 10:08 pm
Location: Nottingham

Post by akj »

A few trivial changes to shorten the code and to support EnableExplicit:

Code: Select all

EnableExplicit

Declare ImageProc(hWnd, Msg, wParam, lParam)
Declare AnimatePen(hwnd)

Structure PENPAIR
  hpen.i
  vpen.i
EndStructure

Define hatch, pen, i, j, img
Dim hatch(17): Dim lb.LOGBRUSH(17)
Global frequency, brush, tid, Dim pen(17), NewList penset.PENPAIR()

hatch = CreateImage(#PB_Any, 16,16)
StartDrawing(ImageOutput(hatch))
  For i = 0 To 16 Step 8
    For j = 0 To 16 Step 8
      Box(j,i,4,4,#White)
      Box(j+4,i+4,4,4,#White)
    Next
  Next
StopDrawing()

ExamineDesktops() : frequency = DesktopFrequency(0)

pen = CreatePen_(#PS_DOT, 1, #Black)
AddElement(penset()) : penset()\hpen = pen  : penset()\vpen = pen
For i=0 To 7
  hatch(i+1) = GrabImage(hatch, #PB_Any, i,0,8,1)
  hatch(i+10)= GrabImage(hatch, #PB_Any, 0,i,1,8)
  lb(i+1)\lbStyle = #BS_PATTERN: lb(i+1)\lbHatch = ImageID(hatch(i+1))
  lb(i+10)\lbStyle= #BS_PATTERN: lb(i+10)\lbHatch= ImageID(hatch(i+10))
  pen(i+1) = ExtCreatePen_(#PS_GEOMETRIC|#PS_SOLID, 1, lb(i+1), 0, 0)
  pen(i+10)= ExtCreatePen_(#PS_GEOMETRIC|#PS_SOLID, 1, lb(i+10), 0, 0)
  AddElement(penset()) : penset()\hpen = pen(i+1) : penset()\vpen = pen(i+10)
Next i
brush = GetStockObject_(#HOLLOW_BRUSH)

UseJPEGImageDecoder()
LoadImage(0, #PB_Compiler_Home + "Examples\Sources\Data\R2Skin.jpg")

OpenWindow(0,0,0,512,512,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
img = ImageGadget(0,0,0,512,512,ImageID(0))
SetProp_(img, "oldproc", SetWindowLongPtr_(img,#GWL_WNDPROC,@ImageProc()))
SetProp_(img, "content", 0)

Repeat: Until WaitWindowEvent() = #PB_Event_CloseWindow
End

Procedure ImageProc(hWnd, Msg, wParam, lParam)
  Static  sel.RECT, drawing
  Protected oldproc, content, hdc, tmp, dcin
  Protected ps.PAINTSTRUCT, old.POINT, wr.RECT, cp.POINT
  oldproc = GetProp_(hWnd, "oldproc")
  content = GetProp_(hwnd, "content")

  Select Msg
    Case #WM_NCDESTROY
      RemoveProp_(hWnd, "oldproc")
      RemoveProp_(hWnd, "content")

    Case #WM_PAINT

      hdc = BeginPaint_(hWnd, ps)

        tmp = CopyImage(content, #PB_Any)
        dcin = StartDrawing(ImageOutput(tmp))
          SelectObject_(dcin, penset()\hpen)
          SelectObject_(dcin, brush)
          MoveToEx_(dcin, sel\left,sel\top, old)
          LineTo_(dcin, sel\right,sel\top)
          SelectObject_(dcin, penset()\vpen)
          LineTo_(dcin, sel\right, sel\bottom)
          SelectObject_(dcin, penset()\hpen)
          LineTo_(dcin, sel\left, sel\bottom)
          SelectObject_(dcin, penset()\vpen)
          LineTo_(dcin, sel\left,sel\top)
          BitBlt_(hdc, 0,0,512,512,dcin,0,0,#SRCCOPY)
        StopDrawing()
        FreeImage(tmp)

      EndPaint_(hWnd, ps)

      ProcedureReturn 0

    Case #WM_LBUTTONDOWN
      If IsThread(tid)
        KillThread(tid)
        WaitThread(tid)
      EndIf
      GetWindowRect_(hWnd, @wr)
      ClipCursor_(@wr) ; Cursor needs to stay in the gadget for drawing
      GetCursorPos_(@cp)
      ScreenToClient_(hWnd, @CP)
      SetRect_(sel,cp\x,cp\y,cp\x-1,cp\y-1) ; Initialize selection rectangle

      drawing = #True
      FirstElement(penset()) ; Use non-animated pen
      SetFocus_(hwnd) ; Use arrow keys to bump selection if desired

    Case #WM_LBUTTONUP
      If drawing
        ClipCursor_(#Null)
        drawing = #False
        tid = CreateThread(@AnimatePen(), hwnd)
      EndIf

    Case #WM_MOUSEMOVE
      If drawing
        GetCursorPos_(@cp.POINT)
        ScreenToClient_(hWnd, @CP)
        sel\right = cp\x
        sel\bottom = cp\y
        InvalidateRect_(hwnd, 0, 0)
      EndIf

    Case #WM_KEYDOWN
      Select wParam
        Case #VK_LEFT
          sel\left-1:sel\right-1
          ProcedureReturn 0
        Case #VK_RIGHT
          sel\left+1:sel\right+1
          ProcedureReturn 0
        Case #VK_UP
          sel\top-1:sel\bottom-1
          ProcedureReturn 0
        Case #VK_DOWN
          sel\top+1:sel\bottom+1
          ProcedureReturn 0
      EndSelect
    EndSelect

  ProcedureReturn CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam)
EndProcedure

Procedure AnimatePen(hwnd)
  SelectElement(penset(), 1) ; First animated pen in list
  Repeat
    InvalidateRect_(hwnd, 0,0)
    Delay(frequency)
    If Not NextElement(penset()) : SelectElement(penset(), 1) : EndIf
  ForEver
EndProcedure
Note the comment that says you can use the arrow keys to bump selection if desired
Anthony Jordan
Top
Post Reply

Return to “Tricks 'n' Tips”