Hello Charles & ALL
I am trying to make classic PLOT and DRAW functions using api calls
MoveToEx hdc, x,y ,lppt
and
LineTo hdc,x1,y1
and i made search all over net but nothing concrete
i just found this small example in C ...so
how this can be translated to Oxygenbasic...
any hint?
static POINT ptPrevious = { 0,0 };
static bool flag = false;
Vertex temp;
...
case WM_LBUTTONDOWN:
HDC hdc = GetDC(hWnd);
POINTS clickPoint = MAKEPOINTS(lParam);
if (flag == false) {
ptPrevious.x = clickPoint.x;
ptPrevious.y = clickPoint.y;
flag = true;
}
//store the point in connectLines
temp.SetX(clickPoint.x);
temp.SetY(clickPoint.y);
connectLines.push_back(temp);
MoveToEx(hdc, ptPrevious.x, ptPrevious.y, NULL);
LineTo(hdc, LOWORD(lParam), HIWORD(lParam));
//record previous point
ptPrevious.x = clickPoint.x;
ptPrevious.y = clickPoint.y;
ReleaseDC(hWnd, hdc);
break;
Hi Aurel,
uses corewin includes all the GDI functions. Then it's much the same as your C snippet. But it is better to store all the plots into an array, so you can do screen refreshes, and save/reload the plot.
Hi Charles
I agree that would be nice to store data in array
if you like speed, make these commands in ASM.
You so know know ASM?
Ask ChatGPT he can give you the ASM Code for all these commands.
I have tried, it works. Ok, it may need small corrections here and there but generally its fine.
section .data
; Define the width and height of the image
width db 100
height db 100
; Define the starting x and y position of the line
x_start db 50
y_start db 50
; Define the angle and length of the line
angle dd 3.14159265358979 / 4
length dd 50
section .bss
; Reserve space for the image buffer
image_buffer resb width * height * 3
section .text
; The main function
global _start
_start:
; Load the angle and length into the x87 FPU
fld angle
fsin
fstp [sin_result]
fld angle
fcos
fstp [cos_result]
; Calculate the end position of the line
mov eax, [length]
fild eax
fmul dword [sin_result]
fistp [y_end]
mov eax, [length]
fild eax
fmul dword [cos_result]
fistp [x_end]
; Add the starting position to the end position to get the final end position
add [x_end], [x_start]
add [y_end], [y_start]
; Calculate the delta x and y
mov eax, [x_end]
sub eax, [x_start]
mov [delta_x], eax
mov eax, [y_end]
sub eax, [y_start]
mov [delta_y], eax
; Calculate the address of the starting pixel
mov ebx, image_buffer
add ebx, y_start * width * 3
add ebx, x_start * 3
; Draw the line
mov eax, [delta_x]
mov edx, [delta_y]
cmp eax, 0
jge .x_positive
neg eax
.x_positive:
cmp edx, 0
jge
Quoteif you like speed, make these commands in ASM
Oh ..you don't know ?
o2 basic and o2 asm run at same speed ..i
TESTED
But in O2 you still need to handcode it yourself :-)
Hi,
it might be easier to use WINDOW.INC under !PROJB?
Hi,
one question, using WINDOW.INC how do I intercept a single press of the mouse key and intercept its release?
If MouseButton=1 this intercepts my left mouse button... how do I know when I've released it?
Should I loop to see when the MouseButton returns to zero?
I tried it but it crashes the program.
Cheers
Hi Nicola,
Make sure you have a Sleep call inside loops, so that WndProc messages get serviced.
This is the wndproc in window.inc. You can see how it sets MouseButton and other state variables.
Function WndProc(byval hWnd as sys,byval wMsg as sys, byval wParam as sys,byval lparam as sys) as sys callback
iF wMsg = WM_CREATE
'
ElseiF wMsg = WM_PAINT
'
ElseiF wMsg = WM_SIZE
FlipBuffer
'
ElseiF wMsg = WM_MOVE
FlipBuffer
ValidateRect sys_hwnd,0
'
ElseiF wMsg = WM_MOUSEMOVE
xMouse = LoWord(lParam)
yMouse = HiWord(lParam)
InValidateRect sys_hwnd,0,0
'
ElseiF wMsg = WM_LBUTTONDOWN
MouseButton =1
InvalidateRect hWnd,0,0
ElseiF wMsg = WM_LBUTTONUP
MouseButton =0
InvalidateRect hWnd,0,0
ElseiF wMsg = WM_RBUTTONDOWN
MouseButton =2
InvalidateRect hWnd,0,0
ElseiF wMsg = WM_RBUTTONUP
MouseButton =0
InvalidateRect hWnd,0,0
ElseiF wMsg = WM_MBUTTONDOWN
MouseButton =4
InvalidateRect hWnd,0,0
ElseiF wMsg = WM_MBUTTONUP
MouseButton =0
InvalidateRect hWnd,0,0
'
ElseiF wMsg = WM_CHAR
AscKey = wParam
InvalidateRect hWnd,0,0
'
ElseiF wMsg = WM_KEYUP
AscKey =0
InvalidateRect hWnd,0,0
'
ElseiF wMsg = WM_DESTROY
PostQuitMessage 0
Else
Function = DefWindowProc hWnd,wMsg,wParam,lParam
End iF
End Function
Charles,
why doesn't it work properly?
'Paintn
'--------------
indexBase 0
include "window.inc"
redim int pu[20,2] 'contiene le coordinate dei punti
int pp = 0 'puntatore di pu[]
Sub WaitFrames(sys Frame)
QueryPerformanceFrequency sys_Freq
sys_Interval = sys_Freq/Frame
While (1)
QueryPerformanceCounter sys_cT2
iF sys_cT2 >= sys_cT1 + sys_Interval
QueryPerformanceCounter sys_cT1
Exit Sub
End iF
Wend
End Sub
Sub ReleaseMouse()
while 1
sleep 1000
if mousebutton=0 then exit while
wend
end sub
Window "Paint",640,480,1
single vel, xOff, yOff, a, angle
int r,g,b,rc,gc,bc, j
rc=0xc8
gc=0xc8
bc=0xf8
r=255
g=0
b=0
clsColor rc,gc,bc
While WinExit=0
if key(82)<>0 then r=r+1 : r and=255
if key(71)<>0 then g=g+1 : g and=255
if key(66)<>0 then b=b+1 : b and=255
iF MouseButton=1
pp = pp + 1
pu[pp,0] = xMouse
pu[pp,1] = yMouse
sleep(200)
'ReleaseMouse()
if pp>1 then
line (pu[pp,0], pu[pp,1], pu[pp-1,0], pu[pp-1,1],2,r,g,b)
end if
End iF
iF MouseButton=2 Then
clsColor rc,gc,bc
text 10,20,"cls",r,g,b
sleep(50)
int j
text 1,1,"redraw fatto",r,g,b
pp=0
sleep 100
clsColor rc,gc,bc
for j=2 to pp
line (pu[j,0], pu[j,1], pu[j-1,0], pu[j-1,1],2,r,g,b)
next
end if
Events
FlipBuffer
WaitFrames 34
Wend
WinEnd
I rarely use Peter Wirbelauer's API but I would start with one of his GDI examples and make incremental changes, working towards the program you want to achieve. Bugs are detected and easily isolated during this process. It's how nature does it, and also AI :)
Hi Charles,
I'm sorry, I thought you knew about it. Anyway I did as you said. In fact, the basis of the program was already there. I just entered a few commands. Furthermore, I believe that its operation is very elementary to be able to create problems, unless the API you were talking about does not have a non-linear management of the commands.
This API is really intended for 2D games and single-window graphics demos. Nonetheless it has some very useful 'seed' functions. I think what we need is a system that does the graphics but also supports child windows for controlling and script editing. So I had the idea that we adapt an IDE and create an additional space for rendering graphics onto the main window...
hello
Additional space in IDE...then that looks like BASIC256 ..he he
I must say that i lerned programming in o2 with Peter include and examples ..
and yes Charles have right Peter WINDOW.inc is creted for 2D programming
and is not bad at all,it have some quirks but in general work fine and is simple .
On the other side my awinho37.inc ..is about building GUI programs and also have some quirks
but also ...as far i use it work well.
Charles,
please how do I change the color of the segments that are drawn when I press the left mouse button?
$ filename "t.exe"
'uses rtl32
'uses rtl64
'uses MinWin
uses corewin
'extern lib "gdi32.dll"
'sys Rectangle (sys hdc,X1,Y1,X2,Y2)
'sys Ellipse (sys hdc,X1,Y1,X2,Y2)
'end extern
#lookahead ' for procedures
% ID_Timer 3000
% Interval 100
'==================
'GLOBAL DEFINITIONS
'==================
sys inst,hdc
sys xmax,ymax,r,idx,idy,xball,yball
r =15 : idx =5 : idy=5 : xball=200 : yball=100
redim int pu[20,2] 'contiene le coordinate dei punti
int pp = 0, j, ref 'pp è puntatore di pu[]
macro RGB(r,g,b) {r+(g<<8)+(b<<16)}
'=========
'MAIN CODE
'=========
dim cmdline as asciiz ptr,inst as sys
&cmdline=GetCommandLine
inst=GetModuleHandle 0
'
'WINDOWS
'-------
'
WinMain inst,0,cmdline,SW_NORMAL
endprog:
'===========
'END OF MAIN
'===========
'crea la finstra
'------------------------------------------------------------------
Function WinMain(sys inst,prevInst,zstring*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 =0
wc.lpszClassName = strptr "Demo"
RegisterClass (&wc)
Wwd = 800 : Wht = 600 'dimensioni finestra
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=0
exit while
end if
if bRet = -1
'show an error message
exit while
else
TranslateMessage @wm
DispatchMessage @wm
end if
end while
End Function
dim as rect crect 'for WndProc and TimerProc
'-------------------------------------------------------------
function WndProc (sys hWnd,wMsg,wParam,lparam) as sys callback
'=============================================================
static as sys count=0, refreshes=0, hdc, htimer
static as String txt
static as PaintStruct Paintst
'==========
select wMsg
'==========
'--------------
case WM_CREATE
'=============
hTimer = SetTimer (hWnd, ID_Timer, 100, &TimerProc)
GetClientRect hWnd,&cRect
'--------------
case WM_TIMER
'=============
'--------------
case WM_DESTROY
'===============
KillTimer(hWnd,ID_TIMER)
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
hDC=BeginPaint hWnd,&Paintst
GetClientRect hWnd,&cRect
'style
'0x20 DT_SINGLELINE
'0x04 DT_VCENTER
'0x01 DT_CENTER
'0x25
'scrive il testo al centro della finestra
SetBkColor hdc,yellow
SetTextColor hdc,red
txt="x y pos" str(xball) " , " str(yball) " - " str(pp)
'DrawText hDC,"Hello World",-1,&cRect,0x25
DrawText hDC,strptr txt,-1,&cRect,0x25
refreshes+=1
Ellipse hdc, xball-r, yball-r, xball+r, yball+r
'Ellipse hdc, xball, yball, xball+20, yball+30
if pp>1 then
SetDCPenColor(hdc, RGB(0,0,255))
MovetoEx(hdc,pu[pp-1,0],pu[pp-1,1],null)
Lineto(hdc,pu[pp,0],pu[pp,1])
end if
'pressed rmousek
if ref=1 then
SetDCPenColor(hdc, RGB(0,0,255))
'SetDCBrushColor(hdc, RGB(0,255,0))
for j=2 to pp
MovetoEx(hdc,pu[j-1,0],pu[j-1,1],null)
Lineto(hdc,pu[j,0],pu[j,1])
next j
ref=0
end if
EndPaint hWnd,&Paintst
ValidateRect hwnd,&crect
'--------------
case WM_KEYDOWN
'==============
'============
Select wParam
'============
Case 37 : xball -= idx 'LEFT
Case 39 : xball += idx 'RIGHT
Case 38 : yball -= idy 'UP
Case 40 : yball += idy 'DOWN
Case 32 : Rectangle hdc, -1, -1, xmax+1, ymax+1 'SPACE
Case 27 : SendMessage hwnd, WM_CLOSE, 0, 0 'ESCAPE
End Select 'wParam
'
'InvalidateRect hwnd, &cRect, 1 'FULL SCREEN REFRESH
InvalidateRect hwnd, &cRect, false 'FULL SCREEN REFRESH
case WM_LBUTTONUP
pp += 1
pu[pp,0] = loword(lParam)
pu[pp,1] = hiword(lParam)
case WM_RBUTTONUP
Ref=1
'--------
case else
'========
function=DefWindowProc hWnd,wMsg,wParam,lParam
end select
end function ' WndProc
'----------------------------------------------------
sys TimerProc(sys hWnd,wMsg,nIDEvent,dwTime) callback
'====================================================
{
static sys d=1
select wMsg
Case WM_TIMER
'viene controllato l'allargamento e il restringimento del cerchio
'InvalidateRect hwnd,&crect,1
InvalidateRect hwnd,&crect,false
if r=50 then d=-1
if r=10 then d=1
r+=d
function = 0
end select
} ' TimerProc
I See 3 Commands for the Color:
Try these.
SetBkColor hdc,yellow
SetTextColor hdc,red
and we have
' Set Color to Blue
SetDCPenColor(hdc, RGB(0,0,255))
Hi Theo,
I tried...
the first two commands are used for the background and for the text. I've already tested the third one you mentioned but it doesn't give the desired result.
case WM_PAINT
...
...
SetDCPenColor(hdc, RGB(0,0,255))
MovetoEx(hdc,pu[pp-1,0],pu[pp-1,1],null)
Lineto(hdc,pu[pp,0],pu[pp,1])
...
the result is always black.
This is Peter's Line drawing procedure:
Sub Line(int x,y,a,b,w, rc,gc,bc)
sys iPen,hPen
int color = rc + gc*256 + bc*65536
iPen = CreatePen PS_SOLID,w,color
SelectObject bHdc, iPen
MoveToEx bHdc,x,y,Byval 0
LineTo bHdc,a,b
DeleteObject iPen
hPen = GetStockObject(DC_PEN)
SelectObject bHdc, hPen
End Sub
Hi Charles,
but I'm not using Peter's API, but I'm using your program "GraphWin.o2bas" as a basis.
However I've tried using Peter's sub and also using the commands directly in the main program, but it doesn't work. :(
if pp>1 then
int color = RGB(255,255,255)
sys iPen = CreatePen PS_SOLID,5,color
SelectObject hdc, iPen
'SetDCPenColor(hdc, RGB(0,0,255))
'MovetoEx(hdc,pu[pp-1,0],pu[pp-1,1],null)
MovetoEx(hdc,pu[pp-1,0],pu[pp-1,1])
Lineto(hdc,pu[pp,0],pu[pp,1])
'Line(pu[pp-1,0],pu[pp-1,1],pu[pp,0],pu[pp,1],1,0,0,255)
end if
I agree, it does not respond to color setting, neither by Pen nor SolidBrush. Perhaps working with Peter's Window.inc would be more productive. It draws onto a back buffer instead of directly to the screen and avoids flickering when the scene is animated.
Nicola,
One way to set the color using your code from post #15.
Change the line SetDCPenColor(hdc, RGB(0,0,255))
to SelectObject(hDc, CreatePen(PS_SOLID, 0, RGB(0, 0, 255))) 'Where %PS_SOLID = 0
Another way...
before the line SetDCPenColor(hdc, RGB(0, 0, 255))
add this SelectObject(hdc, GetStockObject(DC_PEN)) 'Where %DC_PEN =19
Thanks Pierre,
The second method works perfectly without needing a new brush of pen object.
in WM_PAINT:
'RGB COLOR
SetDCPenColor hdc,0x00ff00 'lime green
SetDCBrushColor hdc,0x00ff00 'lime green
'CAN SELECT BOTH PEN AND BRUSH
SelectObject hDC, hPen
SelectObject hDC, hBrush
Ellipse hdc, xball-r, yball-r, xball+r, yball+r
MoveToEx hdc,xball,yball,Byval 0
LineTo hdc,xball+r, yball+r
in WM_CREATE
% DC_BRUSH = 18
% DC_PEN = 19
static sys hPen = GetStockObject(DC_PEN)
static sys hBrush = GetStockObject(DC_BRUSH)
SUB DrawLine(BYVAL hDC AS LONG, BYVAL Xstart AS LONG, BYVAL Ystart AS LONG, BYVAL Xend AS LONG, BYVAL Yend AS LONG, BYVAL nStyle AS LONG, BYVAL nSize AS LONG, BYVAL nColor AS LONG)
LOCAL lp AS LOGPEN
LOCAL p AS POINTAPI
LOCAL hPen AS LONG
p.X = nSize: p.Y = nSize
IF nSize > 1 THEN nStyle = 0 ' %PS_SOLID
lp.lopnStyle = nStyle
lp.lopnWidth = p
lp.lopnColor = nColor
hPen = SelectObject(hDC, CreatePenIndirect(lp))
MoveToEx(hDC, Xstart, Ystart, BYVAL %NULL)
LineTo(hDC, Xend, Yend)
DeleteObject(SelectObject(hDC, hPen))
END SUB
and of course there is also the GdipDrawLine API.
Hi Pierre,
really great. I also used the first solution in the Paintx sub and it works great.
I prefer this solution because you can also set the thickness of the line to be drawn. Thank you.
$ filename "t.exe"
'uses rtl32
'uses rtl64
'uses MinWin
uses corewin
'extern lib "gdi32.dll"
'sys Rectangle (sys hdc,X1,Y1,X2,Y2)
'sys Ellipse (sys hdc,X1,Y1,X2,Y2)
'end extern
#lookahead ' for procedures
% ID_Timer 3000
% Interval 100
% PS_SOLID = 0
% DC_PEN = 19
% DC_BRUSH = 18
'==================
'GLOBAL DEFINITIONS
'==================
sys inst,hdc
sys xmax,ymax,r,idx,idy,xball,yball
r =15 : idx =5 : idy=5 : xball=200 : yball=100
redim int pu[20,2] 'contiene le coordinate dei punti
int pp = 0, j, ref, lm 'pp è puntatore di pu[]
'macro RGB(r,g,b) {r+(g<<8)+(b<<16)}
macro RGB(r,g,b) {r + g*256 + b*65536}
Sub Line(int x,y,a,b,w, rc,gc,bc,hdc, hpen,hBrush)
SetDCPenColor hdc,0x00ff00 'lime green
SetDCBrushColor hdc,0x00ff00 'lime green
'CAN SELECT BOTH PEN AND BRUSH
SelectObject hDC, hPen
SelectObject hDC, hBrush
MoveToEx Hdc,x,y,null
LineTo Hdc,a,b
'DeleteObject iPen
'hPen = GetStockObject(DC_PEN)
'SelectObject bHdc, hPen
'SelectObject Hdc, hPen
End Sub
Sub Linex(int x,y,a,b,w, rc,gc,bc,hdc)
SelectObject(hDc, CreatePen(PS_SOLID, w, RGB(rc,gc,bc)))
MoveToEx Hdc,x,y,null
LineTo Hdc,a,b
'DeleteObject iPen
'hPen = GetStockObject(DC_PEN)
'SelectObject bHdc, hPen
'SelectObject Hdc, hPen
End Sub
'=========
'MAIN CODE
'=========
dim cmdline as asciiz ptr,inst as sys
&cmdline=GetCommandLine
inst=GetModuleHandle 0
'
'WINDOWS
'-------
'
WinMain inst,0,cmdline,SW_NORMAL
endprog:
'===========
'END OF MAIN
'===========
'crea la finstra
'------------------------------------------------------------------
Function WinMain(sys inst,prevInst,zstring*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 =0
wc.lpszClassName = strptr "Demo"
RegisterClass (&wc)
Wwd = 800 : Wht = 600 'dimensioni finestra
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=0
exit while
end if
if bRet = -1
'show an error message
exit while
else
TranslateMessage @wm
DispatchMessage @wm
end if
end while
End Function
dim as rect crect 'for WndProc and TimerProc
'-------------------------------------------------------------
function WndProc (sys hWnd,wMsg,wParam,lparam) as sys callback
'=============================================================
static as sys count=0, refreshes=0, hdc, htimer
static as String txt
static as PaintStruct Paintst
'==========
select wMsg
'==========
'--------------
case WM_CREATE
'=============
hTimer = SetTimer (hWnd, ID_Timer, 100, &TimerProc)
GetClientRect hWnd,&cRect
static sys hPen = GetStockObject(DC_PEN)
static sys hBrush = GetStockObject(DC_BRUSH)
'--------------
case WM_TIMER
'=============
'--------------
case WM_DESTROY
'===============
KillTimer(hWnd,ID_TIMER)
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
hDC=BeginPaint hWnd,&Paintst
GetClientRect hWnd,&cRect
'style
'0x20 DT_SINGLELINE
'0x04 DT_VCENTER
'0x01 DT_CENTER
'0x25
'scrive il testo al centro della finestra
SetBkColor hdc,yellow
SetTextColor hdc,red
txt="x y pos" str(xball) " , " str(yball) " - " str(pp)
'DrawText hDC,"Hello World",-1,&cRect,0x25
DrawText hDC,strptr txt,-1,&cRect,0x25
refreshes+=1
Ellipse hdc, xball-r, yball-r, xball+r, yball+r
'Ellipse hdc, xball, yball, xball+20, yball+30
if (pp>1 and lm > 0) then
Linex(pu[pp-1,0],pu[pp-1,1],pu[pp,0],pu[pp,1],2,0,0,255,hdc)
lm=0
end if
'pressed rmousek
if ref=1 then
SelectObject(hDc, CreatePen(PS_SOLID, 4, RGB(0, 0, 253)))
for j=2 to pp
MovetoEx(hdc,pu[j-1,0],pu[j-1,1],null)
Lineto(hdc,pu[j,0],pu[j,1])
next j
ref=0
end if
EndPaint hWnd,&Paintst
ValidateRect hwnd,&crect
'--------------
case WM_KEYDOWN
'==============
'============
Select wParam
'============
Case 37 : xball -= idx 'LEFT
Case 39 : xball += idx 'RIGHT
Case 38 : yball -= idy 'UP
Case 40 : yball += idy 'DOWN
Case 32 : Rectangle hdc, -1, -1, xmax+1, ymax+1 'SPACE
Case 27 : SendMessage hwnd, WM_CLOSE, 0, 0 'ESCAPE
End Select 'wParam
'
'InvalidateRect hwnd, &cRect, 1 'FULL SCREEN REFRESH
InvalidateRect hwnd, &cRect, false 'FULL SCREEN REFRESH
case WM_LBUTTONUP
pp += 1
pu[pp,0] = loword(lParam)
pu[pp,1] = hiword(lParam)
lm=1
case WM_RBUTTONUP
Ref=1
'--------
case else
'========
function=DefWindowProc hWnd,wMsg,wParam,lParam
end select
end function ' WndProc
'----------------------------------------------------
sys TimerProc(sys hWnd,wMsg,nIDEvent,dwTime) callback
'====================================================
{
static sys d=1
select wMsg
Case WM_TIMER
'viene controllato l'allargamento e il restringimento del cerchio
'InvalidateRect hwnd,&crect,1
InvalidateRect hwnd,&crect,false
if r=50 then d=-1
if r=10 then d=1
r+=d
function = 0
end select
} ' TimerProc
SelectObject(hDc, CreatePen(PS_SOLID, w, RGB(rc,gc,bc)))
If you create a pen or brush, you will need to delete it afterwards using its handle: DeleteObject hp
Therefore the handle must be captured.
sys hp=CreatePen(PS_SOLID, w, RGB(rc,gc,bc))
SelectObject(hDc,hp )
...
DeleteObject hp
Charles,
You are right. There is even a little more to do, the original selected object must be restored after the job is done.
The CreatePen() way...
sys hPen = CreatePen(PS_SOLID, 0, RGB(0, 0, 255)) 'Where %PS_SOLID = 0
sys hOriginal = SelectObject(hDc, hPen)
...
'Do MovetoEx(), Lineto(), etc
...
SelectObject(hdc, hOriginal) 'Restore original object
DeleteObject(hPen) 'Delete the pen
The GetStockObject(DC_PEN) way...
sys hPen = GetStockObject(DC_PEN) 'Where %DC_PEN = 19
sys hOriginal = SelectObject(hdc, hPen)
SetDCPenColor(hdc, RGB(0, 0, 255))
...
'Do MovetoEx(), Lineto(), etc
...
SelectObject(hdc, hOriginal) 'Restore original object
DeleteObject(hPen) 'Not mandatory since this is a stock object
Hi,
ok, i destroyed the created object. I put it in the sub.
(a strange thing, if I delete the sub linex it gives me a meaningless error).
You're giving me some great input.
$ filename "t.exe"
'uses rtl32
'uses rtl64
'uses MinWin
uses corewin
'extern lib "gdi32.dll"
'sys Rectangle (sys hdc,X1,Y1,X2,Y2)
'sys Ellipse (sys hdc,X1,Y1,X2,Y2)
'end extern
#lookahead ' for procedures
% ID_Timer 3000
% Interval 100
% PS_SOLID = 0
% DC_PEN = 19
% DC_BRUSH = 18
'==================
'GLOBAL DEFINITIONS
'==================
sys inst,hdc
sys xmax,ymax,r,idx,idy,xball,yball
r =15 : idx =5 : idy=5 : xball=200 : yball=100
redim int pu[20,2] 'contiene le coordinate dei punti
int pp = 0, j, ref, lm 'pp è puntatore di pu[]
'macro RGB(r,g,b) {r+(g<<8)+(b<<16)}
macro RGB(r,g,b) {r + g*256 + b*65536}
Sub Linex(int x,y,a,b,w, rc,gc,bc,hdc)
End Sub
Sub Line(int x,y,a,b,w, rc,gc,bc,hdc)
sys hpen = CreatePen(PS_SOLID, w, RGB(rc,gc,bc))
sys hOriginal = SelectObject(hDc, hPen)
MoveToEx Hdc,x,y,null
LineTo Hdc,a,b
SelectObject(hdc, hOriginal) 'Restore original object
DeleteObject(hPen) 'Delete the pen
End Sub
'=========
'MAIN CODE
'=========
dim cmdline as asciiz ptr,inst as sys
&cmdline=GetCommandLine
inst=GetModuleHandle 0
'
'WINDOWS
'-------
'
WinMain inst,0,cmdline,SW_NORMAL
endprog:
'===========
'END OF MAIN
'===========
'crea la finstra
'------------------------------------------------------------------
Function WinMain(sys inst,prevInst,zstring*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 =0
wc.lpszClassName = strptr "Demo"
RegisterClass (&wc)
Wwd = 800 : Wht = 600 'dimensioni finestra
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=0
exit while
end if
if bRet = -1
'show an error message
exit while
else
TranslateMessage @wm
DispatchMessage @wm
end if
end while
End Function
dim as rect crect 'for WndProc and TimerProc
'-------------------------------------------------------------
function WndProc (sys hWnd,wMsg,wParam,lparam) as sys callback
'=============================================================
static as sys count=0, refreshes=0, hdc, htimer
static as String txt
static as PaintStruct Paintst
'==========
select wMsg
'==========
'--------------
case WM_CREATE
'=============
hTimer = SetTimer (hWnd, ID_Timer, 100, &TimerProc)
GetClientRect hWnd,&cRect
'--------------
case WM_TIMER
'=============
'--------------
case WM_DESTROY
'===============
KillTimer(hWnd,ID_TIMER)
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
hDC=BeginPaint hWnd,&Paintst
GetClientRect hWnd,&cRect
'style
'0x20 DT_SINGLELINE
'0x04 DT_VCENTER
'0x01 DT_CENTER
'0x25
'scrive il testo al centro della finestra
SetBkColor hdc,yellow
SetTextColor hdc,red
txt="x y pos" str(xball) " , " str(yball) " - " str(pp)
'DrawText hDC,"Hello World",-1,&cRect,0x25
DrawText hDC,strptr txt,-1,&cRect,0x25
refreshes+=1
Ellipse hdc, xball-r, yball-r, xball+r, yball+r
'Ellipse hdc, xball, yball, xball+20, yball+30
'pressed Lmousek
if (pp>1 and lm > 0) then
Line(pu[pp-1,0],pu[pp-1,1],pu[pp,0],pu[pp,1],7,0,0,255,hdc)
lm=0
end if
'pressed rmousek
if ref=1 then
for j=2 to pp
Line(pu[j-1,0],pu[j-1,1],pu[j,0],pu[j,1],2,0,0,255,hdc)
next j
ref=0
end if
EndPaint hWnd,&Paintst
ValidateRect hwnd,&crect
'--------------
case WM_KEYDOWN
'==============
'============
Select wParam
'============
Case 37 : xball -= idx 'LEFT
Case 39 : xball += idx 'RIGHT
Case 38 : yball -= idy 'UP
Case 40 : yball += idy 'DOWN
Case 32 : Rectangle hdc, -1, -1, xmax+1, ymax+1 'SPACE
Case 27 : SendMessage hwnd, WM_CLOSE, 0, 0 'ESCAPE
End Select 'wParam
'
'InvalidateRect hwnd, &cRect, 1 'FULL SCREEN REFRESH
InvalidateRect hwnd, &cRect, false 'FULL SCREEN REFRESH
case WM_LBUTTONUP
pp += 1
pu[pp,0] = loword(lParam)
pu[pp,1] = hiword(lParam)
lm=1
case WM_RBUTTONUP
Ref=1
'--------
case else
'========
function=DefWindowProc hWnd,wMsg,wParam,lParam
end select
end function ' WndProc
'----------------------------------------------------
sys TimerProc(sys hWnd,wMsg,nIDEvent,dwTime) callback
'====================================================
{
static sys d=1
select wMsg
Case WM_TIMER
'viene controllato l'allargamento e il restringimento del cerchio
'InvalidateRect hwnd,&crect,1
InvalidateRect hwnd,&crect,false
if r=50 then d=-1
if r=10 then d=1
r+=d
function = 0
end select
} ' TimerProc