'Program Name Form2.bas
'#Compile Exe
#Include "Win32api.inc" 'Equates, declares, types translated from Windows.h
Type WndEventArgs
wParam As Long
lParam As Long
hWnd As Dword
hInst As Dword
wWidth As Word
wHeight As Word
wX As Word
wY As Word
wCharHt As Word
xPos As Word
yPos As Word
szText As Asciiz*128
End Type
Function fnWndProc_OnCreate(wea As WndEventArgs) As Long
Local tm As TEXTMETRIC
Local hDC As DWord
hDC=GetDC(wea.hWnd)
Call GetTextMetrics(hDC,tm)
wea.wCharHt=tm.tmHeight
Call ReleaseDC(wea.hWnd,hDC)
MsgBox("wea.wCharHt=" & Trim$(Str$(tm.tmHeight))) 'If using Console Compiler remark this
'Print "wea.wCharHt=" & Trim$(Str$(tm.tmHeight)) 'line out and use Print instead!
fnWndProc_OnCreate=0
End Function
Function fnWndProc_OnMouseMove(wea As WndEventArgs) As Long
wea.wX=LoWrd(wea.lParam) : wea.wY=HiWrd(wea.lParam)
Call InvalidateRect(wea.hWnd,ByVal %NULL,%TRUE)
fnWndProc_OnMouseMove=0
End Function
Function fnWndProc_OnSize(wea As WndEventArgs) As Long
wea.wWidth=LoWrd(wea.lParam) : wea.wHeight=HiWrd(wea.lParam)
Call InvalidateRect(wea.hWnd,ByVal %NULL,%TRUE)
fnWndProc_OnSize=0
End Function
Function fnWndProc_OnChar(wea As WndEventArgs) As Long
wea.szText=wea.szText+Chr$(wea.wParam)
Call InvalidateRect(wea.hWnd,ByVal %NULL,%TRUE)
fnWndProc_OnChar=0
End Function
Function fnWndProc_OnLButtonDown(wea As WndEventArgs) As Long
If wea.wParam=%MK_LBUTTON Then
wea.xPos=LoWrd(wea.lParam) : wea.yPos=HiWrd(wea.lParam)
Call InvalidateRect(wea.hWnd,ByVal 0,%TRUE)
End If
fnWndProc_OnLButtonDown=0
End Function
Function fnWndProc_OnPaint(wea As WndEventArgs) As Long
Local szLine As Asciiz*48
Local ps As PAINTSTRUCT
Local hDC As Long
hDC=BeginPaint(wea.hWnd,ps)
szLine="MouseX="+Trim$(Str$(wea.wX)) & " MouseY="+Trim$(Str$(wea.wY))
TextOut(hDC,0,0,szLine,Len(szLine))
szLine="wea.wWidth="+Trim$(Str$(wea.wWidth)) & " wea.wHeight=" + Trim$(Str$(wea.wHeight))
TextOut(hDC,0,16,szLine,Len(szLine))
TextOut(hDC,0,32,wea.szText,Len(wea.szText))
If wea.xPos<>0 And wea.yPos<>0 Then
szLine="WM_LBUTTONDOWN At (" & Trim$(Str$(wea.xPos)) & "," & Trim$(Str$(wea.yPos)) & ")"
TextOut(hDC,wea.xPos,wea.yPos,szLine,Len(szLine))
wea.xPos=0 : wea.yPos=0
End If
Call EndPaint(wea.hWnd,ps)
fnWndProc_OnPaint=0
End Function
Function WndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
Static wea As WndEventArgs
Select Case As Long wMsg
Case %WM_CREATE
wea.hWnd=hWnd : wea.lParam=lParam : wea.wParam=wParam
WndProc=fnWndProc_OnCreate(wea)
Exit Function
Case %WM_MOUSEMOVE
wea.hWnd=hWnd : wea.lParam=lParam : wea.wParam=wParam
WndProc=fnWndProc_OnMouseMove(wea)
Exit Function
Case %WM_SIZE
wea.hWnd=hWnd : wea.lParam=lParam : wea.wParam=wParam
WndProc=fnWndProc_OnSize(wea)
Exit Function
Case %WM_CHAR
wea.hWnd=hWnd : wea.lParam=lParam : wea.wParam=wParam
WndProc=fnWndProc_OnChar(wea)
Exit Function
Case %WM_LBUTTONDOWN
wea.hWnd=hWnd : wea.lParam=lParam : wea.wParam=wParam
WndProc=fnWndProc_OnLButtonDown(wea)
Exit Function
Case %WM_PAINT
wea.hWnd=hWnd : wea.lParam=lParam : wea.wParam=wParam
WndProc=fnWndProc_OnPaint(wea)
Exit Function
Case %WM_DESTROY
Call PostQuitMessage(0)
WndProc=0
Exit Function
End Select
WndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
End Function
Function WinMain(ByVal hIns As Long,ByVal hPrevIns As Long,ByVal lpCmdLine As Asciiz Ptr,ByVal iShow As Long) As Long
Local szClassName As Asciiz*6
Local wc As WndClassEx
Local hMainWnd As Dword
Local Msg As tagMsg
szClassName="Form1"
wc.cbSize=SizeOf(wc) : wc.style=0
wc.lpfnWndProc=CodePtr(WndProc) : wc.cbClsExtra=0
wc.cbWndExtra=0 : wc.hInstance=hIns
wc.hIcon=LoadIcon(%NULL,ByVal %IDI_APPLICATION) : wc.hCursor=LoadCursor(%NULL,ByVal %IDC_ARROW)
wc.hbrBackground=GetStockObject(%WHITE_BRUSH) : wc.lpszMenuName=%NULL
wc.lpszClassName=VarPtr(szClassName) : wc.hIconSm=LoadIcon(%NULL,ByVal %IDI_APPLICATION)
Call RegisterClassEx(wc)
hMainWnd=CreateWindowEx(0,szClassName,"Form1",%WS_OVERLAPPEDWINDOW,200,100,325,300,%HWND_DESKTOP,0,hIns,ByVal 0)
Call ShowWindow(hMainWnd,iShow)
While GetMessage(Msg,%NULL,0,0)
Call TranslateMessage(Msg)
Call DispatchMessage(Msg)
Wend
WinMain=msg.wParam
End Function
« Last Edit: September 12, 2007, 06:16:57 AM by Theo Gottwald »
Type WndEventArgs
wParam As Long
lParam As Long
hWnd As Dword
hInst As Dword
wWidth As Word
wHeight As Word
wX As Word
wY As Word
wCharHt As Word
xPos As Word
yPos As Word
szText As Asciiz*128
End Type
Type TEXTMETRIC
tmHeight As Long
tmAscent As Long
tmDescent As Long
tmInternalLeading As Long
tmExternalLeading As Long
tmAveCharWidth As Long
tmMaxCharWidth As Long
tmWeight As Long
tmOverhang As Long
tmDigitizedAspectX As Long
tmDigitizedAspectY As Long
tmFirstChar As Byte
tmLastChar As Byte
tmDefaultChar As Byte
tmBreakChar As Byte
tmItalic As Byte
tmUnderlined As Byte
tmStruckOut As Byte
tmPitchAndFamily As Byte
tmCharSet As Byte
End Type
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Type PAINTSTRUCT
hdc As Long
fErase As Long
rcPaint As Rect
fRestore As Long
fIncUpdate As Long
rgbReserved As Byte
End Type
Type POINTAPI
x As Long
y As Long
End Type
Type MSG
hwnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
% WM_LBUTTONDOWN = &H201
% WM_LBUTTONUP = &H202
% WM_CREATE = 1
% WM_DESTROY = 2
% WM_PAINT = 15
% WM_QUIT = 18
% WM_SIZE = 5
% WM_MOVE = 3
% WM_CHAR = 258
% SW_SHOW = 5
% WS_OVERLAPPED = &h80000
% HWND_DESKTOP = 0
% IDI_WINLOGO = 32517
% IDC_ARROW = 32512
! GetDC Lib "user32.dll" (sys hwnd) As sys
! GetTextMetrics Lib "gdi32.dll" Alias "GetTextMetricsA" (sys hdc, ByRef lpMetrics As TEXTMETRIC) As sys
! ReleaseDC Lib "user32.dll" (sys hwnd, hdc) As sys
! InvalidateRect Lib "user32.dll" (sys hwnd, ByRef lpRect As RECT, sys bErase) As sys
! BeginPaint Lib "user32.dll" (sys hwnd, ByRef lpPaint As PAINTSTRUCT) As sys
! EndPaint Lib "user32.dll" (sys hwnd, ByRef lpPaint As PAINTSTRUCT) As sys
! TextOut Lib "gdi32.dll" Alias "TextOutA" (sys hdc, x, y, string lpString, sys nCount) As sys
! DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (sys hwnd, wMsg, wParam, lParam) As sys
! PostQuitMessage Lib "user32.dll" (sys nExitCode)
! GetMessage Lib "user32.dll" Alias "GetMessageA" (MSG *lpMsg, sys hwnd, wMsgFilterMin, wMsgFilterMax) As sys
! TranslateMessage Lib "user32.dll" (ByRef lpMsg As MSG) As sys
! DispatchMessage Lib "user32.dll" Alias "DispatchMessageA" (MSG *lpMsg) As sys
! LoadCursor Lib "user32.dll" Alias "LoadCursorA" (sys hInstance, string lpCursorName) As sys
! LoadIcon Lib "user32.dll" Alias "LoadIconA" (sys hInstance, string lpIconName) As sys
! CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" (sys dwExStyle, string lpClassName, lpWindowName, sys dwStyle, x, y, nWidth, nHeight, hWndParent, ByVal hMenu, hInstance, ByRef lpParam As Any) As sys
! RegisterClass Lib "user32.dll" Alias "RegisterClassA" (ByRef Class As WNDCLASS) As sys
! ShowWindow Lib "user32.dll" (sys hwnd, nCmdShow) As sys
Function HiWord (sys hi) as sys
shr hi,16
Return hi
End Function
Function LoWord (sys lo) as sys
and lo,0xFFFF
Return lo
End Function
Function fnWndProc_OnCreate(WndEventArgs *wea) As sys
TEXTMETRIC tm
sys hDC
hDC=GetDC(wea.hWnd)
GetTextMetrics(hDC,tm)
wea.wCharHt=tm.tmHeight
ReleaseDC(wea.hWnd,hDC)
MsgBox "wea.wCharHt= " + tm.tmHeight,"Achtung",48
Return 0
End Function
Function fnWndProc_OnMouseMove(WndEventArgs *wea) As sys
wea.wX=LoWord(wea.lParam) : wea.wY=HiWord(wea.lParam)
InvalidateRect(wea.hWnd,0,1)
Return 0
End Function
Function fnWndProc_OnSize(WndEventArgs *wea) As sys
wea.wWidth=LoWord(wea.lParam) : wea.wHeight=HiWord(wea.lParam)
InvalidateRect(wea.hWnd,0,1)
Return 0
End Function
Function fnWndProc_OnChar(wea As WndEventArgs) As Long
wea.szText=wea.szText+Chr$(wea.wParam)
InvalidateRect(wea.hWnd,0,1)
Return 0
End Function
Function fnWndProc_OnLButtonDown(wea As WndEventArgs) As Long
If wea.wParam= WM_LBUTTONDOWN
wea.xPos=LoWord(wea.lParam) : wea.yPos=HiWord(wea.lParam)
InvalidateRect(wea.hWnd,0,l)
End If
Return WM_LBUTTONDOWN
End Function
Function fnWndProc_OnPaint(WndEventArgs *wea) As sys
dim szLine As Asciiz*48
PAINTSTRUCT ps
sys hDC
hDC=BeginPaint(wea.hWnd,ps)
szLine="MouseX="+ Str(wea.wX) + " MouseY="+ Str(wea.wY)
TextOut(hDC,0,0,szLine,Len(szLine))
szLine="wea.wWidth="+Trim$(Str$(wea.wWidth)) & " wea.wHeight=" + Trim$(Str$(wea.wHeight))
TextOut(hDC,0,16,szLine,Len(szLine))
TextOut(hDC,0,32,wea.szText,Len(wea.szText))
If wea.xPos<>0 And wea.yPos<>0
szLine="WM_LBUTTONDOWN At (" + Str(wea.xPos) + "," + Str(wea.yPos) + ")"
TextOut(hDC,wea.xPos,wea.yPos,szLine,Len(szLine))
wea.xPos=0 : wea.yPos=0
End If
EndPaint(wea.hWnd,ps)
Return 0
End Function
Function WndProc(sys hWnd, wMsg, wParam, lParam) As sys
Static wea As WndEventArgs
Select wMsg
Case WM_CREATE
wea.hWnd=hWnd : wea.lParam=lParam : wea.wParam=wParam
'WndProc=fnWndProc_OnCreate(wea)
'Exit Function
Case WM_MOUSEMOVE
wea.hWnd=hWnd : wea.lParam=lParam : wea.wParam=wParam
'WndProc=fnWndProc_OnMouseMove(wea)
'Exit Function
Case %WM_SIZE
wea.hWnd=hWnd : wea.lParam=lParam : wea.wParam=wParam
'WndProc=fnWndProc_OnSize(wea)
'Exit Function
Case WM_CHAR
wea.hWnd=hWnd : wea.lParam=lParam : wea.wParam=wParam
'WndProc=fnWndProc_OnChar(wea)
'Exit Function
Case WM_LBUTTONDOWN
wea.hWnd=hWnd : wea.lParam=lParam : wea.wParam=wParam
'WndProc=fnWndProc_OnLButtonDown(wea)
'Exit Function
Case WM_PAINT
wea.hWnd=hWnd : wea.lParam=lParam : wea.wParam=wParam
'WndProc=fnWndProc_OnPaint(wea)
'Exit Function
Case WM_DESTROY
Call PostQuitMessage(0)
WndProc=0
Exit Function
End Select
WndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
End Function
Function WinMain(sys hIns, hPrevIns, asciiz lpCmdLine, sys iShow) As sys
dim szClassName As Asciiz*6
WndClassEx wc
sys hMainWnd
Msg tagMsg
szClassName="CrapForm"
wc.cbSize=SizeOf(wc) : wc.style=0
wc.lpfnWndProc= &WndProc : wc.cbClsExtra=0
wc.cbWndExtra=0 : wc.hInstance=hIns
wc.hIcon=LoadIcon(0,IDI_WINLOGO) : wc.hCursor=LoadCursor(0, IDC_ARROW)
wc.hbrBackground=GetStockObject(WHITE_BRUSH) : wc.lpszMenuName=NULL
wc.lpszClassName=VarPtr(szClassName) : wc.hIconSm=LoadIcon(0,IDI_WINLOGO)
RegisterClassEx &wc
hMainWnd=CreateWindowEx(0,szClassName,"CrapForm", WS_OVERLAPPED,200,100,325,300,HWND_DESKTOP,0,hIns,ByVal 0)
ShowWindow(hMainWnd,iShow)
While GetMessage(&Msg,0,0,0)
TranslateMessage(&Msg)
DispatchMessage (&Msg)
Wend
WinMain=msg.wParam
End Function
! RegisterClass Lib "user32.dll" Alias "RegisterClassA" (ByRef Class As WNDCLASS) As sys
InvalidateRect(wea.hWnd,0,1)
Function fnWndProc_OnMouseMove(WndEventArgs *wea) As sys
right? wea.szText = wea.szText + Chr$(wea.wParam)
..how >:(Function WinMain(sys hIns, hPrevIns, lpCmdLine, iShow) As sys
WndClass wc
sys hMainWnd
Msg tagMsg
wc.style=0
wc.lpfnWndProc=&WndProc
wc.cbClsExtra=0
wc.cbWndExtra=0
wc.hInstance=hIns
wc.hIcon=LoadIcon (0,IDI_WINLOGO)
wc.hCursor=LoadCursor (0,IDC_ARROW)
wc.hbrBackground=0
wc.lpszMenuName=0
wc.lpszClassName=StrPtr("win")
RegisterClass wc
hMainWnd=CreateWindowEx(0,szClassName,0, WS_OVERLAPPED,200,100,325,300,HWND_DESKTOP,0,hIns,0)
ShowWindow(hMainWnd, SW_SHOW)
While GetMessage(tagMsg,0,0,0)
TranslateMessage(tagMsg)
DispatchMessage (tagMsg)
Wend
Return msg.wParam
End Function
! GetStockObject Lib "gdi32.dll" (sys nIndex) As sys
wea.szText = wea.szText + Chr$(wea.wParam)
what means 'unprototyped'