Oxygen Basic
Programming => Example Code => Topic started by: Frankolinox on September 17, 2013, 12:35:11 AM
-
winapi topic: click with leftmouse into window "dialog"...
'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
-
hey Frank
you give me idea how to create simple mouse GDI drawing program....
'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
-
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.
-
crypted.. ???
nothing is cypted frank, you probably miss something. ::)
new MD with RGB colors...check small buttons
'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
-
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:
...òŽ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
-
I am interested, which language is that?
Looks like cave-painting !
-
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 ;D
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.