hellowin+mouse coordinates

[Frankolinox]

winapi topic: click with leftmouse into window "dialog"...

Code: [Select]

 'winapi, hello_win+MouseCoordinates by frankolinox, 16.sept.2013
  $ filename "t.exe"
  includepath "$/inc/"
  '#include "RTL32.inc"
  '#include "RTL64.inc"
  #include "MinWin.inc"

%WM_SETCURSOR        = &H0020???
%WM_LBUTTONDOWN      = &H0201???

TYPE RECT
  Left   AS LONG
  Top    AS LONG
  Right  AS LONG
  Bottom AS LONG
END TYPE

DECLARE FUNCTION PtInRect LIB "USER32.DLL" ALIAS "PtInRect" (lpRect AS RECT, BYVAL ptx AS LONG, BYVAL pty AS LONG) AS LONG
DECLARE FUNCTION GetCursorPos LIB "USER32.DLL" ALIAS "GetCursorPos" ( _
   BYREF lpPoint AS POINT _                            
 ) AS LONG                                              

DECLARE FUNCTION ScreenToClient LIB "USER32.DLL" ALIAS "ScreenToClient" ( _
   BYVAL hWnd AS DWORD _                                
 , BYREF lpPoint AS POINT _                            
 ) AS LONG                                              

  #lookahead ' for procedures
  s=error()
  '
  if s then
    print s
    end
  end if

  '=========
  'MAIN CODE
  '=========
  
  dim cmdline as asciiz ptr, inst as sys
  &cmdline=GetCommandLine
  inst=GetModuleHandle 0
  '
  'WINDOWS START
  '=============
  '
  WinMain inst,0,cmdline,SW_NORMAL
  end

  '--------------------------------------------------------------------
  Function WinMain(sys inst, prevInst, asciiz*cmdline, sys show) as sys
  '====================================================================
  WndClass wc
  MSG      wm

  sys hwnd, wwd, wht, wtx, wty, tax

  wc.style = CS_HREDRAW or CS_VREDRAW
  wc.lpfnWndProc = @WndProc
  wc.cbClsExtra =0
  wc.cbWndExtra =0    
  wc.hInstance =inst
  wc.hIcon=LoadIcon 0, IDI_APPLICATION
  wc.hCursor=LoadCursor 0,IDC_ARROW
  wc.hbrBackground = GetStockObject WHITE_BRUSH
  wc.lpszMenuName =null
  wc.lpszClassName = strptr "Demo"

  RegisterClass (@wc)
 
  Wwd = 420 : Wht = 300
  Tax = GetSystemMetrics SM_CXSCREEN
  Wtx = (Tax - Wwd) /2
  Tax = GetSystemMetrics SM_CYSCREEN
  Wty = (Tax - Wht) /2
 
  hwnd = CreateWindowEx 0,wc.lpszClassName,"OXYGEN BASIC",WS_OVERLAPPEDWINDOW,Wtx,Wty,Wwd,Wht,0,0,inst,0
  ShowWindow hwnd,SW_SHOW
  UpdateWindow hwnd
  '
  sys bRet
  '
  do while bRet := GetMessage (@wm, 0, 0, 0)
    if bRet = -1 then
      'show an error message
    else
      TranslateMessage @wm
      DispatchMessage @wm
    end if
  wend

  End Function



  dim as rect crect 'for WndProc and TimerProc

  '--------------------------------------------------------------
  function WndProc ( hWnd, wMsg, wParam, lparam ) as sys callback
  '==============================================================
    static as sys hGraphic
    static as sys hdc
    static as String txt
    static as PaintStruct Paintst
    static hit as byte
    point pt
    
    '==========
    select wMsg
    '==========      
    '--------------
    case WM_CREATE
    '=============
    GetClientRect  hWnd,&cRect
    '-------------------
    case %WM_LBUTTONDOWN      
    '===================
        GetCursorPos pt              
        ScreenToClient (hGraphic, pt)  
        print "here lButton: " + str(pt.x) + "," + str(pt.y)

      '--------------  
      case WM_DESTROY
      '===============
          
      PostQuitMessage 0
        
      '------------
      case WM_PAINT
      '============

      'TEXT
      'http://msdn.microsoft.com/en-us/library/dd144821(v=VS.85).aspx

      'DRAWING AND PAINTING
      'http://msdn.microsoft.com/en-us/library/dd162760(v=VS.85).aspx

      GetClientRect  hWnd,&cRect
      hDC=BeginPaint hWnd,&Paintst
      'style
      '0x20 DT_SINGLELINE
      '0x04 DT_VCENTER
      '0x01 DT_CENTER
      '0x25

       SetBkColor   hdc,yellow
       SetTextColor hdc,red
       DrawText hDC,"Hello World!",-1,&cRect,0x25
       EndPaint hWnd,&Paintst
        
      '--------------  
      case WM_KEYDOWN
      '==============      

      '============            
      Select wParam
      '============

