Screen >Melt< effect

Share your advanced PureBasic knowledge/code with the community.
Post Reply
syntax error
User
User
Posts: 93
Joined: Tue Jan 13, 2004 5:11 am
Location: Midlands , UK

Screen >Melt< effect

Post by syntax error »

Code updated for 5.20+

Here's something I've been toying with ..
Can you improve the effect?

Code: Select all

; melt1

#win=0
#lineH=40

sw.l=GetSystemMetrics_(#SM_CXSCREEN)
sh.l=GetSystemMetrics_(#SM_CYSCREEN)+#lineH

;- setup window
If OpenWindow(#win, 0, -#lineH, sw, sh, "",  #PB_Window_BorderLess)
  AddKeyboardShortcut(#win, #PB_Shortcut_Escape, #PB_Shortcut_Escape)
Else
  MessageRequester("Error","unable to open window")
  End
EndIf

StartDrawing(WindowOutput(#win))
Box(0,0,sw,sh,RGB($ff,$ff,$ff))
StopDrawing()

Global hWnd1,hWnd2,DC1,DC2
hWnd1=WindowID(0)
hWnd2=WindowID(0)
DC1=GetWindowDC_(hWnd1)
DC2=GetWindowDC_(hWnd2)

Procedure DrawLines()
  Shared sw,sh
  StartDrawing(WindowOutput(#win))
  For l=1 To 50
    FrontColor(RGB(Random(255),Random(255),Random(255)))
    LineXY(Random(sw),Random(#lineH),Random(sw),Random(#lineH))
  Next
  StopDrawing()
EndProcedure

Procedure Melt(effect.l)
  Shared sw,sh
  rW=Random(sw/4)+10 : rH=Random(200)+8
  rX=Random(sw+8)-16 : rY=Random(sh)
  shX=Random(1)-Random(1)
  BitBlt_(DC2,rX+shX,rY+Random(4)+1,rW,rH,DC1,rX,rY,effect)
EndProcedure

ShowCursor_(0)

Repeat
  
  count-1
  If count<=0
    DrawLines()
    count=20
  EndIf
  
  For m=1 To 20
    Melt(#SRCCOPY)
  Next
  
  Delay(1)
  
  If mouse-(mouse>0)
    ev = WindowEvent()
    If ev=#WM_CHAR : Break : EndIf
    If ev=#WM_MOUSEMOVE
      mouse+1
      If mouse=12 : Break : EndIf
    EndIf
  EndIf
ForEver

ReleaseDC_(hWnd1,DC1)
ReleaseDC_(hWnd2,DC2)
ShowCursor_(1)

End
You can pass a combination of these to the Melt() command:

#BLACKNESS
#DSTINVERT
#MERGECOPY
#MERGEPAINT
#NOTSRCCOPY
#NOTSRCERASE
#PATCOPY
#PATINVERT
#PATPAINT
#SRCAND
#SRCCOPY
#SRCERASE
#SRCINVERT
#SRCPAINT
#WHITENESS
Top
User avatar
Flype
Addict
Addict
Posts: 1542
Joined: Tue Jul 22, 2003 5:02 pm
Location: In a long distant galaxy

Post by Flype »

beuuurk ! :D

nice effect
No programming language is perfect. There is not even a single best language.
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer
Top
benny
Enthusiast
Enthusiast
Posts: 465
Joined: Fri Apr 25, 2003 7:44 pm
Location: end of www
Contact:
Contact benny

Post by benny »

Indeed, nice one !

Keep it up 8)
regards,
benny!
-
pe0ple ar3 str4nge!!!
Top
syntax error
User
User
Posts: 93
Joined: Tue Jan 13, 2004 5:11 am
Location: Midlands , UK

Post by syntax error »

Melt your desktop ...

Code: Select all

; melt2 - desktop

#win=0

; capture the desktop screen - modified code from BackupUser
Procedure.l CaptureDesktop() 
  Shared sw.l,sh.l
  dm.DEVMODE
  dm.DEVMODE 
  BMPHandle.l 
  srcDC = CreateDC_("DISPLAY", "", "", dm) 
  trgDC = CreateCompatibleDC_(srcDC) 
  BMPHandle = CreateCompatibleBitmap_(srcDC, sw, sh) 
  SelectObject_( trgDC, BMPHandle) 
  BitBlt_( trgDC, 0, 0, sw, sh, srcDC, 0, 0, #SRCCOPY) 
  DeleteDC_( trgDC) 
  ReleaseDC_( BMPHandle, srcDC) 
  ProcedureReturn BMPHandle 
EndProcedure 

sw.l=GetSystemMetrics_(#SM_CXSCREEN)
sh.l=GetSystemMetrics_(#SM_CYSCREEN)
Delay(100)
dtimage.l=CaptureDesktop()

;- setup window
If OpenWindow(#win, 0, 0, sw, sh,  #PB_Window_BorderLess, "") 
Else
  MessageRequester("Error","unable to open window")
  End
EndIf

StartDrawing(WindowOutput())
DrawImage(dtimage,0,0)
StopDrawing()

Global hWnd1,hWnd2,DC1,DC2
hWnd1=WindowID(0)
hWnd2=WindowID(0)
DC1=GetWindowDC_(hWnd1)
DC2=GetWindowDC_(hWnd2)

Procedure Melt(effect.l)
  Shared sw,sh
  rW=Random(sw/10)+10 : rH=Random(sh/10)+10
  rX=Random(sw+8)-16 : rY=Random(sh+8)-16
  shX=Random(1)-Random(1)
  shY=Random(1)-Random(1)
  BitBlt_(DC2,rX+shX,rY+shY,rW,rH,DC1,rX,rY,effect)
EndProcedure

ShowCursor_(0)

Repeat

  For m=1 To 60
    Melt(#SRCCOPY)
  Next
  
  Delay(1)

  mouse-(mouse>0)
  ev = WindowEvent()
  If ev=#WM_CHAR : Break : EndIf
  If ev=#WM_MOUSEMOVE
    mouse+1
    If mouse=7 : Break : EndIf
  EndIf
ForEver

ReleaseDC_(hWnd1,DC1)
ReleaseDC_(hWnd2,DC2)
ShowCursor_(1)

End
Top
fweil
Enthusiast
Enthusiast
Posts: 725
Joined: Thu Apr 22, 2004 5:56 pm
Location: France
Contact:
Contact fweil

Post by fweil »

LO,

I love this one ... it's a nice bug.

Code: Select all

#Window_Main = 0
  ScreenWidth = GetSystemMetrics_(#SM_CXSCREEN)
  ScreenHeight = GetSystemMetrics_(#SM_CYSCREEN)
  SourceDeviceContext = GetDC_(0)
  DestinationDeviceContext = CreateCompatibleDC_(SourceDeviceContext)
  ImageID = CreateImage(0, ScreenWidth / 2, ScreenHeight / 2)
  SelectObject_(DestinationDeviceContext, ImageID)
  SetStretchBltMode_(DestinationDeviceContext, #HALFTONE)
  StretchBlt_(DestinationDeviceContext, 0, 0, ScreenWidth / 2, ScreenHeight / 2, SourceDeviceContext, 0, 0, ScreenWidth, ScreenHeight, #SRCCOPY )
  DeleteDC_(DestinationDeviceContext)
  ReleaseDC_(0, SourceDeviceContext)
  If OpenWindow(#Window_Main, (ScreenWidth - ImageWidth()) / 2, (ScreenHeight - ImageHeight()) / 2, ImageWidth(), ImageHeight(), #PB_Window_BorderLess, "")
      StartDrawing(WindowOutput())
        DrawImage(ImageID, (WindowWidth() - ImageWidth()) / 2 , (WindowHeight() - ImageHeight()) / 2)
      StopDrawing()
      SourceDeviceContext = GetDC_(0)
      DestinationDeviceContext = GetDC_(0)
      ShowCursor_(0)
      Repeat
        For m = 1 To 60
          rX = Random(ScreenWidth + 8) - 16
          rY = Random(ScreenHeight + 8) - 16
          BitBlt_(DestinationDeviceContext, rX + Random(1) - Random(1), rY + Random(1) - Random(1), Random(ScreenWidth / 10) + 10, Random(ScreenHeight / 10) + 10, SourceDeviceContext, rX, rY, #SRCCOPY)
        Next
        Delay(1)
        WindowEvent = WindowEvent()
        If WindowEvent = #PB_Event_CloseWindow Or WindowEvent = #WM_LBUTTONDOWN Or WindowEvent = #WM_CHAR
            Quit = #TRUE
        EndIf
      Until Quit
      StartDrawing(WindowOutput())
        DrawingFont(LoadFont(0, "Verdana", 20, #PB_Font_Bold | #PB_Font_Italic | #PB_Font_HighQuality))
        Text.s = "You have been swindled"
        DrawingMode(1)
        For i = 1 To 12
          FrontColor(255 * (i % 2), 255 * (i % 2), 255 * (i % 2))
          Locate((WindowWidth() - TextLength(Text)) / 2, WindowHeight() / 2 - 20)
          DrawText(Text)
          Sleep_(100)
        Next
      StopDrawing()
      ReleaseDC_(WindowID(), SourceDeviceContext)
      ReleaseDC_(WindowID(), DestinationDeviceContext)
      ShowCursor_(1)
    Else
      MessageRequester("Error","unable to open window")
  EndIf
  TerminateProcess_(GetCurrentProcess_(), 0)
End
My avatar is a small copy of the 4x1.8m image I created and exposed at 'Le salon international du meuble à Paris' january 2004 in Matt Sindall's 'Shades' designers exhibition. The original laminated print was designed using a 150 dpi printout.
Top
thefool
Always Here
Always Here
Posts: 5875
Joined: Sat Aug 30, 2003 5:58 pm
Location: Denmark

Post by thefool »

you screwed up my desktop :?

:D
Top
fweil
Enthusiast
Enthusiast
Posts: 725
Joined: Thu Apr 22, 2004 5:56 pm
Location: France
Contact:
Contact fweil

Post by fweil »

8)
My avatar is a small copy of the 4x1.8m image I created and exposed at 'Le salon international du meuble à Paris' january 2004 in Matt Sindall's 'Shades' designers exhibition. The original laminated print was designed using a 150 dpi printout.
Top
PolyVector
Enthusiast
Enthusiast
Posts: 499
Joined: Wed Sep 17, 2003 9:17 pm
Location: Southern California
Contact:
Contact PolyVector

Post by PolyVector »

That was fun :mrgreen:
But I'm not feelin' so good
Top
User avatar
blueznl
PureBasic Expert
PureBasic Expert
Posts: 6172
Joined: Sat May 17, 2003 11:31 am
Contact:
Contact blueznl

Post by blueznl »

no multi monitor support :-)
( PB6.00 LTS Win11 x64 Asrock AB350 Pro4 Ryzen 5 3600 32GB GTX1060 6GB - upgrade incoming...)
( The path to enlightenment and the PureBasic Survival Guide right here... )
Top
freak
PureBasic Team
PureBasic Team
Posts: 5950
Joined: Fri Apr 25, 2003 5:21 pm
Location: Germany

Post by freak »

.. it does "melt" a little bit into the second monitor though :)
quidquid Latine dictum sit altum videtur
Top
thefool
Always Here
Always Here
Posts: 5875
Joined: Sat Aug 30, 2003 5:58 pm
Location: Denmark

Post by thefool »

:D
Top
User avatar
blueznl
PureBasic Expert
PureBasic Expert
Posts: 6172
Joined: Sat May 17, 2003 11:31 am
Contact:
Contact blueznl

Post by blueznl »

so... it would depend on how close they stand to eachother, my screens i mean? damn, gotta try this, let me move them a little further apart...

:-)
( PB6.00 LTS Win11 x64 Asrock AB350 Pro4 Ryzen 5 3600 32GB GTX1060 6GB - upgrade incoming...)
( The path to enlightenment and the PureBasic Survival Guide right here... )
Top
freak
PureBasic Team
PureBasic Team
Posts: 5950
Joined: Fri Apr 25, 2003 5:21 pm
Location: Germany

Post by freak »

Here's a tip: If you set your table on fire, your monitor will also start to melt.
A much more realistic melt effect... :mrgreen:
quidquid Latine dictum sit altum videtur
Top
Post Reply

Return to “Tricks 'n' Tips”