Изучение PureBasic с точки зрения новичка

@Power_Basic · Регистрация: 08.03.2016

Здесь буду задавать вопросы, которые, на мой взгляд, не заслуживают создания отдельной ветки. Ну просто чтобы не плодить кучу тем, не слишком полезных для подавляющего большинства.

Сейчас приступил к изучению "PureBasic - A Beginners Guide" в переводе Станислава Будинова. К сожалению, это книга эпохи версии 4.00.Там довольно подробно рассматриваются функции, содержащиеся в библиотеке OnError Library, а именно: GetErrorNumber(), GetErrorDescription(), GetErrorLineNR() и GetErrorModuleName().
Правильно ли я понимаю, что это уже полный анахронизм, и сейчас всю отладку рекомендуется производить в самом отладчике, поскольку он теперь (на современных компьютерах) стал очень быстрым, и нужда в этих функциях уже полностью отпала?

И кроме того, функция CreateGadgetList() тоже уже устарела, потому что список добавляемых на форму гаджетов создаётся теперь автоматически подобно коллекции Controls в VB?

P.S. Сначала собирался озаглавить эту ветку вот так: "Вопросы новичка, приступившего к изучению PureBasic", но движок форума по какой-то причине цензурирует слово "вопросы". Пришлось как-нибудь перефразировать, чтобы обойтись без этого слова. Получилось не так хорошо, как было задумано, но всё-таки относительно близко к первоначальному варианту.

@Tiger61 · 21.03.2024, 11:37

Уважаемые "Гуру" никто не заморачивался построением диаграммы Ганта на Пурике? Типа сделать Визуальный График отпусков....Или Пурик на это не способен ?

@locm · 21.03.2024, 12:58

Сообщение от Tiger61

Типа сделать Визуальный График

Нарисовать.