Case 27 : SendMessage hwnd, WM_CLOSE, 0, 0      'ESCAPE
      End Select
      
      '--------        
      case else
      '========
        function=DefWindowProc hWnd,wMsg,wParam,lParam
        
    end select

  end function ' WndProc

 
regards, frank

[Aurel]

hey Frank
you give me idea how to create simple mouse GDI drawing program....

Code: [Select]

'gui-skeleton app
$ Filename "MouseDraw.exe"
Include "RTL32.inc"
Include "awinh.inc"
#lookahead
INT win,win2
INT x,y,w,h,x2,y2,w2,h2
x=0:y=10:w=400:h=400
x2=410:y2=10:w2=400:h2=300
INT winstyle,wstyle2
winstyle = WS_MINMAXSIZE or WS_CLIPCHILDREN
wstyle2 = WS_MINMAXSIZE or WS_CLIPCHILDREN
INT b0ID = 100
'##### GLOBALS  ###############################################
INT hdc, hdcMem, hbmMem,   oldBmp, oldBrush, oldPen, oldFont,fColor
INT textX,textY,hBrush
String tBuffer
INT mx,my,tx,ty,hx,hy,mode
'##############################################################
'create window **************************************************
win = SetWindow("Double Buffered Window",x,y,w,h,0,winstyle)
'print "WIN:" +str(win)
'create button on win
'button0 = SetButton(win,80,4,80,26,"Close Win2",0x50000000,0x200,b0ID)
'create second window

'****************************************************************
'init paint structure if you plan to use BeginPaint/EndPaint
'PAINTSTRUCT ps
InitDrawing()

'text
TextColor(win,RGB(220,0,0),RGB(231,223,231))
TextOn(win,40,20,"Draw on window...")


'/////////
Wait()
'\\\\\\\\\

Function WndProc (sys hwnd,wmsg,wparam,lparam) as sys callback

SELECT hwnd
'----------------------------------------
CASE win
'----------------------------------------
Select wmsg

CASE WM_CLOSE
DestroyWindow win
'Clean DC objects
CleanUp()
PostQuitMessage 0

CASE WM_SIZE
'get current size of window
GetSize(win,0,0,w,h)

',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
CASE WM_PAINT
' //blit under WM_PAINT - can be blited inside Message Loop to //
' blit the memory DC buffer back to the window DC
BitBlt(hDC, 0, 0, w, h, hdcMem, 0, 0, SRCCOPY)

'mousemove msg
CASE WM_MOUSEMOVE
hx=LoWord(lParam): hy=HiWord(lParam)
'call mouse h
hMouse( hx, hy)

'left Mbutton
CASE WM_LBUTTONDOWN
mode=1
tx= LoWord(lParam)
ty = HiWord(lParam)
MoveXY (win,tx,ty)

'right Mbutton
CASE WM_LBUTTONUP
mode=0


',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    CASE WM_COMMAND
controlID = LoWord(wParam) 'get control ID
notifyCode = HiWord(wParam) 'get notification message

Select controlID
   CASE b0ID
