Can't draw with WM_MOUSEMOVE

[Tolo68]

Hello everyone, when I move the mouse over the window, it doesn't draw the line, I guess I have to redraw the window, but I don't know how. Thanks in advance!!!

Code: Select all

#include "windows.bi"

Dim shared hDC As HDC

Function WndProc(ByVal hWnd As HWND, ByVal msg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As LRESULT
    
  Select Case msg
  
  Case WM_CREATE
    Dim ArialFont As HFONT
    Dim OldFont As HFONT
    ArialFont = CreateFont(40, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, "Arial")
    OldFont = SelectObject(GetDC(hWnd), ArialFont)
    DeleteObject OldFont
    SetBkMode(GetDC(hWnd), TRANSPARENT)
    
  
  case WM_LBUTTONDOWN
      print "WM_LBUTTONDOWN"
  
  case WM_MOUSEMOVE
      print "WM_MOUSEMOVE"
      lineto(hdc,100,100)
  
  Case WM_PAINT
    Dim ps As PAINTSTRUCT
    
    hDC = BeginPaint( hWnd, @ps )
    
    TextOut hDC, 10, 10, "Hello, Windows!", 15
    EndPaint hWnd, @ps
    
  Case WM_DESTROY
    PostQuitMessage 0
    
  Case Else
    Return DefWindowProc( hWnd, msg, wParam, lParam )
    
  End Select 
End Function

Dim hInstance As HINSTANCE
dim wMsg as MSG
dim wcls as WNDCLASS     
dim szAppName as string
dim hWnd as HWND
  
  hInstance = GetModuleHandle(NULL)

  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( GRAY_BRUSH )
    .lpszMenuName  = NULL
    .lpszClassName = strptr( szAppName )
  end with
     
  if( RegisterClass( @wcls ) = FALSE ) then
    MessageBox( null, "Failed to register wcls!", szAppName, MB_ICONERROR )
    End
  end if
  
  hWnd = CreateWindowEx( 0, _
  szAppName, _
  "The Hello Program", _
  WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, _
  NULL, NULL, hInstance, NULL )
  
  ShowWindow( hWnd, SW_NORMAL )
  UpdateWindow( hWnd )
  
  while( GetMessage( @wMsg, NULL, 0, 0 ) <> FALSE )    
    TranslateMessage( @wMsg )
    DispatchMessage( @wMsg )
  wend
  

[SARG]

Comment this line : EndPaint hWnd, @ps

However not sure, again, the logic is ok.

In case you don't get what is expected use print getlasterror just after the statement to know if an error occurs.
Then use FormatMessage (Windows API) to get the text of the message error. I can give you later a snippet for that.

[dodicat]

A little fiddle around with your code.

Code: Select all

#include "windows.bi"

Dim Shared hDC As HDC
Function Set_Font (Font As String,Size As Long,Bold As Long,Italic As Long,Underline As Long,StrikeThru As Long) As HFONT
      Dim As HDC hDC=GetDC(HWND_DESKTOP)
      Dim As Long CyPixels=GetDeviceCaps(hDC,LOGPIXELSY)
      ReleaseDC(HWND_DESKTOP,hDC)
      Return CreateFont(0-(Size*CyPixels)/72,0,0,0,Bold,Italic,Underline,StrikeThru,ANSI_CHARSET _
      ,OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,FF_DONTCARE,Font)
End Function

Function WndProc(Byval hWnd As HWND, Byval msg As UINT, Byval wParam As WPARAM, Byval lParam As LPARAM) As LRESULT
      
      Static As Any Ptr pen
      Static As boolean isdown
      Static As Point p
      Static As Long lx,ly
      Static As Any Ptr child
      Dim ArialFont As HFONT
      Select Case msg
      
      Case WM_CREATE
            ArialFont = Set_Font("Arial",40,0,0,0,0)
            child=createwindowex(0,"static","Left button down and move mouse", WS_VISIBLE Or WS_CHILD,100,100,400,180,hwnd,0,0,0)
            SendMessage(child,WM_SETFONT,Cast(WPARAM,ArialFont),0)
            hdc=GetDC(hwnd)
            Pen = CreatePen(PS_SOLID, 3, bgr(0, 0, 255))
            SelectObject(hdc, Pen)
      Case WM_LBUTTONDOWN
            Print "WM_LBUTTONDOWN"
            isdown=true
            getcursorpos(@p)
            ScreenToClient(hwnd, @p)
            lx=p.x
            ly=p.y
            
      Case WM_MOUSEMOVE
            If (isDown) Then
                  Print "WM_MOUSEMOVE"
                  getcursorpos(@p)
                  ScreenToClient(hwnd, @p)
                  MoveToEx(hdc, lx, ly, NULL)
                  lineto(hdc,p.x,p.y)
                  lx=p.x
                  ly=p.y
                  setwindowtext(child,Str(lx)+","+Str(ly))
            End If
      Case WM_LBUTTONUP
            
            isDown = false
            
      Case WM_PAINT
            Dim As PAINTSTRUCT ps
            Var hDC = BeginPaint( hWnd, @ps )
            SetBkMode(hdc, TRANSPARENT)
            TextOut hDC, 10, 10, "Hello, Windows!", 15
            EndPaint hWnd, @ps
            
      Case WM_DESTROY
            ReleaseDC(hwnd,hdc)
            PostQuitMessage 0
            
      Case Else
            Return DefWindowProc( hWnd, msg, wParam, lParam )
            
      End Select 
End Function

Dim hInstance As HINSTANCE
Dim wMsg As MSG
Dim wcls As WNDCLASS     
Dim szAppName As String
Dim hWnd As HWND

hInstance = GetModuleHandle(NULL)

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( GRAY_BRUSH )
      .lpszMenuName  = NULL
      .lpszClassName = Strptr( szAppName )
End With

If( RegisterClass( @wcls ) = FALSE ) Then
      MessageBox( null, "Failed to register wcls!", szAppName, MB_ICONERROR )
      End
End If

hWnd = CreateWindowEx( 0, _
szAppName, _
"The Hello Program", _
WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, _
NULL, NULL, hInstance, NULL )
Dim  As HFONT  ThisFont:ThisFont=Set_Font("Times new roman",14,0,0,0,0)
ShowWindow( hWnd, SW_NORMAL )
UpdateWindow( hWnd )

While( GetMessage( @wMsg, NULL, 0, 0 ) <> FALSE )    
      TranslateMessage( @wMsg )
      DispatchMessage( @wMsg )
Wend
 

[Tolo68]

Thank you SARG and dodicat !!!!

The last example worked for me !!!!! The only thing is that I have added some buttons, and it also paints the line on top of them

Code: Select all

Case WM_CREATE
            ArialFont = Set_Font("Arial",40,0,0,0,0)
            child=createwindowex(0,"static","Left button down and move mouse", WS_VISIBLE Or WS_CHILD,100,100,400,180,hwnd,0,0,0)
            
            ''''' added buttons
            dim x as integer
            dim y as integer
            dim button as hwnd
            for x=0 to 1000 step 150
                for y=0 to 1000 step 40
                    button = CreateWindowEx( 0, "BUTTON", "Button 1", WS_VISIBLE Or WS_CHILD, x, y, 100, 20, hwnd, 0, 0, 0 )
                next y
            next x

[Tolo68]

I was able to solve it, I added

WS_CLIPCHILDREN Or WS_CLIPSIBLINGS to main window

Code: Select all

hWnd = CreateWindowEx( 0, _
  szAppName, _
  "The Hello Program", _
  WS_OVERLAPPEDWINDOW Or WS_CLIPCHILDREN Or WS_CLIPSIBLINGS, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, _
  NULL, NULL, hInstance, NULL )

Thank you all !!!!

[SARG]

As promised the snippet

Code: Select all

'=========================================================
'' translates code message to the text (only windows)
'=========================================================

#include "windows.bi"
private sub winmsg(code as integer)
	Dim Buffer As String*210
	'Format the message string
	FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0,code , LANG_NEUTRAL, Buffer, 200, ByVal 0)
	print"Windows code :";code;" Message : "+buffer
End Sub

winmsg(6)
sleep

[Tolo68]

Thank you very much SARG!! Then I try it. Best regards