Author Topic: Fred win32 - The Window procedure  (Read 6603 times)

0 Members and 1 Guest are viewing this topic.

Aurel

  • Guest
Fred win32 - The Window procedure
« on: December 12, 2012, 03:17:10 PM »
Hi Charles..
I read about situation on PowerBasic forum and just look little bit in JoseRoca forum
and
found Fred win32 api tutorial - The Window Procedure.
Example looks nice & clear...
What exactly represent that aproach ?
Do we (I) can translate on easy way this exaample to Oxygen?
Code: [Select]
'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 »

Peter

  • Guest
Re: Fred win32 - The Window procedure
« Reply #1 on: December 13, 2012, 08:37:04 AM »
Hi Aurel,

Try this, might be incorrect!
Code: [Select]
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
« Last Edit: December 13, 2012, 03:14:03 PM by peter »

Aurel

  • Guest
Re: Fred win32 - The Window procedure
« Reply #2 on: December 13, 2012, 08:55:26 AM »
Hey Peter.. :)
Thank you for respond and for converting...
oxygen complain about this line:
Code: [Select]
! RegisterClass    Lib "user32.dll" Alias "RegisterClassA" (ByRef Class As WNDCLASS) As sys
And it looks that WNDCLASS structure is not defined...
Hmm... i'm still not sure what this aproach mean. ???
I even download older release of JoseRoca include files which are huge..(7MB)

Aurel

  • Guest
Re: Fred win32 - The Window procedure
« Reply #3 on: December 13, 2012, 09:14:22 AM »
Ok i add WNDCLASS and looks that is accepted but compiler found error in line 143
with UDT wea.hwnd here:
Code: [Select]
InvalidateRect(wea.hWnd,0,1)
wea variable is defined as pointer
Code: [Select]
Function fnWndProc_OnMouseMove(WndEventArgs *wea) As sysright?
Maybe is this shape of UDT is not supportrd by oxygen or i am in wrong.. :-\

Peter

  • Guest
Re: Fred win32 - The Window procedure
« Reply #4 on: December 13, 2012, 09:24:03 AM »
here:
InvalidateRect(wea.hWnd,NULL,0)

Aurel

  • Guest
Re: Fred win32 - The Window procedure
« Reply #5 on: December 13, 2012, 09:49:46 AM »
thanks Peter and another weird problem for me :
Code: [Select]
wea.szText = wea.szText + Chr$(wea.wParam)..how >:(

X

Peter

  • Guest
Re: Fred win32 - The Window procedure
« Reply #6 on: December 13, 2012, 09:52:48 AM »
corrected   :D

Code: [Select]
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

missing.

Code: [Select]
! GetStockObject   Lib "gdi32.dll"  (sys nIndex) As sys
« Last Edit: December 13, 2012, 03:13:18 PM by peter »

Peter

  • Guest
Re: Fred win32 - The Window procedure
« Reply #7 on: December 13, 2012, 09:55:44 AM »
Quote
wea.szText = wea.szText + Chr$(wea.wParam)

This knows only God!  :D

Aurel

  • Guest
Re: Fred win32 - The Window procedure
« Reply #8 on: December 13, 2012, 10:28:57 AM »
Heh... ;D
Yes it look that is true...oh man...
probably Charles know what's that mean... ::)

Charles Pegge

  • Guest
Re: Fred win32 - The Window procedure
« Reply #9 on: December 14, 2012, 03:57:05 AM »
Yep. Problem with fixed length string in a byref UDT

I've produced a rough translation, using minwin.inc and unprototyped calls

X

Aurel

  • Guest
Re: Fred win32 - The Window procedure
« Reply #10 on: December 14, 2012, 07:20:14 AM »
Thanks Charles... :)
It works now.
Sorry ...i am completely stupid for this tech words...
what means 'unprototyped' -
is that function who is not inside include file or something else?

Another thing...
what is a main advantage of this aproach ?

thanks
Aurel

Peter

  • Guest
Re: Fred win32 - The Window procedure
« Reply #11 on: December 14, 2012, 07:49:35 AM »
Quote
what means 'unprototyped'


without prototype.

Charles Pegge

  • Guest
Re: Fred win32 - The Window procedure
« Reply #12 on: December 14, 2012, 10:38:20 AM »

It is just a matter of preference for those who prefer working low-level. It is quick and compact, though not informative.

With recent releases, you can simply omit the prototype from the declaration:

Example from minwin.inc
Code: OxygenBasic
  1.   extern lib "GDI32.dll"
  2.   ! CreateCompatibleDC                            '2
  3.  ! CreateCompatibleBitmap                        '3
  4.  ! DeleteDC                                      '1
  5.  ! BitBlt                                        '9
  6.  ! SetBkColor                                    '4
  7.  ! SetTextColor                                  '4
  8.  ! GetStockObject                                '1
  9.  ! CreateSolidBrush                              '1
  10.  ! ChoosePixelFormat                             '2
  11.  ! SetPixelFormat                                '3
  12.  ! SelectObject                                  '2
  13.  ! DeleteObject                                  '1
  14.  ! SwapBuffers                                   '1
  15.  ! GetPixel                                      '4
  16.  ! SetPixel                                      '4
  17.  ! CreateFont         alias "CreateFontA"        '14
  18.  ! CreateFontIndirect alias "CreateFontIndirectA"'1
  19.  ! TextOut            alias "TextOutA"           '5
  20.  ! GetTextMetrics     alias "GetTextMetricsA"    '2
  21.  end extern
  22.