If notifycode=0 
MsgBox "Close New Window!","To Win2"
         'CloseWindow(win2)
End If
    End Select
End select


END SELECT

RETURN Default

END FUNCTION
'----------------------------------------------------
'drawm
SUB hMouse(mx as INT,my as INT)
  IF mode=1
    LineToXY (win,mx,my)
  END IF
END SUB

SUB InitDrawing
''get current size of window
GetSize(win,0,0,w,h)
'get window DC
hdc=GetDC(win)
hdcMem = CreateCompatibleDC(0)
hbmMem = CreateCompatibleBitmap(hdc, w, h)
oldBmp = SelectObject( hdcMem, hbmMem )
oldBrush = SelectObject(hdcMem, CreateSolidBrush( RGB(231,223,231)) )
oldPen = SelectObject(hdcMem, CreatePen(PS_SOLID,1,RGB(231,223,231)))
'fill rectangle memDC with brush color
FillRect ( hdcMem,rc, oldBrush)
SetTextColor( hDC,RGB(0,0,0))
SetBkColor( hDC, RGB(231,223,231))
'blit to memDC
BitBlt(hDCmem, 0, 0, w, h, hdc, 0, 0, SRCCOPY)

ReleaseDC( win, hdc)
End SUB
'##########################################################
SUB TextColor (wID as INT,byval frontColor as sys,byval  backColor as sys )
hdc = GetDC(wID)

fColor=frontColor

SetTextColor( hDC, frontColor)
SetBkColor( hDC, backColor)

BitBlt(hDCmem, 0, 0, w, h, hdc, 0, 0, SRCCOPY)

ReleaseDC( wID, hdc)

END SUB
'########################################################

SUB TextOn(wID as INT,tx as INT,ty as INT,byval txt as string)

hdc = GetDC(wID)

'draw text to screen DC
TextOut hdc,tx,ty,txt,Len(txt)

'blit screen DC to memDC
BitBlt(hDCmem, 0, 0, w, h, hdc, 0, 0, SRCCOPY)

ReleaseDC( wID, hdc)

END SUB
 
'-------------------------------------------------

SUB Pset (wID as int , px as int ,py as int)
hdc = GetDC(wID)

SetPixel ( hdc, px, py, fColor)

BitBlt(hDCmem, 0, 0, w, h, hdc, 0, 0, SRCCOPY)

ReleaseDC( wID, hdc)

END SUB
'----------------------------------------------------------------

SUB LineXY (wID as INT,Lx as INT,Ly as INT,Lx1 as INT,Ly1 as INT)

hdc = GetDC(wID)
SelectObject(hdc, CreatePen(PS_SOLID,1,fColor))
MoveToEx (hdc,Lx,Ly,ByVal 0)
LineTo (hdc,Lx1,Ly1)

BitBlt(hDCmem, 0, 0, w, h, hdc, 0, 0, SRCCOPY)

ReleaseDC( wID, hdc)


END SUB

'--------------------------------------------------------------
SUB LineToXY (wID as INT,Lx1 as INT,Ly1 as INT)

hdc = GetDC(wID)
SelectObject(hdc, CreatePen(PS_SOLID,1,fColor))
'MoveToEx (hdc,Lx,Ly,ByVal 0)
LineTo (hdc,Lx1,Ly1)

BitBlt(hDCmem, 0, 0, w, h, hdc, 0, 0, SRCCOPY)

ReleaseDC( wID, hdc)


END SUB
'------------------------------------------------------------
SUB MoveXY (wID as INT,Lx as INT,Ly as INT)

hdc = GetDC(wID)
SelectObject(hdc, CreatePen(PS_SOLID,1,fColor))
MoveToEx (hdc,Lx,Ly,ByVal 0)


BitBlt(hDCmem, 0, 0, w, h, hdc, 0, 0, SRCCOPY)

ReleaseDC( wID, hdc)

END SUB

'----------------------------------
SUB CleanUp

