[*]Profan

CLS
var HPIC&=CREATE("hNewPic",100,100,$FF0000)
var HBMP&=CREATE("bitmap",%HWND,HPIC&,10,10)

WHILE 1

    WAITINPUT 10
    SENDMESSAGE(HBMP&,370,0,HPIC&)//stm_setImage

END

 $H Windows.ph
 $H Structs.ph
 $H Messages.ph
DEF &CAPTUREBLT $40000000
Struct WNDCLASSEX = ~WNDCLASSEX
Struct PS         = ~PAINTSTRUCT
Declare Ende&,CanvasClassname$
WindowTitle "Canvas"
CLS ~GetSysColor(~Color_BTNFACE)
'Klassen Info holen
Var wndc# = New(WNDCLASSEX)
wndc#.cbSize& = SizeOf(wndc#)
~GetClassInfoEx(%hInstance,"STATIC",wndc#)
'alte controlprocadresse speichern
Var OldWndProc& = wndc#.lpfnWndProc&
' neue controlprocadresse setzen
wndc#.lpfnWndProc& = Procaddr("CanvasProc",4)
'neuen Klassennamen setzen
CanvasClassname$ = "PrfCanvas"
wndc#.lpszClassName& = Addr(CanvasClassname$)
wndc#.hInstance& = %hInstance
' Neue Klasse registrieren
~RegisterClassEx(wndc#)
Set("Fastmode",1)
Var Canvas& = ~CreateWindowEx(0,"PrfCanvas","", ~WS_CHILD | ~WS_VISIBLE | ~SS_SUNKEN,10,10,300,300,%hwnd,0,%hInstance,0)

Whilenot Ende&

    Waitinput

Endwhile

End

Proc CanvasProc

    Parameters wnd&,msg&,wparam&,lparam&

    Select msg&

        Caseof ~WM_PAINT

        Var PS# = New(PS)
        Var DC& = ~BeginPaint(wnd&,PS#)
        ~BitBlt(DC&,0,0,298,298,~GetDC(%Desktop),0,0,~SRCCOPY | &CAPTUREBLT)
        ~EndPaint(wnd&,PS#)
        Dispose PS#
        Return 0

    Endselect

    Return ~CallWindowProc(OldWndProc&,wnd&,msg&,wparam&,lparam&)

EndProc

 $H Windows.ph
 $H Structs.ph
 $H Messages.ph
DEF &CAPTUREBLT $40000000
Struct WNDCLASSEX = ~WNDCLASSEX
Struct PS         = ~PAINTSTRUCT
Struct BITMAP     = ~BITMAP
Declare Ende&,CanvasClassname$
WindowTitle "Canvas"
CLS ~GetSysColor(~Color_BTNFACE)
'Klassen Info holen
Var wndc# = New(WNDCLASSEX)
wndc#.cbSize& = SizeOf(wndc#)
~GetClassInfoEx(%hInstance,"STATIC",wndc#)
'alte controlprocadresse speichern
Var OldWndProc& = wndc#.lpfnWndProc&
' neue controlprocadresse setzen
wndc#.lpfnWndProc& = Procaddr("CanvasProc",4)
'neuen Klassennamen setzen
CanvasClassname$ = "PrfCanvas"
wndc#.lpszClassName& = Addr(CanvasClassname$)
wndc#.hInstance& = %hInstance
' Neue Klasse registrieren
~RegisterClassEx(wndc#)
Set("Fastmode",1)
Var Canvas& = ~CreateWindowEx(0,"PrfCanvas","", ~WS_CHILD | ~WS_VISIBLE | ~SS_SUNKEN | ~SS_BITMAP,10,10,0,0,%hwnd,0,%hInstance,0)
var HPIC&=CREATE("hNewPic",100,100,$FF0000)
SendMessage(Canvas&,~STM_SETIMAGE,0,HPIC&)

Whilenot Ende&

    WAITINPUT 10
    Startpaint HPIC&
    TextColor $00FFFF,$FF0000
    Drawtext 10,10,Time$(0)+":"+Left$(Time$(1),2)
    EndPaint
    SENDMESSAGE(Canvas&,370,0,HPIC&)'stm_setImage

Endwhile

End

Proc CanvasProc

    Parameters wnd&,msg&,wparam&,lparam&

    Select msg&

        Caseof ~WM_PAINT

        Var PS# = New(PS)
        Var DC& = ~BeginPaint(wnd&,PS#)
        Var CompDC& = ~CreateCompatibleDC(DC&)
        Var Bmp& = ~SendMessage(wnd&,~STM_GETIMAGE,0,0)
        Var BMP# = New(BITMAP)
        ~GetObject(Bmp&,SizeOf(BMP#),BMP#)
        Var Width& = BMP#.bmwidth&
        var Height& = BMP#.bmHeight&
        ~SelectObject(CompDC&,Bmp&)
        ~ReleaseDC(CompDC&)
        ~BitBlt(DC&,0,0,Width&,Height&,CompDC&,0,0,~SRCCOPY | &CAPTUREBLT)
        ~EndPaint(wnd&,PS#)
        ~DeleteDC(CompDC&)
        Dispose PS#
        Dispose BMP#
        Return 0

        Caseof ~STM_SETIMAGE

        ~InvalidateRect(wnd&,0,0)

    Endselect

    Return ~CallWindowProc(OldWndProc&,wnd&,msg&,wparam&,lparam&)