PureBasic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
If OpenWindow(0, 0, 0, 800, 200, "2DDrawing Example", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  CanvasGadget(0, 0, 0, 800, 200)
  
  If StartDrawing(CanvasOutput(0))
    
    x=8 : y=8 : w=0 : h=20
    For i=1 To 8
      w = Random(120, 50)
      Box(x, y, w, h, RGB(Random(255), Random(255), Random(255)))
      x+w
      y+h+4
    Next
    
    StopDrawing()
  EndIf
  
  Repeat
    Event = WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
EndIf

@Tiger61 · 22.03.2024, 06:39

Ваш пример знакомый.....
Пурик прекрасно работает с базами данных sqlite....Идея то вот какая...Создается база данных с номерами и фамилиями (рис)
В перечне выбираем пипла...Потом жмякаем кнопицу *График заданий* и выскакивает окошко с заданиями для выбранного пипла...Где на графике показаны задания на год для него (прямоугольнички)....выделено каким либо цветом и с указанием количества дней (рис)...при наведении мышкой на выделенный прямоугольничек всплывает окошечко с числами начала и окончания задания .

@locm · 22.03.2024, 13:09

Нарисовать такой график вполне возможно.

@Tiger61 · 23.03.2024, 11:23

Искал на многих форумах по Пурику...ничего подобного не встретил...есть наработки на других языках....(((( А моих скромных знаний не хватает для написания такого кода...Пока вот сделал "морду лица" для графика....

@ArsMagnus · 01.06.2024, 01:57

Прошу помочь разобраться с обращением к библиотеке .dll из процедуры. Компилятор х64 выдает ошибку при вызове библиотеки, а 32 разрядная версия считает верно, но зависает на выходе из процедуры. Что я делаю не так?

PureBasic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
Declare DOMA (jd.i,lat.d,lon.d,ss.s,j)
Global Dim hous.d(1, 12)
#libpath32 = "C:\Swiss\swedll32.dll"
#libpath64 = "C:\Swiss\swedll64.dll"
#libpath2 = "kernel32.dll"
#lib1    = 0
#lib2    = 1
 
Enumeration 0 Step 1
  #SE_GREG_CAL
  #SE_JUL_CAL
  #ID
EndEnumeration
 
 
Prototype.d SWE_JulDay(year,month,day,hour.d,flag)
Prototype.i SWE_Calc(tjd_ut.d,ipl,Iflag,*x,serr.s)
Prototype.i SWE_houses(tjd.d,geolat.d,geolon.d,ihsy,*cusp,*ascmc)
Prototype.i TzSpecificLocalTimeToSystemTime (*i,*j,*k)
Prototype.i swe_set_ephe_path(NULL)
 
CompilerSelect #PB_Compiler_Processor
 CompilerCase #PB_Processor_x86
  If OpenLibrary(#lib1,#libpath32 )
   JulDay.SWE_JulDay = GetFunction(#lib1,"_swe_julday@24")
   Global Calc.SWE_Calc = GetFunction(#lib1,"_swe_calc@24")
   Global houses.SWE_houses= GetFunction(#lib1,"_swe_houses@36")
  Else
   MessageRequester("Внимание!","Библиотека swedll32.dll не найдена")
   End
  EndIf
 CompilerCase #PB_Processor_x64
   If OpenLibrary(#lib1,#libpath64 )
   JulDay.SWE_JulDay = GetFunction(#lib1,"swe_julday")
   Global Calc.SWE_Calc = GetFunction(#lib1,"_swe_calc")
   Global houses.SWE_houses= GetFunction(#lib1,"_swe_houses")
   Else
    MessageRequester("Внимание","Библиотека swedll64.dll не найдена")
    End
   EndIf
CompilerEndSelect
If OpenLibrary(#lib2, #libpath2)
LOC_UTC.TzSpecificLocalTimeToSystemTime = GetFunction(#lib2,"TzSpecificLocalTimeToSystemTime")
Else
 MessageRequester("Внимание","Библиотека kernel32.dll не найдена")
 End
EndIf
 
year=Year(Date())
day=Day(Date())
month=Month(Date())
hour.d=Hour(Date())
minut.d=Minute(Date())
 
tjdt.i=JulDay(year,month,day,hour,#SE_JUL_CAL)
glat.d = 55.7423456635
glon.d = 37.6134575667
DOMA (tjdt.i, glat.d, glon.d, "P", 1)
Debug "Вертекс "
Debug vrx.d
 
 
 
Procedure DOMA (jd.i,lat.d,lon.d,ss.s,j)
  sy = Asc(ss) 
  Dim cusp.d(13)
  Dim ascmc.d(6)
  vrx.d=0
  houses (tjd_ut+hourGMT,lat.d,lon.d,sy,@cusp.d(0),@ascmc.d(0))
  Debug "Дома"
 For i = 1 To 12
   hous.d(j, i) = cusp(i)
   Debug hous.d(j, i)   
 Next i
 vrx.d = ascmc(3)
 ProcedureReturn vrx.d
 EndProcedure

@Замабувараев · 01.06.2024, 06:57

Сообщение от ArsMagnus

JulDay.SWE_JulDay = GetFunction(#lib1,"swe_julday")
Global Calc.SWE_Calc = GetFunction(#lib1,"_swe_calc")
Global houses.SWE_houses= GetFunction(#lib1,"_swe_houses")

А почему у вас первая функция начинается с подчёркиванием, а в другом случае без подчёркивания? И эти Global — то есть, то нету. Наверное что‐то одно — это ошибка.

@ArsMagnus · 01.06.2024, 10:09

Сообщение от Замабувараев

А почему у вас первая функция начинается с подчёркиванием, а в другом случае без подчёркивания?

Спасибо, это моя невнимательность (скопировал наскоро из кода для 32 разрядной версии). Должно быть так:

PureBasic
1
2
3
4
5
CompilerCase #PB_Processor_x64
   If OpenLibrary(#lib1,#libpath64 )
   JulDay.SWE_JulDay = GetFunction(#lib1,"swe_julday")
   Global Calc.SWE_Calc = GetFunction(#lib1,"swe_calc")
   Global houses.SWE_houses= GetFunction(#lib1,"swe_houses")

Global - это для передачи расчета в процедуры, JulDay рассчитывается в самой программе, поэтому без Global.
Теперь считает верно, но из процедуры всё равно не выходит

Описание вызова dll брал здесь: https://www.astro.com/swisseph/swephprg.htm обе dll в приложении.

@locm · 01.06.2024, 22:35

Сообщение от ArsMagnus

Описание вызова dll брал здесь: https://www.astro.com/swisseph/swephprg.htm

int swe_houses(

double tjd_ut, /* Julian day number, UT */

double geolat, /* geographic latitude, in degrees */

double geolon, /* geographic longitude, in degrees

* eastern longitude is positive,

* western longitude is negative,

* northern latitude is positive,

* southern latitude is negative */

int hsys, /* house method, ascii code of one of the letters documented below */

double *cusps, /* array for 13 (or 37 for hsys G) doubles, explained further below */

double *ascmc); /* array for 10 doubles, explained further below */

PureBasic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Procedure DOMA (jd.i,lat.d,lon.d,ss.s,j)
  sy = Asc(ss) 
  Dim cusp.d(13)
  Dim ascmc.d(6) ; <---- Должно быть 10!
  vrx.d=0
  houses (tjd_ut+hourGMT,lat.d,lon.d,sy,@cusp.d(0),@ascmc.d(0))
  Debug "Дома"
 For i = 1 To 12
   hous.d(j, i) = cusp(i)
   Debug hous.d(j, i)   
 Next i
 vrx.d = ascmc(3)
 ProcedureReturn vrx.d
 EndProcedure

@ArsMagnus · 22.06.2024, 21:42

С вычислениями теперь всё в порядке, но теперь застрял на обработке событий кнопок мыши в окне. Пытаюсь заставить вращаться диск с указателем при движении мышью с зажатой левой клавишей (ну или пальцем по тачскрину). Но вращение у меня получается какое-то хаотичное и дерганое. Очень прошу помочь организовать обработку движения мыши правильно...

PureBasic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
Enumeration
 #window 
 #IMAGE_GADGET
 #IMAGE_KRUG
 #param
 #harm
EndEnumeration
#grd = 57.2957795130823    ;гпадусов в радиане
#pi2 = 6.28318530717959
 
 
Global re.i, gra.d, ndel.d, q.i
Global ImageWidth, ImageHeight
Global axex, axey
Global r2, r3, r4
Global Dim radius (6)
Global Dim gt.d(1, 3) 
Global Dim kooA1(3, 3, 2)
Global Dim factor.d(2) 
Global Dim plh.d(2)
Global Dim kooP1(3, 3, 2)
 
Declare risov ()
Declare risgamb ()
Declare krugamb ()
Declare grad(gr.d)
Declare gt1(a1.d)
Declare krdeli(N, r1, r2, sm, X, Y)
Declare midp(a.d, b.d)
Declare gambPlh(deg, l.d)
Declare gamb(deg, l.d, r, q)
 
GWidth = 1190
GHeight = 900
ImageWidth =  GWidth-300                 
ImageHeight = GHeight-20
If ImageHeight < ImageWidth
  imageWidth = ImageHeight
Else 
  ImageHeight = ImageWidth
EndIf
axex = imageWidth/2 ;координата х на экране
axey = ImageHeight/2;координата y на экране
 
radius (5) = 338
radius (6) = 420
factor (0)= 23.56   ;исходные установки
factor (1)= 58.42
Factor (2)= 250.73
q=180 ; 0° сверху
gt(0,0)=  midp(factor (0), factor (1))  ;указатель
 
If OpenWindow(#window,500,50,GWidth,GHeight,"Указатель") 
 ComboBoxGadget (#param,   50,10, 50,20)
 AddGadgetItem (#param, -1, "A" )
 AddGadgetItem (#param, -1, "B" )
 AddGadgetItem (#param, -1, "C" )
 AddGadgetItem (#param, -1, "A/B" )
 AddGadgetItem (#param, -1, "A+B-C" ) 
 SetGadgetText (#param,"A/B" ) 
  
 ComboBoxGadget (#harm,   180,10, 50,20)
 AddGadgetItem (#harm, -1, "90°" )
 AddGadgetItem (#harm, -1, "360°" )
 AddGadgetItem (#harm, -1, "180°" )
 AddGadgetItem (#harm, -1, "120°" )
 AddGadgetItem (#harm, -1, "45°" ) 
 SetGadgetText (#harm,"90°" )
EndIf
 
re=90
gra = 360 / re
ndel = 360 / gra  
r2 = radius(5)
r3 = r2 + 7
r4 = radius(6)      
gt1 (gt(0, 0))
risov ()
 
Repeat
  Select WindowEvent()
    Case 0 
      Delay(1)
    Case #PB_Event_CloseWindow
      End
    Case #PB_Event_Gadget  
      Select EventGadget()
        Case #Harm
          n= GetGadgetState(#harm)
          Select n 
            Case 0
              re=90
            Case 1
              re=360
            Case 2 
              re=180
            Case 3
              re=120
            Case 4
              re=45   
          EndSelect
          gra = 360 / re
          ndel = 360 / gra  
          gt1 (gt(0, 0))
          risov ()
        Case #param
          n= GetGadgetState(#param)
          Select n 
            Case 0
              gt(0, 0)= factor (0)
            Case 1
              gt(0, 0)= factor (1)
            Case 2 
              gt(0, 0)= factor (2)
            Case 3
              gt(0, 0)= midp(factor (0), factor (1))
            Case 4
              gt(0, 0)= factor (0) +  factor (1)- factor (2)  
          EndSelect
          gt1 (gt(0, 0))
          risov ()
      EndSelect
  EndSelect 
ForEver    
    
Procedure risov ()
      CreateImage(#IMAGE_KRUG, ImageWidth, ImageHeight)
      StartDrawing(ImageOutput(#IMAGE_KRUG))
      DrawingMode(#PB_2DDrawing_Outlined)
      FillArea(0 ,0 ,RGB(255,255,223),RGB(255,255,223))
      FrontColor(RGB(0, 0, 0))
      BackColor(RGB(255,255,223))
      SetOrigin(axex, axey)
   
     risgamb ()
     krugamb ()
     
     StopDrawing()
     ImageGadget(#IMAGE_GADGET, 300, 10, ImageWidth, ImageHeight, ImageID(#IMAGE_KRUG))
EndProcedure 
 
 
 
Procedure risgamb()
  Protected rpl
  rpl = r2 + 50
    For p = 0 To 2
    plh(p) = gambPlh(re, factor(p))
    result.l=gamb(re, factor (p), r2, q)
    kooP1(p, 1, 1) = PeekW (@result)
    kooP1(p, 2, 1) = PeekW (@result+2)
    result.l=gamb (re, factor (p), rpl ,q )
    kooP1(p, 1, 0)= PeekW (@result)
    kooP1(p, 2, 0) = PeekW (@result+2)
  Next p  
  Ellipse(0, 0, r2, r2) ; Внутренний круг
  Ellipse(0, 0, r3, r3)  
  Ellipse(0, 0, r4, r4) ; Внешний круг
  For p = 0 To 2
    DrawText(kooP1(p, 1, 0) , kooP1(p, 2, 0) ,Chr(65+p))
    X3 = kooP1(p, 1, 1) + (kooP1(p, 1, 0) - kooP1(p, 1, 1)) / 2:
    Y3 = kooP1(p, 2, 1) + (kooP1(p, 2, 0) - kooP1(p, 2, 1)) / 2:
    LineXY(X3, Y3 ,kooP1(p, 1, 1), kooP1(p, 2, 1), RGB(250, 0, 0))  
  Next p
EndProcedure
 
Procedure krugamb()
  Protected X1.d,Y1.d, X2.d, Y2.d, r2, k.d, u.d, b.d
  r2 = radius(5): k = 0.5
  u = grad(gt(0, 0) * gra + q)
  b = grad(gt(0, 0) * gra + q + 1) / #grd 
  Y1 = (r2 - 20) * Cos(b) 
  X1 = (r2 - 20) * Sin(b) 
  b = grad(gt(0, 0) * gra + q - 1) / #grd
  Y2 = (r2 - 20) * Cos(b) 
  X2 = (r2 - 20) * Sin(b) 
  LineXY(kooA1(0, 0, 1), kooA1(0, 0, 2) , X1, Y1,RGB(255, 0, 0))
  LineXY(kooA1(0, 0, 1), kooA1(0, 0, 2) , X2, Y2,RGB(255, 0, 0))
  LineXY(kooA1(0, 0, 1), kooA1(0, 0, 2), kooA1(0, 2, 1), kooA1(0, 2, 2),RGB(255, 0, 0))
  krdeli (ndel, r2, r2 - 10, u, 0, 0) 
  LineXY(kooA1(0, 1, 1), kooA1(0, 1, 2) , kooA1(0, 1, 1) * k , kooA1(0, 1, 2) * k ,RGB(0, 0, 255)) 
  LineXY(kooA1(0, 3, 1), kooA1(0, 3, 2), kooA1(0, 3, 1) * k, kooA1(0, 3, 2) * k,RGB(0, 0, 255))
  b = grad(gt(0, 0) * gra + q + 120) / #grd
  Y1 = r2  * Cos(b)
  X1 = r2  * Sin(b) 
  LineXY(X1, Y1 , X1 * k, Y1 * k) 
  b = grad(gt(0, 0) * gra + q + 240) / #grd
  Y1 = r2  * Cos(b)
  X1 = r2  * Sin(b) 
  LineXY(X1, Y1 , X1 * k, Y1 * k)
EndProcedure
 
Procedure grad(gr.d) 
  Protected grad.d
  grad=360 * ((gr / 360) - Int(gr / 360))
  ProcedureReturn grad
EndProcedure
 
Procedure gt1(a1.d)  
  Protected r2.d
  Protected i
  Protected a.d
  r2 = radius(5)
  gt(0, 0) = a1
  gt(0, 1) = a1 + re / 4
  If gt(0, 1) > re 
    gt(0, 1) = gt(0, 1) - re
  EndIf  
  gt(0, 2) = a1 + re / 2
  If gt(0, 2) > re 
    gt(0, 2) = gt(0, 2) - re
  EndIf   
  gt(0, 3) = a1 + re * 0.75
  If gt(0, 3) > re
    gt(0, 3) = gt(0, 3) - re
  EndIf  
  For i = 0 To 3
    a = grad(gt(0, i) * gra + q) / #grd
    kooA1(0, i, 2) = r2 * Cos(a)
    kooA1(0, i, 1) = r2 * Sin(a)
  Next i
EndProcedure
 
 
Procedure krdeli(N, r1, r2, sm, X, Y)
  Protected i, s.d
  Protected xa.d, ya.d, X1.d,Y1.d,X2.d, Y2.d
  s = sm / #grd
  For i = 1 To N
    Ya = Cos(i / N * #pi2 + s)
    Xa = Sin(i / N * #pi2 + s)
    X1 = X + r1 * xa
    Y1 = Y + r1 * ya 
    X2 = X + r2 * xa
    Y2 = Y + r2 * ya 
    LineXY(X1, Y1 ,X2, Y2, RGB(0, 0, 0))
  Next i
EndProcedure
  
Procedure midp(a.d, b.d) 
  Protected r,re, midp.d
  r = re / 2
  If a > b 
    midp = (a - b) / 2 + b
  EndIf  
  If a - b > r 
    midp = midp + r
  EndIf  
  midp = (b - a) / 2 + a
  If b - a > r 
    midp = midp + r
  EndIf
  If midp > re 
    midp = midp - re
  EndIf  
  ProcedureReturn midp
EndProcedure
  
Procedure gamb(deg, l.d, r, q) 
  ;     определение координат точки на экране - xg, yg
  Protected gr
  Protected b.d, lgm.d
  Protected X1.d
  Protected Y1.d, res.l
  Protected xg.w, yg.w
  lgm = deg * (l / deg - Int(l / deg))
  If r > 0 
    gr = 360 / deg:
    b = (lgm * gr + q) / #grd
    Y1 = Cos(b)
    X1 = Sin(b)   
    xg = r * X1 
    yg = r * Y1  
  EndIf  
  PokeW (@res,xg)
  PokeW (@res+2,yg)
  ProcedureReturn res
EndProcedure
 
Procedure gambPlh(deg, l.d)
  ;     преобразование долготы (l) в долготу на deg-градусном круге - lgm
  Protected lgm.d
  lgm = deg * (l / deg - Int(l / deg))
  ProcedureReturn lgm.d 
EndProcedure

@locm · 23.06.2024, 12:06

Не заметил где в коде обрабатываются события кнопок мышки.

@ArsMagnus · 23.06.2024, 15:21

Сообщение от locm

Не заметил где в коде обрабатываются события кнопок мышки.

Я убрал полностью эту часть, потому что то, что я пробывал, как следует не работало

В цикле обработки событий ставил

PureBasic
1
2
3
4
       Case #IMAGE_GADGET
          If EventType = # PB_EventType_LeftClick
               povorot()           
          EndIf

а в процедуре povorot() пытался получить координаты указателя мыши в гафическом окне:
mx = WindowMouseX(#IMAGE_GADGET)
my = WindowMouseY(#IMAGE_GADGET)
но в итоге получил ошибку "Указанный #Window не инициализирован. Тогда пошел длинным путем, - получил координаты мыши не в графическом, а в главном окне программы (#window) , затем преобразовал их в координаты графического окна. В итоге уазатель поворачивался, но фиксировался в одном положении, а чтобы переместить его надо было вновь кликать мышью уже в дугой точке. А нужен был плавный поворот вслед за движением указателя. В итоге счел этот путь ошибочным и потер всё, что с ним связано, а как сделать правильно - не знаю...

@locm · 23.06.2024, 15:56

Сообщение от ArsMagnus

а в процедуре povorot() пытался получить координаты указателя мыши в гафическом окне:
mx = WindowMouseX(#IMAGE_GADGET)
my = WindowMouseY(#IMAGE_GADGET)

В имени функций присутствует слово Window, а вы пытаетесь вместо идентификатора окна передать идентификатор гаджета. Конечно же работать не будет.

Сообщение от ArsMagnus

В итоге уазатель поворачивался, но фиксировался в одном положении

Правильно. Чтобы следовал за мышью нужно событие MouseMove - "перемещение мыши".

Сообщение от ArsMagnus

как сделать правильно - не знаю

Нужно вместо ImageGadget использовать CanvasGadget.
У него есть все нужные события под эту задачу.

#PB_EventType_MouseEnter : В Гаджет введен курсор мыши
#PB_EventType_MouseLeave : Курсор мыши покинул Гаджет
#PB_EventType_MouseMove : Перемещение курсора мыши
#PB_EventType_MouseWheel : Колесо мыши было прокручено
#PB_EventType_LeftButtonDown : Левая кнопка мыши была нажата
#PB_EventType_LeftButtonUp : Левая кнопка мыши была отпущена
#PB_EventType_LeftClick : Щелчок левой кнопкой мыши
#PB_EventType_LeftDoubleClick : Двойной щелчок левой кнопкой мыши
#PB_EventType_RightButtonDown : Правая кнопка мыши была нажата
#PB_EventType_RightButtonUp : Правая кнопка мыши была отпущена
#PB_EventType_RightClick : Щелчок правой кнопкой мыши
#PB_EventType_RightDoubleClick: Двойной щелчок правой кнопкой мыши
#PB_EventType_MiddleButtonDown: Средняя кнопка мыши была нажата
#PB_EventType_MiddleButtonUp : Средняя кнопка мыши была отпущена
#PB_EventType_Focus : Гаджет получил фокус клавиатуры
#PB_EventType_LostFocus : Гаджет потерял фокус клавиатуры
#PB_EventType_KeyDown : Нажата клавиша
#PB_EventType_KeyUp : Отпущена клавиша
#PB_EventType_Input : Был введён текст
#PB_EventType_Resize : Размер Гаджета был изменен

Кроме того

Дополнительная информация о текущем событии может быть получена с помощью функции GetGadgetAttribute(). Эта информация доступна, только если текущее событие, полученное через WaitWindowEvent() или WindowEvent(), является событием ЭТОГО Гаджета. Могут использоваться следующие атрибуты:

#PB_Canvas_MouseX, #PB_Canvas_MouseY
Возвращает заданную координату мыши относительно области рисования Гаджета. Это возвращает местоположение мыши во время создания события, поэтому результат может отличаться от координат, предоставленных функциями WindowMouseX() и WindowMouseY(), которые возвращают текущее местоположение мыши независимо от состояния обработанных событий. Чтобы гарантировать, что координаты мыши синхронизированы с текущим событием для этого Гаджета, следует использовать координаты, возвращенные с помощью этих атрибутов.

#PB_Canvas_Buttons
Возвращает состояние кнопок мыши для события. Результатом является комбинация (с использованием операции '|') следующих значений:
#PB_Canvas_LeftButton : Левая кнопка в данный момент нажата.
#PB_Canvas_RightButton : Правая кнопка в данный момент нажата.
#PB_Canvas_MiddleButton: Средняя кнопка в данный момент нажата.

@ArsMagnus · 10.07.2024, 23:00

Спасибо, с CanvasGadget и координатами получилось, а вот в этом модуле - не совсем. По плану он должен отрисовывать карту, а при активизации пересечением линий указать координаты. Если при этом нажата левая клавиша мыши, пересечение линий должно следовать за курсором (но этого почему-то не происходит).
И еще вопрос, если рисовать в CanvasGadget c загруженной в него картой, то линии будут закрашивать фон. Как этого лучше избежать - каждый раз перерисовывая фон с новыми линиями или создать поверх CanvasGadget новый ImageGadget с альфа-каналом и рисовать линии в нем?

PureBasic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Enumeration
  #window
  #CanvasReloc
  #RelocChek
  #RelocFrame
  #TownList
  #Image0
EndEnumeration
 
Global lg.d, fg.d
Define lgg,fgg, hImage
Define xl,yf ,cX, cY; координаты курсора в карте мира
Declare Reloc ()
 
#FLAGS = #PB_Window_SystemMenu | #PB_Window_ScreenCentered
LoadImage(#Image0, "C:\ProgramData\PureBasic\Examples\world5.bmp")
hImage = ImageID(#Image0)
 
If OpenWindow(#window, 0, 0, 310, 140, "Test",#FLAGS) 
  FrameGadget(#RelocFrame,  10 , 10,  290, 120, "Pелокация")
  CreateImage(#CanvasReloc, 180, 90)
  CanvasGadget(#CanvasReloc, 20, 29, 180, 90,0)
  CheckBoxGadget(#RelocChek, 274, 20, 20, 20, "")
  ButtonGadget (#TownList, 210, 100, 70,20, "Города")
  DisableGadget(#TownList, #True)
  SetGadgetAttribute(#CanvasReloc, #PB_Canvas_Image, hImage)
  lg= 24.7 ; исходные координаты
  fg= 56.5
  
  Repeat
    Event = WaitWindowEvent() 
    Select EventGadget()
      Case #RelocChek
        If GetGadgetState(#RelocChek) = #PB_Checkbox_Checked
          DisableGadget(#TownList, #False)
          GetGadgetAttribute(#CanvasReloc, #PB_Canvas_Cursor)
          SetGadgetAttribute(#CanvasReloc, #PB_Canvas_Cursor, #PB_Cursor_Cross)
          StartDrawing(CanvasOutput(#CanvasReloc))
          DrawingMode(#PB_2DDrawing_Default )    
          SetOrigin(90, 45)          
          xl = lg/2 ; отписовка исходных координат
          yf = fg/2
          LineXY (xl,-45, xl,45, RGB(250, 0, 0))
          LineXY (-90,-yf,90,-yf, RGB(250, 0, 0))
          StopDrawing ()
          Select EventType
            Case #PB_EventType_MouseEnter, #PB_EventType_LeftButtonDown, #PB_EventType_MouseMove, #PB_EventType_LeftClick
              Reloc ()    
          EndSelect
        Else
          DisableGadget(#TownList, #True)
          SetGadgetAttribute(#CanvasReloc, #PB_Canvas_Cursor, #PB_Cursor_Default)
        EndIf 
    EndSelect    
  Until Event = #PB_Event_CloseWindow Or Quit = #True
EndIf  
 
Procedure Reloc()
  Protected xl,yf, cX,cY,lgg,fgg, EventType
  StartDrawing(CanvasOutput(#CanvasReloc))
  DrawingMode(#PB_2DDrawing_Default )    
  SetOrigin(90, 45)
  cX = GetGadgetAttribute(#CanvasReloc, #PB_Canvas_MouseX)
  cY = GetGadgetAttribute(#CanvasReloc, #PB_Canvas_MouseY)
  xl = cX- 90 ; новые координаты для дальнейшей обработки
  yf = cY- 45
  If EventType = #PB_EventType_LeftButtonDown
    LineXY (xl,-45, xl,45, RGB(250, 0, 0)) ; отрисовка новых координат под курсором
    LineXY (-90,-yf,90,-yf, RGB(250, 0, 0))
    StopDrawing () 
  EndIf
  If EventType = #PB_EventType_LeftButtonUp
    ProcedureReturn
  EndIf
EndProcedure

@locm · 11.07.2024, 00:01

Код написан не внимательно и в нем много ошибок.
Например обрабатывается событие #RelocChek вместо #CanvasReloc.
Переменная EventType в процедуре Reloc() будет всегда равна нулю.
Вместо If EventType = #PB_EventType_LeftButtonDown должно быть If GetGadgetAttribute(#CanvasReloc, #PB_Canvas_Buttons) & #PB_Canvas_LeftButton
StopDrawing() в процедуре Reloc() нужно переместить вниз за EndIf и много чего еще.

@ArsMagnus · 11.07.2024, 04:09

Спасибо за подсказки, я ведь только учусь

Отработку событий поправил, а как лучше поступить с отрисовкой линий при нажатой клавише мыши? Делать новый ImageGadget или перерисовывать фон?

PureBasic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Enumeration
  #window
  #CanvasReloc
  #RelocChek
  #RelocFrame
  #TownList
  #Image0
EndEnumeration
 
Global lg.d, fg.d
Define lgg,fgg, hImage
Define xl,yf ,cX, cY; координаты курсора в карте мира
Declare Reloc ()
 
#FLAGS = #PB_Window_SystemMenu | #PB_Window_ScreenCentered
LoadImage(#Image0, "C:\ProgramData\PureBasic\Examples\world5.bmp")
hImage = ImageID(#Image0)
 
If OpenWindow(#window, 0, 0, 310, 140, "Test",#FLAGS) 
  FrameGadget(#RelocFrame,  10 , 10,  290, 120, "Pелокация")
  CreateImage(#CanvasReloc, 180, 90)
  CanvasGadget(#CanvasReloc, 20, 29, 180, 90,0)
  CheckBoxGadget(#RelocChek, 274, 20, 20, 20, "")
  ButtonGadget (#TownList, 210, 100, 70,20, "Города")
  DisableGadget(#TownList, #True)
  SetGadgetAttribute(#CanvasReloc, #PB_Canvas_Image, hImage)
  lg= 24.7 ; исходные координаты
  fg= 56.5
  
  Repeat
    Event = WaitWindowEvent() 
    Select EventGadget()
      Case #RelocChek
        If GetGadgetState(#RelocChek) = #PB_Checkbox_Checked
          DisableGadget(#TownList, #False)
          GetGadgetAttribute(#CanvasReloc, #PB_Canvas_Cursor)
          SetGadgetAttribute(#CanvasReloc, #PB_Canvas_Cursor, #PB_Cursor_Cross)
          StartDrawing(CanvasOutput(#CanvasReloc))
          DrawingMode(#PB_2DDrawing_Default )    
          SetOrigin(90, 45)          
          xl = lg/2 ; отписовка исходных координат
          yf = fg/2
          LineXY (xl,-45, xl,45, RGB(250, 0, 0))
          LineXY (-90,-yf,90,-yf, RGB(250, 0, 0))
          StopDrawing ()
        Else
          DisableGadget(#TownList, #True)
          SetGadgetAttribute(#CanvasReloc, #PB_Canvas_Cursor, #PB_Cursor_Default)
        EndIf 
      Case #CanvasReloc
        Select eventType
        Case #PB_EventType_LeftButtonDown,  #PB_EventType_LeftClick
          Reloc () 
        EndSelect 
    EndSelect    
  Until Event = #PB_Event_CloseWindow Or Quit = #True
EndIf  
 
Procedure Reloc()
  Protected xl,yf, cX,cY,lgg,fgg, EventType
  StartDrawing(CanvasOutput(#CanvasReloc))
  DrawingMode(#PB_2DDrawing_Default )    
  SetOrigin(90, 45)
  cX = GetGadgetAttribute(#CanvasReloc, #PB_Canvas_MouseX)
  cY = GetGadgetAttribute(#CanvasReloc, #PB_Canvas_MouseY)
  xl = cX- 90 ; новые координаты для дальнейшей обработки
  yf = cY- 45
  If GetGadgetAttribute(#CanvasReloc, #PB_Canvas_Buttons) & #PB_Canvas_LeftButton
    LineXY (xl,-45, xl,45, RGB(250, 0, 0)) ; отрисовка новых координат под курсором
    LineXY (-90,yf,90,yf, RGB(250, 0, 0)) 
 EndIf
  StopDrawing () 
EndProcedure

Добавлено через 1 час 12 минут
Вернее так:

PureBasic
1
2
3
4
5
6
7
      Case #CanvasReloc
        If GetGadgetState(#RelocChek) = #PB_Checkbox_Checked
          Select eventType
            Case #PB_EventType_LeftButtonDown,  #PB_EventType_LeftClick
              Reloc () 
          EndSelect 
        EndIf

@locm · 11.07.2024, 10:20

Сообщение от ArsMagnus

Вернее так:

Вернее так

PureBasic
1
2
3
4
5
6
7
      Case #CanvasReloc
        If GetGadgetState(#RelocChek) = #PB_Checkbox_Checked
          Select EventType()
            Case #PB_EventType_LeftButtonDown,  #PB_EventType_LeftClick
              Reloc () 
          EndSelect 
        EndIf

потому что переменной eventType нигде не присваивается значение.

Сообщение от ArsMagnus

перерисовывать фон

Проще так. Перерисовать все.

@Tiger61 · 05.12.2024, 08:15

Подскажите пожалуйста процедуру проверки наличия Интернета...
Пытался проверять вот таким способом....но не работает....т.е. есть интернет или отключен все равно показывает наличие..
всегда выдает единичку.....
Такой код нацарапал....

PureBasic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
 If OpenWindow(0, 0, 0, 400, 150, "Пример проверки ТЫРНЕТА", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
   ButtonGadget  (1, 100, 100, 200, 30, "Закрыть")
 
 InitNetwork()
   
 ;Проверка интернета   Выдержка из справки......
 ;Возвращает не нулевое значение, если инициализация прошла успешно. 
 ;Если был возвращён 0, то библиотеку "Network" использовать нельзя. 
 
  
  Result = InitNetwork() 
  If  Result = 1
 
  
  TextGadget(2, 80,  40, 250, 30, " ТЫРНЕТ ЕСТЬ !!!  ")
   SetGadgetFont(2,LoadFont(2, "Arial",20, #PB_Font_Bold|#PB_Font_HighQuality))
  SetGadgetColor(2, #PB_Gadget_BackColor , $ABDE39)
  EndIf
  
  Debug Result
  
  
    If  Result = 0
      MessageRequester("Информация !","                    Данные недоступны !!!"+ #CRLF$+ "Проверьте наличие интернет соединения.")   
    End
  EndIf
  
  ; Все время возвращает 1 ...Почему ???????????????????
  
   Repeat
     Event = WaitWindowEvent()
     Select Event
       Case #PB_Event_Gadget
         Select EventGadget()
           Case 1 
              CloseWindow(0)
              End  
         EndSelect
      EndSelect
   Until Event = #PB_Event_CloseWindow
   
 EndIf

@useful · 05.12.2024, 10:18

Во первых InitNetwork() функция устаревшая и отсутствует в современных версиях.
Во вторых она имела отношение только к локальной сетевой инфраструктуре.

Для озвученной цели смотреть https://www.purebasic.com/docu... index.html

@locm · 05.12.2024, 13:12

Функция InitNetwork() инициализирует сетевую библиотеку, а не проверяет наличие интернета.
Проверить можно например так

PureBasic
1
2
3
4
5
6
7
8
9
10
Connect = OpenNetworkConnection("ya.ru", 80, #PB_Network_TCP)
If Connect
  CloseNetworkConnection(Connect)
EndIf
 
If Connect
  Debug "Инет есть"
Else
  Debug "Инета нет"
EndIf

Новые блоги и статьи Все статьи Все блоги /
Свет внутри себя kumehtar 07.06.2026 Пусть это будет здесь lIs4oanZS9Y	Программа для com-порта Uhbif79 05.06.2026 Всем привет, давно хотел изучить Qt, начинал, бросал, потом снова начинал. И сейчас вот смог написать свою первую программу. До этого имел опыт программирования микроконтроллеров, писал прошивки на. . .	Транскрипция 55-минутного видео через Whisper: WhisperDesktop облажался, спас Google Colab[ anaschu 01.06.2026 Понадобилось получить текст из свежезагруженного видео на YouTube. Казалось бы, задача на пять минут. Заняла полтора часа. Делюсь опытом — может кому пригодится последовательность решений. . . .	21 мат мед. Планы на развитие модели здравоСохранения anaschu 01.06.2026 AnyLogic: план развития симуляционной модели рабочего коллектива — динамический абсентеизм, реальные данные, три сценария сравнения Продолжаю серию постов о дискретно-событийной модели рабочего. . .
20. Мат мед. Абсентеизм как отдельный тип простоя anaschu 29.05.2026 Апдейт модели: исправленные баги, абсентеизм и новые механизмы Продолжаю развивать ранее описанную модель рабочего коллектива на AnyLogic. За последние несколько дней был проведён серьёзный. . .	19. здоровье, усталость и психотип работника влияют на производительность предприятия, и наоборот, производительность на здоровье, усталось и психотип anaschu 28.05.2026 Дискретно-событийная модель рабочего коллектива на AnyLogic: здоровье, выгорание, психотипы и микростимуляция Привет, коллеги. Хочу поделиться итогами нескольких недель работы над симуляционной. . .	"Прокси" для последовательного порта Eddy_Em 28.05.2026 Эту штуку написал я достаточно давно. Но сейчас вот понадобилось настроить датчик грозы, но при этом не отключать его от "метеодемона". Соответственно, надо запустить этот "прокси": метеодемон будет. . .	Рефакторинг программы уравнивания. Massaraksh7 26.05.2026 Пример по предыдущей записи в блоге. Но, надо заметить, что, во-первых, там оптимизация не только математики, но и работы с базой данных, и с графами, а во-вторых, это ещё не всё.

@Power_Basic 46 / 25 / 0 Регистрация: 08.03.2016 Сообщений: 443

	Изучение PureBasic с точки зрения новичка 23.02.2023, 19:22. Показов 15407. Ответов 124 Метки нет (Все метки) Здесь буду задавать вопросы, которые, на мой взгляд, не заслуживают создания отдельной ветки. Ну просто чтобы не плодить кучу тем, не слишком полезных для подавляющего большинства. Сейчас приступил к изучению "PureBasic - A Beginners Guide" в переводе Станислава Будинова. К сожалению, это книга эпохи версии 4.00.Там довольно подробно рассматриваются функции, содержащиеся в библиотеке OnError Library, а именно: GetErrorNumber(), GetErrorDescription(), GetErrorLineNR() и GetErrorModuleName(). Правильно ли я понимаю, что это уже полный анахронизм, и сейчас всю отладку рекомендуется производить в самом отладчике, поскольку он теперь (на современных компьютерах) стал очень быстрым, и нужда в этих функциях уже полностью отпала? И кроме того, функция CreateGadgetList() тоже уже устарела, потому что список добавляемых на форму гаджетов создаётся теперь автоматически подобно коллекции Controls в VB? P.S. Сначала собирался озаглавить эту ветку вот так: "Вопросы новичка, приступившего к изучению PureBasic", но движок форума по какой-то причине цензурирует слово "вопросы". Пришлось как-нибудь перефразировать, чтобы обойтись без этого слова. Получилось не так хорошо, как было задумано, но всё-таки относительно близко к первоначальному варианту. 0

@Tiger61 0 / 0 / 0 Регистрация: 11.12.2014 Сообщений: 30
	21.03.2024, 11:37
	Уважаемые "Гуру" никто не заморачивался построением диаграммы Ганта на Пурике? Типа сделать Визуальный График отпусков....Или Пурик на это не способен ? 0

@Tiger61 0 / 0 / 0 Регистрация: 11.12.2014 Сообщений: 30
	22.03.2024, 06:39
	Ваш пример знакомый..... Пурик прекрасно работает с базами данных sqlite....Идея то вот какая...Создается база данных с номерами и фамилиями (рис) В перечне выбираем пипла...Потом жмякаем кнопицу График заданий и выскакивает окошко с заданиями для выбранного пипла...Где на графике показаны задания на год для него (прямоугольнички)....выделено каким либо цветом и с указанием количества дней (рис)...при наведении мышкой на выделенный прямоугольничек всплывает окошечко с числами начала и окончания задания . Миниатюры 0

@locm 6993 / 3309 / 341 Регистрация: 28.10.2011 Сообщений: 12,989 Записей в блоге: 7
	22.03.2024, 13:09
	Нарисовать такой график вполне возможно. 0

@Tiger61 0 / 0 / 0 Регистрация: 11.12.2014 Сообщений: 30
	23.03.2024, 11:23
	Искал на многих форумах по Пурику...ничего подобного не встретил...есть наработки на других языках....(((( А моих скромных знаний не хватает для написания такого кода...Пока вот сделал "морду лица" для графика.... Миниатюры 0

@locm 6993 / 3309 / 341 Регистрация: 28.10.2011 Сообщений: 12,989 Записей в блоге: 7
	23.06.2024, 12:06
	Не заметил где в коде обрабатываются события кнопок мышки. 0

@locm 6993 / 3309 / 341 Регистрация: 28.10.2011 Сообщений: 12,989 Записей в блоге: 7
	11.07.2024, 00:01
	Код написан не внимательно и в нем много ошибок. Например обрабатывается событие #RelocChek вместо #CanvasReloc. Переменная EventType в процедуре Reloc() будет всегда равна нулю. Вместо `If EventType = #PB_EventType_LeftButtonDown` должно быть `If GetGadgetAttribute(#CanvasReloc, #PB_Canvas_Buttons) & #PB_Canvas_LeftButton` StopDrawing() в процедуре Reloc() нужно переместить вниз за EndIf и много чего еще. 0

@useful 12 / 12 / 0 Регистрация: 02.07.2014 Сообщений: 115
	05.12.2024, 10:18
	Во первых InitNetwork() функция устаревшая и отсутствует в современных версиях. Во вторых она имела отношение только к локальной сетевой инфраструктуре. Для озвученной цели смотреть https://www.purebasic.com/docu... index.html 0