DeleteDC(hdcMem)
DeleteObject(SelectObject(hdcMem, oldBrush))
DeleteObject(SelectObject(hdcMem, oldPen))
DeleteObject(SelectObject(hdcMem, oldBmp))


END SUB

X

[Frankolinox]

thanks for your little "painter" example, aurel. but your "awinh.inc" include file is crypted, I have used another file some weeks ago and the example works.

[Aurel]

crypted..
nothing is cypted frank, you probably miss something.
new MD with RGB colors...check small buttons

Code: [Select]

'gui-skeleton app
$ Filename "MouseDraw.exe"
Include "RTL32.inc"
Include "awinh.inc"
#lookahead
INT win,win2
INT x,y,w,h,x2,y2,w2,h2
x=0:y=10:w=800:h=600
x2=410:y2=10:w2=400:h2=300
INT winstyle,wstyle2
winstyle = WS_MINMAXSIZE or WS_CLIPCHILDREN
wstyle2 = WS_MINMAXSIZE or WS_CLIPCHILDREN
INT b0ID = 100
INT b1ID = 101
INT b2ID = 102
'##### GLOBALS  ###############################################
INT hdc, hdcMem, hbmMem,   oldBmp, oldBrush, oldPen, oldFont,fColor
INT textX,textY,hBrush
String tBuffer
INT mx,my,tx,ty,hx,hy,mode
INT b1dc
'##############################################################
'create window **************************************************
win = SetWindow("DBW Mouse Draw",x,y,w,h,0,winstyle)
'print "WIN:" +str(win)
'create button on win
button0 = SetButton(win,4,4,8,8,".",0x50000000,0x200,b0ID)
button1 = SetButton(win,16,4,8,8,".",0x50000000,0x200,b1ID)
button2 = SetButton(win,30,4,8,8,".",0x50000000,0x200,b2ID)
'color buttons
b1color()
'****************************************************************

InitDrawing()

'text
TextColor(win,RGB(20,0,220),RGB(231,223,231))
TextOn(win,410,10,"Click LeftMouseButton to draw on window...")


'/////////
Wait()
'\\\\\\\\\

Function WndProc (sys hwnd,wmsg,wparam,lparam) as sys callback

SELECT hwnd
'----------------------------------------
CASE win
'----------------------------------------
Select wmsg

CASE WM_CLOSE
DestroyWindow win
'Clean DC objects
CleanUp()
PostQuitMessage 0

CASE WM_SIZE
'get current size of window
GetSize(win,0,0,w,h)


',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
CASE WM_PAINT
' //blit under WM_PAINT - can be blited inside Message Loop to //
' blit the memory DC buffer back to the window DC
BitBlt(hDC, 0, 0, w, h, hdcMem, 0, 0, SRCCOPY)

'mousemove msg
CASE WM_MOUSEMOVE
hx=LoWord(lParam): hy=HiWord(lParam)
'call mouse h
hMouse( hx, hy)

'left Mbutton
CASE WM_LBUTTONDOWN
mode=1
tx= LoWord(lParam)
ty = HiWord(lParam)
MoveXY (win,tx,ty)

'right Mbutton
CASE WM_LBUTTONUP
mode=0


',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    CASE WM_COMMAND
controlID = LoWord(wParam) 'get control ID
notifyCode = HiWord(wParam) 'get notification message

  Select controlID
CASE b0ID
If notifycode=0 
fColor=RGB(200,0,0):chColor()
End If
CASE b1ID
If notifycode=0 
fColor=RGB(0,170,0):chColor()
End If
CASE b2ID
If notifycode=0 
fColor=RGB(0,0,220):chColor()
End If
  End Select
End select


END SELECT

RETURN Default

END FUNCTION
'----------------------------------------------------
'drawm
SUB hMouse(mx as INT,my as INT)
  IF mode=1
    LineToXY (win,mx,my)
  END IF
END SUB

'-------------------------------------------
'set button color
SUB b1color
'INT bBrush = CreateSolidBrush( RGB(0,0,220))
b1DC=GetDC(button0)
SetBkColor( b1Dc, RGB(231,223,231))
'FloodFill (b1Dc, 8, 8,RGB(1,3,231))
invalidaterect button0,0,1

