Запрет на запуск, больше одного раза.
Расположить в начале кода программы :
<![CDATA[
;--------Запрет на запуск больше одного раза---------------
*a = CreateSemaphore_(NULL,0,1,GetProgramName())
If *a <> 0 And GetLastError_()= #ERROR_ALREADY_EXISTS
CloseHandle_(*a)
End
EndIf
;---------------------------------------------------------
</plaintext>
</div><br><br><br>
<img src="img/lin.jpg" width="700" height="20" alt="Уроки PureBasic">
<p><a name="22"></a></p><h2 align="center">Гаджет линия</h2><br>
<center><img src="img/Line.png" width="456" height="309" alt="Уроки PureBasic"></center>
<div class="con">
<plaintext id="PureBasic">
; ///////////////////////Гаджет линия/////////////////////////////////
Procedure LineGadgetHeight(Gadget, x, y, Height, color)
Im=CreateImage(#PB_Any, 1, Height)
If Im
If StartDrawing(ImageOutput(Im))
Line(0,0, 0,Height ,color) ; для PB4.40 Line(0,0, 1,Height ,color)
StopDrawing()
ImageGadget(Gadget,x, y, 1,Height,ImageID(Im))
EndIf
EndIf
EndProcedure
Procedure LineGadgetWidth(Gadget, x, y, Width, color)
Im=CreateImage(#PB_Any, Width, 1)
If Im
If StartDrawing(ImageOutput(Im))
Line(0,0, Width,0 ,color) ; для PB4.40 Line(0,0, Width,1 ,color)
StopDrawing()
ImageGadget(Gadget,x, y, Width,1,ImageID(Im))
EndIf
EndIf
EndProcedure
; //////////////////////////////////////////////////////////////////////
OpenWindow(0, 100, 100, 450, 280, "Заголовок", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
SetWindowColor(0, $ffffff)
LineGadgetWidth (1, 20, 40, 300, $6C6C6C)
LineGadgetWidth (2, 20, 50, 300, $6C6C6C)
;--------------------------------------
LineGadgetHeight(3, 40, 20, 200, $0501FA)
LineGadgetHeight(4, 50, 20, 200, $0501FA)
Repeat
Event=WaitWindowEvent()
If Event=#PB_Event_CloseWindow
Break
EndIf
ForEver
</plaintext>
</div><br><br><br>
<img src="img/lin.jpg" width="700" height="20" alt="Уроки PureBasic">
<p><a name="33"></a></p><h2 align="center">Закругленные углы в Box</h2><br>
<center><img src="img/box.png" width="262" height="285" alt="Уроки PureBasic"></center>
<div class="con">
<plaintext id="PureBasic">
img = CreateImage(0,256,256,24)
StartDrawing(ImageOutput(0))
Box(0,0,256,256,#White)
StopDrawing()
pen = CreatePen_(#PS_SOLID,0,#Blue)
brush = CreateSolidBrush_(#Blue)
hdc = CreateCompatibleDC_(#Null)
SelectObject_(hdc, img)
SelectObject_(hdc, pen)
SelectObject_(hdc, brush)
RoundRect_(hdc, 20,20,236,236,20,20)
DeleteDC_(hdc)
OpenWindow(0,0,0,256,256,"Заголовок",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
ImageGadget(0,0,0,0,0,ImageID(0))
Repeat
Until WaitWindowEvent()=#PB_Event_CloseWindow
</plaintext>
</div><br><br><br>
<img src="img/lin.jpg" width="700" height="20" alt="Уроки PureBasic"><br>
<center><img src="img/box_2.png" width="206" height="179" alt="Уроки PureBasic"></center>
<div class="con">
<plaintext id="PureBasic">
CreateImage(0,105,30)
hdc = StartDrawing(ImageOutput(0))
DrawingMode(1)
FrontColor($0000FF)
RoundRect_(hdc,5,5,100,25,5,5)
DrawText(25, 7, "Hello !!!", #White)
StopDrawing()
OpenWindow(0,0,0,200,150,"",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
; imagebrush=CreatePatternBrush_(ImageID(0))
; SetClassLong_(WindowID(0),#GCL_HBRBACKGROUND,imagebrush)
ImageGadget(0,50,50,0,0,ImageID(0))
Repeat
Until WaitWindowEvent()=#PB_Event_CloseWindow
</plaintext>
</div><br><br><br>
<img src="img/lin.jpg" width="700" height="20" alt="Уроки PureBasic"><br>
<center><img src="img/box_3.png" width="206" height="179" alt="Уроки PureBasic"></center>
<div class="con">
<plaintext id="PureBasic">
Procedure RoundedBox(X, Y, W, H, R, Col)
X2 = X+r
Y2 = Y+r
W2 = W-R*2
H2 = H-R*2
Box(X2, Y, W2, R, Col)
Box(X, Y2, W, H2, Col)
Box(X2,Y2+H2, W2, R, Col)
Circle(X2, Y2, R, Col)
Circle(X2, Y2+H2-1, R, Col)
Circle(X2+W2-1, Y2, R, Col)
Circle(X2+W2-1, Y2+H2-1, R, Col)
EndProcedure
OpenWindow(0,0,0,200,150,"",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
CreateImage(0,200, 200)
StartDrawing(ImageOutput(0))
RoundedBox(10, 10,100,30, 10, #Blue)
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(35, 17, "Hello !!!", #White)
StopDrawing()
ImageGadget(0, 50, 50, 100, 30, ImageID(0))
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_CloseWindow
Quit = 1
EndIf
Until Quit = 1
</plaintext>
</div><br><br><br>
<img src="img/lin.jpg" width="700" height="20" alt="Уроки PureBasic"><br>
<center><img src="img/box_4.png" width="206" height="179" alt="Уроки PureBasic"></center>
<div class="con">
<plaintext id="PureBasic">
Procedure RoundedBox(X, Y, W, H, R, Col,wcol)
X2 = X+r
Y2 = Y+r
W2 = W-R*2
H2 = H-R*2
Box(x,y,w,h,wcol)
Box(X2, Y, W2, R, Col)
Box(X, Y2, W, H2, Col)
Box(X2,Y2+H2, W2, R, Col)
Circle(X2, Y2, R, Col)
Circle(X2, Y2+H2-1, R, Col)
Circle(X2+W2-1, Y2, R, Col)
Circle(X2+W2-1, Y2+H2-1, R, Col)
EndProcedure
OpenWindow(0,0,0,200,150,"",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
iw=100
ih=70
a$="Hello !!!"
R=10 ; radius
wcol=$FFFF00
SetWindowColor(0,wcol) ; должны сначала установить !
;wcol=GetWindowColor(0)
col=$00FFFF ; box color
CreateImage(0,iw,ih)
StartDrawing(ImageOutput(0))
RoundedBox(0, 0,iw,ih,R,col,wcol)
DrawingMode(#PB_2DDrawing_Transparent)
DrawText((iw-TextWidth(a$))/2,(ih-TextHeight(a$))/2,a$,0)
StopDrawing()
ImageGadget(0, 20, 20, 20+iw,20+ih, ImageID(0))
Repeat
Until WaitWindowEvent()=#PB_Event_CloseWindow
</plaintext>
</div><br><br><br>
<img src="img/lin.jpg" width="700" height="20" alt="Уроки PureBasic"><br>
<center><img src="img/box_5.png" width="206" height="179" alt="Уроки PureBasic"></center>
<div class="con">
<plaintext id="PureBasic">
Procedure RoundedBox(X, Y, W, H, R,FrT,FrC,FiC)
Box(X,Y,W,H,GetWindowColor(0)) ;Windows background color in case of Image output
;Box(0, 0, 200,150,$B5D4E6)
Circle(X+R,Y+R, R,FrC)
Circle(X+R,Y+R, R-FrT,FiC)
Circle(X+W-R,Y+R,R,FrC)
Circle(X+W-R,Y+R,R-FrT,FiC)
Circle(X+R,Y+H-R,R,FrC)
Circle(X+R,Y+H-R,R-FrT,FiC)
Circle(X+W-R,Y+H-R,R,FrC)
Circle(X+W-R,Y+H-R,R-FrT,FiC)
Box(X+R,Y,W-2*R,H,FrC)
Box(X+R,Y+FrT,W-2*R,H-2*FrT,FiC)
Box(X,Y+R,W,H-2*R,FrC)
Box(X+FrT,Y+R,W-2*FrT,H-2*R,FiC)
EndProcedure
X = 50
Y = 45
W = 100
H = 40
If H > W
Swap H,W
EndIf
R = 12 ; radius
a$ = "Hello !!!"
FiC=$01FFFE ;Fill Color
FrC=$FD0202 ;Frame Color
FrT=4 ;Frame Thickness
If H < 3*R
R = H/3
EndIf
OpenWindow(0,0,0,200,150,"",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
; StartDrawing(WindowOutput(0))
; RoundedBox(X,Y,W,H,R,FrT,FrC,FiC)
; DrawingMode(#PB_2DDrawing_Transparent)
; Draw Text need more care (Get text length in pixels and calculate the position exact)
; DrawText((W-TextWidth(a$))/2,(H-TextHeight(a$))/2,a$,$FD0202)
; StopDrawing()
SetWindowColor(0,$B5D4E6)
CreateImage(0,W,H)
StartDrawing(ImageOutput(0))
RoundedBox(0,0,W,H,R,FrT,FrC,FiC)
DrawingMode(#PB_2DDrawing_Transparent)
;Draw Text need more care (Get text length in pixels and calculate the position exact)
DrawText((W-TextWidth(a$))/2,(H-TextHeight(a$))/2,a$,$FD0202)
StopDrawing()
;ButtonImageGadget(0, 20, 20, W+2*FrT,H+2*FrT, ImageID(0))
ImageGadget(0, 20, 20, 20+W,20+H, ImageID(0))
Repeat
Until WaitWindowEvent()=#PB_Event_CloseWindow
</plaintext>
</div><br><br><br>
<img src="img/lin.jpg" width="700" height="20" alt="Уроки PureBasic"><br>
<center><img src="img/box_6.png" width="366" height="229" alt="Уроки PureBasic"></center>
<div class="con">
<plaintext id="PureBasic">
CreateImage(0,320,120 )
hdc = StartDrawing(ImageOutput(0))
Box(0,0,320,120,$000000)
DrawingMode(900)
FrontColor($6C6C6C)
RoundRect_(hdc,10,10,300,100,10,10)
LineXY(25, 40, 280, 40, $6C6C6C)
StopDrawing()
If OpenWindow(0, 0, 0, 360, 200, "Заголовок", #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget| #PB_Window_ScreenCentered)
SetWindowColor(0, $ffffff)
EndIf
ImageGadget(77,20,20,0,0,ImageID(0))
Repeat
Event=WaitWindowEvent()
If Event=#PB_Event_CloseWindow
Break
EndIf
ForEver
</plaintext>
</div><br><br><br>
<img src="img/lin.jpg" width="700" height="20" alt="Уроки PureBasic"><br>
<p><a name="44"></a></p><h2 align="center">Процедура таймер</h2>
<center><img src="img/taimer.png" width="256" height="129" alt="Уроки PureBasic"></center>
<div class="con">
<plaintext id="PureBasic">
; //////////////////////////////////Таймер//////////////////////////////
Global a,b
Procedure.s Secundomer() ;- Сама процедура таймера - всего 3 строчки!
a+1
If a=10:a=0:b=b+1:EndIf
SetGadgetText(30,FormatDate("%ii:%ss", b)+":"+ Str(a))
EndProcedure
; /////////////////////////////////////////////////////////////////////
OpenWindow(0, 0, 0, 250, 100, "Заголовок", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
SetWindowColor(0, $131313)
TextGadget(30, 165, 30, 45, 15, "00:00:0")
HyperLinkGadget(31, 25, 20, 80, 15, "Старт",RGB(167, 72, 2))
HyperLinkGadget(32, 25, 60, 80, 15, "Стоп",RGB(167, 72, 2))
For h=30 To 32
SetGadgetColor(h, #PB_Gadget_FrontColor, $055AE6)
SetGadgetColor(h, #PB_Gadget_BackColor, $131313)
Next h
Repeat
Delay (1)
Event= WaitWindowEvent()
Window=EventWindow()
Gadget=EventGadget()
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case 31
a=0:b=0
StartTimer( 1 , 100 , @Secundomer())
Case 32
EndTimer(1)
EndSelect
EndSelect
If Event=#PB_Event_CloseWindow
Break
EndIf
ForEver
</plaintext>
</div><br><br><br>
<a href="http://purebasic.info/phpBB2/viewtopic.php?p=8391&highlight=%D1%E0%EC%E0#8391"> http://purebasic.info</a><br><br>
<img src="img/lin.jpg" width="700" height="20" alt="Уроки PureBasic"><br>
<p><a name="55"></a></p><h2 align="center">Часы</h2>
<center><img src="img/clok.png" width="256" height="129" alt="Уроки PureBasic"></center>
<div class="con">
<plaintext id="PureBasic">
;////////////////////////////////////Часы/////////////////////////////////////////
Procedure Clok()
LoadFont(777,"Arial",8)
StartDrawing( WindowOutput(0) )
DrawingFont(FontID(777))
DrawingMode(777)
Box(100, 50, 45, 15, $131313)
FrontColor($055AE6)
DrawText(100,50,FormatDate("%hh:%ii:%ss", Date() ))
StopDrawing()
EndProcedure
; /////////////////////////////////////////////////////////////////////
OpenWindow(0, 0, 0, 250, 100, "Заголовок", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
SetWindowColor(0, $131313)
For i=1 To 250
WindowEvent()
Next i
Delay(10)
Repeat
Event= WaitWindowEvent()
;-------------------вывод часы--------------------
If zeit$<>FormatDate("%ss", Date() )
zeit$=FormatDate("%ss", Date() )
Clok()
EndIf
;--------------------------------------------------
If Event=#PB_Event_CloseWindow
Break
EndIf
ForEver
</plaintext>
</div><br><br><br>
<img src="img/lin.jpg" width="700" height="20" alt="Уроки PureBasic"><br><br>
<p><a name="66"></a></p><h2 align="center">Кнопка триггер</h2>
<center><img src="img/triger.png" width="256" height="129" alt="Уроки PureBasic"></center>
<div class="con">
<plaintext id="PureBasic">
OpenWindow(0, 0, 0, 250, 100, "Заголовок", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
ButtonGadget(1, 20, 20, 80, 20, "кнопка 1")
ButtonGadget(2, 20, 50, 80, 20, "кнопка 2")
TextGadget(77, 135, 20, 250, 15, "позиция 1")
TextGadget(78, 135, 50, 250, 15, "позиция 3")
Repeat
Event= WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case 1
Toggle = Toggle ! 1
If Toggle
SetGadgetText(77,"позиция 2")
Else
SetGadgetText(77,"позиция 1")
EndIf
Case 2
Toggle = Toggle ! 1
If Toggle
SetGadgetText(78,"позиция 4")
Else
SetGadgetText(78,"позиция 3")
EndIf
EndSelect
EndSelect
If Event=#PB_Event_CloseWindow
Break
EndIf
ForEver
</plaintext>
</div><br><br><br>
<img src="img/lin.jpg" width="700" height="20" alt="Уроки PureBasic"><br><br>
Свершилось - вся эта ерунда ( с альфа каналом ) в PureBasic 4.40 <b>не нужна</b>.<br><br>
Все и так прекрасно работает. Ура !
<p><a name="77"></a></p><h2 align="center">Альфа канал</h2><br>
<center><img src="img/alfa.png" width="406" height="329" alt="Уроки PureBasic"></center><br>
Изображения с альфа каналом, формат PNG-24
<div class="con">
<plaintext id="PureBasic">
UsePNGImageDecoder()
Declare WindowProc(hwnd, msgw,f,g )
Global image = CatchImage(#PB_Any, ?img, ?imgend-?img)
Global image2 = CatchImage(#PB_Any, ?img2, ?img2end-?img2)
Global image3 = CatchImage(#PB_Any, ?img3, ?img3end-?img3)
Global image4 = CatchImage(#PB_Any, ?img4, ?img4end-?img4)
Global image5 = CatchImage(#PB_Any, ?img5, ?img5end-?img5)
Global base = CreateImage(#PB_Any, 400,300,#PB_Image_DisplayFormat)
OpenWindow(0, 0, 0, 400, 300, "Window_0", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
SetWindowCallback(@WindowProc())
Repeat
Event= WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
Procedure WindowProc(hwnd, msgw,f,g)
result=#PB_ProcessPureBasicEvents
Select msgw
Case #WM_PAINT
hdc = BeginPaint_(hwnd, ps.PAINTSTRUCT)
dcOut = StartDrawing(ImageOutput(base))
BitBlt_(dcOut, 0,0,ImageWidth(base),ImageHeight(base),hdc,0,0,#SRCCOPY)
DrawAlphaImage(ImageID(image),0,0)
DrawAlphaImage(ImageID(image2),0,0)
DrawAlphaImage(ImageID(image4),70,40)
DrawAlphaImage(ImageID(image3),100,80)
DrawAlphaImage(ImageID(image5),230,160)
StopDrawing()
dcIn = StartDrawing(ImageOutput(base))
BitBlt_(hdc, 0,0,ImageWidth(base),ImageHeight(base),dcIn,0,0,#SRCCOPY)
StopDrawing()
EndPaint_(hwnd, ps)
result=0
EndSelect
ProcedureReturn result
EndProcedure
DataSection
img:
IncludeBinary "фон.png"
imgend:
img2:
IncludeBinary "Adium.png"
img2end:
img3:
IncludeBinary "alphatest.png"
img3end:
img4:
IncludeBinary "Butterfly.png"
img4end:
img5:
IncludeBinary "Compute.png"
img5end:
EndDataSection
</plaintext>
</div><br><br><br>
Скачать <a href="fail/alfa.rar">архив</a>
<img src="img/lin.jpg" width="700" height="20" alt="Уроки PureBasic"><br><br>
<center><img src="img/alfa_2.png" width="326" height="289" alt="Уроки PureBasic"></center>
<div class="con">
<plaintext id="PureBasic">
UsePNGImageDecoder()
Enumeration
#window
#logo
#logo2
EndEnumeration
Procedure Paintaa(WindowID, Message, wParam, lParam)
If Message = #WM_PAINT
If StartDrawing(WindowOutput(#window))
Box(0, 0, 320, 320, GetSysColor_(#COLOR_3DFACE))
DrawAlphaImage(ImageID(#logo), 40, 40)
DrawAlphaImage(ImageID(#logo2), 120, 40)
StopDrawing()
EndIf
EndIf
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
If OpenWindow(#window, #PB_Any, #PB_Any, 320, 260, "PureBasic Window", #PB_Window_ScreenCentered)
SetWindowCallback(@Paintaa())
LoadImage(#logo, "gimp_logo.png")
If StartDrawing(WindowOutput(#window))
Box(0, 0, 160, 160, GetSysColor_(#COLOR_3DFACE))
DrawAlphaImage(ImageID(#logo), 0, 0)
StopDrawing()
EndIf
LoadImage(#logo2, "Adium.png")
If StartDrawing(WindowOutput(#window))
Box(80, 50, 160, 160, GetSysColor_(#COLOR_3DFACE))
DrawAlphaImage(ImageID(#logo2), 80, 50)
StopDrawing()
EndIf
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_CloseWindow
Quit = 1
EndIf
Until Quit = 1
EndIf
End
</plaintext>
</div><br><br><br>
Скачать <a href="fail/png_2.rar">архив</a><br><br>
<img src="img/lin.jpg" width="700" height="20" alt="Уроки PureBasic"><br><br>
<p><a name="88"></a></p><h2 align="center">Геометрические фигуры</h2><br>
<center><img src="img/figyri.png" width="606" height="429" alt="Уроки PureBasic"></center><br>
<div class="con3">
<plaintext id="PureBasic">
Procedure.d Radian(degreeAngle.d)
ProcedureReturn ASin(1) / 90 * degreeAngle
EndProcedure
Procedure Pie(dc, x, y, w, h, angleStart, angleEnd, outlineColor = -1, fillColor = -1)
; Рисуем (круг / эллипс сектор)
; Создает кистью и пером
If outlineColor >= 0 : pen = CreatePen_(#PS_SOLID, 1, outlineColor) : Else : pen = GetStockObject_(#NULL_PEN) : EndIf
If fillColor >= 0 : brush = CreateSolidBrush_(fillColor) : Else : brush = GetStockObject_(#NULL_BRUSH) : EndIf
SelectObject_(dc, pen)
SelectObject_(dc, brush)
; Рассчитывает измерения углов http://www.purebasic.fr/english/viewtopic.php?t=13845
midx = w / 2
midy = h / 2
sx = 0 - (0 - midy) * Sin((2 * #PI) * angleStart / 360) + midx
sy = (0 - midy) * Cos((2 * #PI) * angleStart / 360) + midy
ex = 0 - (0 - midy) * Sin((2 * #PI) * angleEnd / 360) + midx
ey = (0 - midy) * Cos((2 * #PI) * angleEnd / 360) + midy
Pie_(dc, x, y, x + w, y + h, ex + x, ey + y, sx + x, sy + y)
If outlineColor >= 0 : DeleteObject_(pen) : EndIf
If fillColor >= 0 : DeleteObject_(brush) : EndIf
EndProcedure
Procedure RoundRectangle(dc, x, y, w, h, roundedWidth, roundedHeight, outlineColor = -1, fillColor = -1)
; Рисует прямоугольник с закругленными углами
If outlineColor >= 0 : pen = CreatePen_(#PS_SOLID, 1, outlineColor) : Else : pen = GetStockObject_(#NULL_PEN) : EndIf
If fillColor >= 0 : brush = CreateSolidBrush_(fillColor) : Else : brush = GetStockObject_(#NULL_BRUSH) : EndIf
SelectObject_(dc, pen)
SelectObject_(dc, brush)
; Рисует прямоугольник с закругленными углами
RoundRect_(dc, x, y, x + w, y + h, roundedWidth, roundedHeight)
If outlineColor >= 0 : DeleteObject_(pen) : EndIf
If fillColor >= 0 : DeleteObject_(brush) : EndIf
EndProcedure
Procedure Arc(dc, x, y, w, h, angleStart, angleEnd, outlineColor)
; Рисуем дугу
If outlineColor < 0 : outlineColor = 0 : EndIf
pen = CreatePen_(#PS_SOLID, 1, outlineColor)
SelectObject_(dc, pen)
; Рассчитываем измерения угла
midx = w / 2
midy = h / 2
sx = 0 - (0 - midy) * Sin((2 * #PI) * angleStart / 360) + midx
sy = (0 - midy) * Cos((2 * #PI) * angleStart / 360) + midy
ex = 0 - (0 - midy) * Sin((2 * #PI) * angleEnd / 360) + midx
ey = (0 - midy) * Cos((2 * #PI) * angleEnd / 360) + midy
; Рисует дугу
Arc_(dc, x, y, x + w, y + h, ex + x, ey + y, sx + x, sy + y)
DeleteObject_(pen)
EndProcedure
Procedure Chord(dc, x, y, w, h, angleStart, angleEnd, outlineColor = -1, fillColor = -1)
;Обращает аккорде (круг / эллипс разделе)
If outlineColor >= 0 : pen = CreatePen_(#PS_SOLID, 1, outlineColor) : Else : pen = GetStockObject_(#NULL_PEN) : EndIf
If fillColor >= 0 : brush = CreateSolidBrush_(fillColor) : Else : brush = GetStockObject_(#NULL_BRUSH) : EndIf
SelectObject_(dc, pen)
SelectObject_(dc, brush)
; Рассчитываеv измерения угла
midx = w / 2
midy = h / 2
sx = 0 - (0 - midy) * Sin((2 * #PI) * angleStart / 360) + midx
sy = (0 - midy) * Cos((2 * #PI) * angleStart / 360) + midy
ex = 0 - (0 - midy) * Sin((2 * #PI) * angleEnd / 360) + midx
ey = (0 - midy) * Cos((2 * #PI) * angleEnd / 360) + midy
Chord_(dc, x, y, x + w, y + h, ex + x, ey + y, sx + x, sy + y)
If outlineColor >= 0 : DeleteObject_(pen) : EndIf
If fillColor >= 0 : DeleteObject_(brush) : EndIf
EndProcedure
Procedure Triangle(dc, x1, y1, x2, y2, x3, y3, outlineColor = -1, fillColor = -1)
; Рисует треугольник - с помощью функции API Polygon_
If outlineColor >= 0 : pen = CreatePen_(#PS_SOLID, 1, outlineColor) : Else : pen = GetStockObject_(#NULL_PEN) : EndIf
If fillColor >= 0 : brush = CreateSolidBrush_(fillColor) : Else : brush = GetStockObject_(#NULL_BRUSH) : EndIf
SelectObject_(dc, pen)
SelectObject_(dc, brush)
; Создает многоугольник массив
Dim PolygonArray.l(5)
PolygonArray(0) = x1
PolygonArray(1) = y1
PolygonArray(2) = x2
PolygonArray(3) = y2
PolygonArray(4) = x3
PolygonArray(5) = y3
; Рисует треугольник
Polygon_(dc, @PolygonArray(), 3)
If outlineColor >= 0 : DeleteObject_(pen) : EndIf
If fillColor >= 0 : DeleteObject_(brush) : EndIf
EndProcedure
Procedure Parallelogram(dc, x, y, w, h, xPush, outlineColor = -1, fillColor = -1)
; Рисует параллелограмм - с помощью функции API Polygon_
If outlineColor >= 0 : pen = CreatePen_(#PS_SOLID, 1, outlineColor) : Else : pen = GetStockObject_(#NULL_PEN) : EndIf
If fillColor >= 0 : brush = CreateSolidBrush_(fillColor) : Else : brush = GetStockObject_(#NULL_BRUSH) : EndIf
SelectObject_(dc, pen)
SelectObject_(dc, brush)
; Создает параллелограмм массив
Dim PolygonArray.l(7)
PolygonArray(0) = x
PolygonArray(1) = y
PolygonArray(2) = x + xPush
PolygonArray(3) = y + h
PolygonArray(4) = x + xPush + w
PolygonArray(5) = y + h
PolygonArray(6) = x + w
PolygonArray(7) = y
; Рисует параллелограмм
Polygon_(dc, @PolygonArray(), 4)
; Deletes the brush and the pen
If outlineColor >= 0 : DeleteObject_(pen) : EndIf
If fillColor >= 0 : DeleteObject_(brush) : EndIf
EndProcedure
Procedure Trapezium(dc, upperX, upperW, lowerX, lowerW, y, h, outlineColor = -1, fillColor = -1)
; Рисует трапецию - с помощью функции API Polygon_
If outlineColor >= 0 : pen = CreatePen_(#PS_SOLID, 1, outlineColor) : Else : pen = GetStockObject_(#NULL_PEN) : EndIf
If fillColor >= 0 : brush = CreateSolidBrush_(fillColor) : Else : brush = GetStockObject_(#NULL_BRUSH) : EndIf
SelectObject_(dc, pen)
SelectObject_(dc, brush)
; Creates the polygon array
Dim PolygonArray.l(7)
PolygonArray(0) = upperX
PolygonArray(1) = y
PolygonArray(2) = lowerX
PolygonArray(3) = y + h
PolygonArray(4) = lowerX + lowerW
PolygonArray(5) = y + h
PolygonArray(6) = upperX + upperW
PolygonArray(7) = y
; Draws the trapezium
Polygon_(dc, @PolygonArray(), 4)
; Deletes the brush and the pen
If outlineColor >= 0 : DeleteObject_(pen) : EndIf
If fillColor >= 0 : DeleteObject_(brush) : EndIf
EndProcedure
Procedure Rhombus(dc, x, y, w, h, outlineColor = -1, fillColor = -1)
; Рисует ромба - с помощью функции API Polygon_
; Creates the brush and the pen
If outlineColor >= 0 : pen = CreatePen_(#PS_SOLID, 1, outlineColor) : Else : pen = GetStockObject_(#NULL_PEN) : EndIf
If fillColor >= 0 : brush = CreateSolidBrush_(fillColor) : Else : brush = GetStockObject_(#NULL_BRUSH) : EndIf
SelectObject_(dc, pen)
SelectObject_(dc, brush)
; Creates the polygon array
Dim PolygonArray.l(7)
PolygonArray(0) = Int((x + x + w) / 2)
PolygonArray(1) = y
PolygonArray(2) = x
PolygonArray(3) = Int((y + y + h) / 2)
PolygonArray(4) = Int((x + x + w) / 2)
PolygonArray(5) = y + h
PolygonArray(6) = x + w
PolygonArray(7) = Int((y + y + h) / 2)
; Draws the rhombus
Polygon_(dc, @PolygonArray(), 4)
; Deletes the brush and the pen
If outlineColor >= 0 : DeleteObject_(pen) : EndIf
If fillColor >= 0 : DeleteObject_(brush) : EndIf
EndProcedure
Procedure Cross(dc, x, y, w, h, verticalX, verticalW, horizontalY, horizontalH, outlineColor = -1, fillColor = -1)
; Рисуем крест- using the Polygon_ API function
; NOTE: you can center verticalX and/or horizontalY by giving them a value less than zero
; Creates the brush and the pen
If outlineColor >= 0 : pen = CreatePen_(#PS_SOLID, 1, outlineColor) : Else : pen = GetStockObject_(#NULL_PEN) : EndIf
If fillColor >= 0 : brush = CreateSolidBrush_(fillColor) : Else : brush = GetStockObject_(#NULL_BRUSH) : EndIf
SelectObject_(dc, pen)
SelectObject_(dc, brush)
If verticalX < 0 : verticalX = Int((w - verticalW) / 2) : EndIf
If horizontalY < 0 : horizontalY = Int((h - horizontalH) / 2) : EndIf
; Creates the polygon array
Dim PolygonArray.l(23)
PolygonArray(0) = x + verticalX + verticalW
PolygonArray(1) = y
PolygonArray(2) = x + verticalX
PolygonArray(3) = y
PolygonArray(4) = x + verticalX
PolygonArray(5) = y + horizontalY
PolygonArray(6) = x
PolygonArray(7) = y + horizontalY
PolygonArray(8) = x
PolygonArray(9) = y + horizontalY + horizontalH
PolygonArray(10) = x + verticalX
PolygonArray(11) = y + horizontalY + horizontalH
PolygonArray(12) = x + verticalX
PolygonArray(13) = y + h
PolygonArray(14) = x + verticalX + verticalW
PolygonArray(15) = y + h
PolygonArray(16) = x + verticalX + verticalW
PolygonArray(17) = y + horizontalY + horizontalH
PolygonArray(18) = x + w
PolygonArray(19) = y + horizontalY + horizontalH
PolygonArray(20) = x + w
PolygonArray(21) = y + horizontalY
PolygonArray(22) = x + verticalX + verticalW
PolygonArray(23) = y + horizontalY
; Draws the cross
Polygon_(dc, @PolygonArray(), 12)
; Deletes the brush and the pen
If outlineColor >= 0 : DeleteObject_(pen) : EndIf
If fillColor >= 0 : DeleteObject_(brush) : EndIf
EndProcedure
Procedure RegularPolygon(dc, x, y, size, numSides, outlineColor = -1, fillColor = -1, startAngle.f = 0, enableStar = 0, distanceFromEdge.f = -1)
; Draws Звезду - using the Polygon_ API function
; Let enableStar = 1 to draw stars, let distanceFromEdge < 0 to use the standard distance
; Creates the brush and the pen
If outlineColor >= 0 : pen = CreatePen_(#PS_SOLID, 1, outlineColor) : Else : pen = GetStockObject_(#NULL_PEN) : EndIf
If fillColor >= 0 : brush = CreateSolidBrush_(fillColor) : Else : brush = GetStockObject_(#NULL_BRUSH) : EndIf
SelectObject_(dc, pen)
SelectObject_(dc, brush)
; Calculates angle stuff
If numSides < 3 : numSides = 3 : EndIf
If enableStar : enableStar = 1 : EndIf
startAngle = 360 - startAngle
anglePoint.f = 360 / numSides / (enableStar + 1)
If Not enableStar : startAngle + (anglePoint / 2) : EndIf
If enableStar : startAngle - 180 : EndIf
While startAngle < 0 : startAngle + 360 : Wend
While startAngle > 360 : startAngle - 360 : Wend
; Creates the polygon array
polyCount.w = numSides * (enableStar + 1)
Dim PolygonArray.l(polyCount * 2)
midx = (size / 2) + x
midy = (size / 2) + y
If distanceFromEdge < 0 : distanceFromEdge = 0.62 : Else : distanceFromEdge * 0.01 : EndIf
For a = 1 To polyCount
; Calculates the angle measurements of the actual point
anglePos = anglePoint * a + startAngle + 180
While anglePos > 360 : anglePos - 360 : Wend
sx = midx - Sin(Radian(anglePos)) * (size / 2)
sy = midy - Cos(Radian(anglePos)) * (size / 2)
If (enableStar And a & 1)
distance = Sqr(Pow(sx - midx, 2) + Pow(sy - midy, 2))
sx + Sin(Radian(anglePos)) * distanceFromEdge * distance
sy + Cos(Radian(anglePos)) * distanceFromEdge * distance
EndIf
PolygonArray((2 * a) - 2) = sx
PolygonArray((2 * a) - 1) = sy
Next a
; Draws the regular polygon/star
Polygon_(dc, @PolygonArray(), polyCount)
; Deletes the brush and the pen
If outlineColor >= 0 : DeleteObject_(pen) : EndIf
If fillColor >= 0 : DeleteObject_(brush) : EndIf
EndProcedure
CreateImage(0, 580, 380)
dc = StartDrawing(ImageOutput(0)) ; Функции рисования необходимо дескриптор контекста устройства выходной
FillArea(0, 0, -1, GetSysColor_(#COLOR_BTNFACE))
Pie(dc, 0, 0, 120, 120, 90, 225, -1, RGB(255, 0, 0))
RoundRectangle(dc, 0, 180, 180, 90, 40, 40, -1, RGB(0, 168, 255))
Arc(dc, 280, 0, 200, 100, 225, 45, RGB(0, 0, 0))
Chord(dc, 280, 120, 100, 100, 135, 300, -1, RGB(255, 128, 0))
Triangle(dc, 150, 80, 200, 0, 250, 80, -1, RGB(0, 0, 255))
Parallelogram(dc, 150, 110, 100, 50, -20, -1, RGB(0, 200, 0))
Trapezium(dc, 25, 100, 0, 150, 280, 80, -1, RGB(0, 255, 128))
Rhombus(dc, 180, 220, 150, 100, -1, RGB(255, 255, 0))
Cross(dc, 400, 50, 150, 200, -1, 40, 60, 40, -1, RGB(200, 200, 200))
RegularPolygon(dc, 340, 200, 100, 5, -1, RGB(0, 128, 64), 0, 1, -1)
RegularPolygon(dc, 450, 270, 100, 8, -1, RGB(0, 64, 238), 30)
StopDrawing()
OpenWindow(0, 10, 10, 600, 400, "Drawing different shapes", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
ImageGadget(1, 10, 10, 580, 380, ImageID(0))
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
End
</plaintext>
</div><br><br><br>
<img src="img/lin.jpg" width="700" height="20" alt="Уроки PureBasic"><br><br>
<p><a name="99"></a></p><h2 align="center">Заставка перед стартом программы </h2>
<center><img src="img/489537.jpg" width="400" height="347" alt="Уроки PureBasic"></center><br>
<div class="con">
<plaintext id="PureBasic">
;////////////////////////////Заставка перед стартом программы//////////////////////////
UsePNGImageDecoder()
hWnd = OpenWindow(0,0,0, 500, 434, "Window Name", #WS_POPUP|#PB_Window_Invisible|#PB_Window_ScreenCentered)
hBitmap = LoadImage(0, "489537.png")
SkinWin(hWnd, hBitmap)
HideWindow(0,#False)
Delay(1000); время работы заставки
;//////////////////////////////////////////////////////////////////////////////////////
</plaintext>
</div><br><br><br>
Время показа заставки определяется параметром <b>Delay(1000)</b><br><br>
Код разместить перед основным кодом программы.<br><br>
Скачать <a href="fail/zastavka.rar">архив</a><br><br>
<img src="img/lin.jpg" width="700" height="20" alt="Уроки PureBasic"><br><br>
<p><a name="100"></a></p><h2 align="center">Определение положения курсора в пределах окна</h2>
<div class="con">
<plaintext id="PureBasic">
;-----Определение положения курсора в пределах окна--------
;
; Правый клик
;
; Двойной левый
;----------------------------------------------------------
Enumeration
#Window_0
EndEnumeration
Global hhook
Procedure MouseProc(nCode, wParam, lParam)
*ms.MOUSEHOOKSTRUCT = lParam
SetGadgetText(0, "x: "+Str(*ms\pt\x))
SetGadgetText(1, "y: "+Str(*ms\pt\y))
x.s= "x="+Str(*ms\pt\x)
y.s= "y="+Str(*ms\pt\y)
If wParam = #WM_RBUTTONUP
result = 1
MessageRequester("Message", "Нажата правая кнопка "+Chr(10)+" "+x+" "+y , 0)
Else
result = 0
EndIf
If wParam = #WM_LBUTTONDBLCLK
result = 1
MessageRequester("Message", "Двойной клик левой "+Chr(10)+" "+x+" "+y , 0)
Else
result = 0
EndIf
;If wParam = #WM_LBUTTONUP
;result = 1
;MessageRequester("Message", "Клик левой "+Chr(10)+" "+x+" "+y , 0)
;Else
;result = 0
;EndIf
ProcedureReturn result
EndProcedure
hInstance = GetModuleHandle_(0)
OpenWindow (#Window_0, 0, 0, 1000, 800, "Заглавие", #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered )
WindowID = WindowID(#Window_0)
TextGadget(0, 4, 4, 48, 24, "x: ")
TextGadget(1, 4, 32, 48, 24, "y: ")
lpdwProcessId = GetWindowThreadProcessId_(WindowID, 0)
hhook = SetWindowsHookEx_(#WH_MOUSE, @MouseProc(), hInstance, lpdwProcessId)
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_CloseWindow
Break
EndIf
ForEver
</plaintext>
</div><br><br><br>
<img src="img/lin.jpg" width="700" height="20" alt="Уроки PureBasic"
</div>
</div>
<!-- copyright (t4) --><div align="center">Используются технологии <a href="http://www.ucoz.ru/" title="Создать сайт бесплатно"><b>uCoz</b></a><br /></div><!-- /copyright -->
</body>
</html>
]]></plaintext></div></div></div> 