Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
fb-derrisch
| Uploader: |  csde_rats |
| Datum/Zeit: | 08.08.2007 13:38:09 |
#define WIN_INCLUDEALL 1
#include once "windows.bi"
dim shared count as integer
dim shared hWnd as HWND
#Define WBM_MALE 1200
declare function WinMain ( byval hInstance as HINSTANCE, _
byval hPrevInstance as HINSTANCE, _
szCmdLine as string, _
byval iCmdShow as integer ) as integer
Declare Sub mythread(counta as integer ptr)
Declare SUB WriteToConsole(ByVal Message AS string)
''
'' Entry point
''
WinMain( GetModuleHandle( null ), null, Command, SW_NORMAL )
end
'' ::::::::
'' name: WndProc
'' desc: Processes windows messages
''
'' ::::::::
function WndProc ( byval hWnd as HWND, _
byval message as UINT, _
byval wParam as WPARAM, _
byval lParam as LPARAM ) as LRESULT
function = 0
''
'' Process messages
''
select case( message )
''
'' Window was created
''
case WM_CREATE
exit function
''
'' Windows is being repainted
''
case WM_PAINT
dim rct as RECT
Dim tct As RECT
dim pnt as PAINTSTRUCT
dim hDC as HDC
hDC = BeginPaint( hWnd, @pnt )
GetClientRect( hWnd, @rct )
with tct
.top = 30
.left = 0
.right = 40
.bottom = 50
end with
DrawText( hDC, _
str(count), _
Len(Str(count)), _
@tct, _
DT_SINGLELINE or DT_CENTER or DT_VCENTER )
EndPaint( hWnd, @pnt )
WriteToConsole "WM_PAINT empfangen (Count:" & count
exit function
Case WBM_MALE
'SendMessage(hWnd,WM_PAINT,0,0)
WriteToConsole "WBM_MALE empfangen"
hWnd = hWnd
Return TRUE
Exit Function
''
'' Key pressed
''
case WM_KEYDOWN
if( lobyte( wParam ) = 27 ) then
PostMessage( hWnd, WM_CLOSE, 0, 0 )
end if
''
'' Window was closed
''
case WM_DESTROY
PostQuitMessage( 0 )
exit Function
end select
''
'' Message doesn't concern us, send it to the default handler
'' and get result
''
function = DefWindowProc( hWnd, message, wParam, lParam )
end function
SUB mythread (counta As Integer ptr)
do
count += 1
sleep 1000
print Str(@count) + "(" + Str(hWnd) + ")"
dim rct as RECT
dim pnt as PAINTSTRUCT
dim hDC as HDC
'SendMessage(hWnd,WBM_MALE, NULL, NULL)
hDC = BeginPaint( hWnd, @pnt )
GetClientRect( hWnd, @rct )
InvalidateRect (hWnd,null, true)
EndPaint( hWnd, @pnt )
loop
END SUB
'' ::::::::
'' name: WinMain
'' desc: A win2 gui program entry point
''
'' ::::::::
function WinMain ( byval hInstance as HINSTANCE, _
byval hPrevInstance as HINSTANCE, _
szCmdLine as string, _
byval iCmdShow as integer ) as integer
dim wMsg as MSG
dim wcls as WNDCLASS
dim szAppName as string
function = 0
''
'' Setup window class
''
szAppName = "HelloWin"
with wcls
.style = CS_HREDRAW or CS_VREDRAW
.lpfnWndProc = @WndProc
.cbClsExtra = 0
.cbWndExtra = 0
.hInstance = hInstance
.hIcon = LoadIcon( NULL, IDI_APPLICATION )
.hCursor = LoadCursor( NULL, IDC_ARROW )
.hbrBackground = GetStockObject( WHITE_BRUSH )
.lpszMenuName = NULL
.lpszClassName = strptr( szAppName )
end with
''
'' Register the window class
''
if( RegisterClass( @wcls ) = FALSE ) then
MessageBox( null, "Failed to register wcls!", szAppName, MB_ICONERROR )
exit function
end if
''
'' Create the window and show it
''
hWnd = CreateWindowEx( 0, _
szAppName, _
"The Hello Program", _
WS_OVERLAPPEDWINDOW, _
CW_USEDEFAULT, _
CW_USEDEFAULT, _
CW_USEDEFAULT, _
CW_USEDEFAULT, _
NULL, _
NULL, _
hInstance, _
NULL )
ShowWindow( hWnd, iCmdShow )
UpdateWindow( hWnd )
''
'' Process windows messages
threadcreate(@mythread,@count)
while ((GetMessage( @wMsg, NULL, 0, 0 ) <> FALSE) )
TranslateMessage( @wMsg )
DispatchMessage( @wMsg )
wend
''
'' Program has ended
''
function = wMsg.wParam
end function
SUB WriteToConsole(ByVal Message AS string)
dim chCon as integer
chCon = FreeFile
open CONS for output as #chCon
print #chCon, Message
close #chCon
END Sub