END SUB
'-----------------------------------------------------
Sub chColor
hdc = GetDC(win)

frontColor=fcolor

SetTextColor( hDC, frontColor)
SetBkColor( hDC,RGB(231,223,231))

BitBlt(hDCmem, 0, 0, w, h, hdc, 0, 0, SRCCOPY)

ReleaseDC( win, hdc)


End Sub

'--------------------------------------------
SUB InitDrawing
''get current size of window
GetSize(win,0,0,w,h)
'get window DC
hdc=GetDC(win)
hdcMem = CreateCompatibleDC(0)
hbmMem = CreateCompatibleBitmap(hdc, w, h)
oldBmp = SelectObject( hdcMem, hbmMem )
oldBrush = SelectObject(hdcMem, CreateSolidBrush( RGB(231,223,231)) )
oldPen = SelectObject(hdcMem, CreatePen(PS_SOLID,1,RGB(231,223,231)))
'fill rectangle memDC with brush color
FillRect ( hdcMem,rc, oldBrush)
SetTextColor( hDC,RGB(0,0,0))
SetBkColor( hDC, RGB(231,223,231))
'blit to memDC
BitBlt(hDCmem, 0, 0, w, h, hdc, 0, 0, SRCCOPY)

ReleaseDC( win, hdc)
End SUB
'##########################################################
SUB TextColor (wID as INT,byval frontColor as sys,byval  backColor as sys )
hdc = GetDC(wID)

fColor=frontColor

SetTextColor( hDC, frontColor)
SetBkColor( hDC, backColor)

BitBlt(hDCmem, 0, 0, w, h, hdc, 0, 0, SRCCOPY)

ReleaseDC( wID, hdc)

END SUB
'########################################################

SUB TextOn(wID as INT,tx as INT,ty as INT,byval txt as string)

hdc = GetDC(wID)

'draw text to screen DC
TextOut hdc,tx,ty,txt,Len(txt)

'blit screen DC to memDC
BitBlt(hDCmem, 0, 0, w, h, hdc, 0, 0, SRCCOPY)

ReleaseDC( wID, hdc)

END SUB
 
'-------------------------------------------------

SUB Pset (wID as int , px as int ,py as int)
hdc = GetDC(wID)

SetPixel ( hdc, px, py, fColor)

BitBlt(hDCmem, 0, 0, w, h, hdc, 0, 0, SRCCOPY)

ReleaseDC( wID, hdc)

END SUB
'----------------------------------------------------------------

SUB LineXY (wID as INT,Lx as INT,Ly as INT,Lx1 as INT,Ly1 as INT)

hdc = GetDC(wID)
SelectObject(hdc, CreatePen(PS_SOLID,1,fColor))
MoveToEx (hdc,Lx,Ly,ByVal 0)
LineTo (hdc,Lx1,Ly1)

BitBlt(hDCmem, 0, 0, w, h, hdc, 0, 0, SRCCOPY)

ReleaseDC( wID, hdc)


END SUB

'--------------------------------------------------------------
SUB LineToXY (wID as INT,Lx1 as INT,Ly1 as INT)
GetSize(win,0,0,w,h)
hdc = GetDC(wID)
SelectObject(hdc, CreatePen(PS_SOLID,1,fColor))
'MoveToEx (hdc,Lx,Ly,ByVal 0)
LineTo (hdc,Lx1,Ly1)

BitBlt(hDCmem, 0, 0, w, h, hdc, 0, 0, SRCCOPY)

ReleaseDC( wID, hdc)


END SUB
'------------------------------------------------------------
SUB MoveXY (wID as INT,Lx as INT,Ly as INT)
GetSize(win,0,0,w,h)
hdc = GetDC(wID)
SelectObject(hdc, CreatePen(PS_SOLID,1,fColor))
MoveToEx (hdc,Lx,Ly,ByVal 0)


BitBlt(hDCmem, 0, 0, w, h, hdc, 0, 0, SRCCOPY)

ReleaseDC( wID, hdc)

END SUB

'----------------------------------
SUB CleanUp

DeleteDC(hdcMem)
DeleteObject(SelectObject(hdcMem, oldBrush))
DeleteObject(SelectObject(hdcMem, oldPen))
DeleteObject(SelectObject(hdcMem, oldBmp))


END SUB
X

[Frankolinox]

crypted.. Huh
nothing is cypted frank, you probably miss something.

aurel, I've downloade yesterday at ca. 15:20pm your "winh.inc" file and that was crypted, that's a fact. it looks like this one for me:

Code: [Select]

...òŽXó{±çŸÇ¶Ü‹¶­ÒÌ?{:?ÿ9ŽQ023#
ÒÚ}$ÀÈÌvV=##ůAƒ±køÛoãm¿é¯íù#ŠÓwhMÜÇ£#w€Ž:œ78yŸo²3øû&>Ï·y9ö}ŸÈÏÑÿþô{žù¹ö}žó…÷Ÿ}5Í#Ý¥C#
{Ð#z’•”#³ü­tççT=/YÓ¯}-?Û-öž¹#q\\©ë~#—³±âÖŽùƒçÕ#ý¬™âð¶ÙAÏ…Ç(
@XîÙ­i㊒7ÿšrc‡"¢:ð‚Ã^,ô1§Ù#æÿ$zgY
4ëšVM $+EŠ#ËmnÓ#}§àÉÈ#/RuÊ‹å뢻i×]ÑécÚŽ±Œ÷Ƕ›+¡{}ª#²¿–#8GóÞL
ŒÄŽÀÈÌY+#ƒ#bÖÇ Áصü}·ñœ·Æß#mÞ=OÉ:œÅ+#Ù{µùéÞ?ÿøޝñ¶ß#îÆÛsîû#†þž ³8¹ë.‚Ë=‚ËŠ/t{#°²BËÚpÂ#É#ˆîZ#â琎ƒÍŠgà0aŸ</<¯ÚÏõ˜D-#}PXhôkVW Ç­=ÚÝÓ?gkŽž]ó##NÌúõÒó>yGÞN#SŽ”–#A–
’e‹þ¯‘r$YŸ7Óˆ^-Oîøôβ##€Cí¢5ںˣë£Zþ !<§Öõ^¹#,û ⺋Ùï…ÏWq£zßŝ—W¥†9#`—êo ™­líŠ#FaäÀ\ÇecÐ`ìZØô#;#ÿ7¬íåŽÛ#mò7Û¶,×î–U#â×çë#{{ǶËÇ›#ý£ž##aP#&#†#bƒ#š}Q$
#u3Ÿ§âg«#š,#\\#ò#·#Â0Ç#$䶔#j#e.À.ö 1ì#°[Alï#€áŽ#³÷¥>©ö~ôäYö~ö'áóÌ°…Ì--iõ“##4*"Ažut¶œ+1#Qªy#á#У«#Œ#Ï®{±#C]ZÐeÊúõÍv)#hiCÉëlèØ/#¹$ó”úoL|sÑí#m»#ÐóKRœæÞ÷#³Ò_‹#ª (ØsJ²ÑôÕz#tüHióÝö##Oªtòêƒ#v8óû;Ê€¹*€¹‹%cÐ`ìZØô#;#¿œŸ7û²<Ûú{ž=1Æ“}-£#›¢#ËA /²·ÜŒ#ª## /#l6# ‹j#nB#<ä"¬rËH÷# pc#8Í6{({,1
...
and now? but it's not important as I took another include file for running your example.

frank

X

[Peter]

I am interested,  which language is that?
Looks like cave-painting !

[Aurel]

well i really don't get what was hapend with this file ,it looks like binary format loaded into
editor

maybe is this some sort of extraterestrial message

frank i really don't know what is this but hey...if i may ask?
from where you download this include file.

by the way i have somewhere one old program which can generate crypted file
but i never use them.