PureBasic - форум

Информация о пользователе

Привет, Гость! Войдите или зарегистрируйтесь.


Вы здесь » PureBasic - форум » PureBasic для Windows » мышь и CanvasGadget


мышь и CanvasGadget

Сообщений 1 страница 6 из 6

1

Вот что получается, столкнулся уже не первый раз: если я пытаюсь перетаскивать круг мышкой, то курсор "убегает" из радиуса(желтый в коде). Интересно, это баг или фича такая? и есть ли решение?

Код:
Enumeration
  #ca
  #bl
  #br
EndEnumeration

Structure gradp
  num.a
  rgb.l
EndStructure

Global grc=GetSysColor_(#COLOR_BTNFACE)

Global gri=2 ; gradient index
Global Dim gr.gradp(255)
With gr(0)
  \num=0
  \rgb=$FF0000
EndWith

With gr(1)
  \num=255
  \rgb=$FFFF00
EndWith

With gr(2)
  \num=127
  \rgb=$00FFFF
EndWith

CreateImage(0,20,20)
CreateImage(1,20,20)
CreateImage(2,256,128)

; Procedure drgrad()
;   StartDrawing(ImageOutput(2))
;   ;x=0
;   r1=Red(gr(0)\rgb)
;   g1=Green(gr(0)\rgb)
;   b1=Blue(gr(0)\rgb)
;   
;   r2=Red(gr(1)\rgb)
;   g2=Green(gr(1)\rgb)
;   b2=Blue(gr(1)\rgb)
;   
;   For i=gr(0)\num To gr(1)\num
;     r=r1+(i*(r2-r1)/256)
;     g=g1+(i*(g2-g1)/256)
;     b=b1+(i*(b2-b1)/256)
;     LineXY(i,0,i,128,RGB(r,g,b))
;   Next i
;   
;   StopDrawing()
;   StartDrawing(CanvasOutput(#ca))
;   DrawImage(ImageID(2),0,0)
;   Box(0,0,256,20,grc)
;   
;   ;pointers
;   For i=0 To gri
;     LineXY(gr(i)\num,0,gr(i)\num,128,0-gr(i)\rgb)
;   Next i
;   
;   StopDrawing()
; EndProcedure

Procedure drgrad2()
  StartDrawing(ImageOutput(2))
  
  x=0
  For j=0 To gri-1
    r1=Red(gr(j)\rgb)
    g1=Green(gr(j)\rgb)
    b1=Blue(gr(j)\rgb)
    
    r2=Red(gr(j+1)\rgb)
    g2=Green(gr(j+1)\rgb)
    b2=Blue(gr(j+1)\rgb)
    
    ;
    k=0
    nn=gr(j+1)\num-gr(j)\num
    For i=gr(j)\num To gr(j+1)\num
      r=r1+(k*(r2-r1)/nn)
      g=g1+(k*(g2-g1)/nn)
      b=b1+(k*(b2-b1)/nn)
      LineXY(x,0,x,128,RGB(r,g,b))
      k+1
      x+1
    Next i
  Next j
  
  StopDrawing()
  StartDrawing(CanvasOutput(#ca))
  DrawImage(ImageID(2),0,0)
  Box(0,0,256,20,grc)
  
  ;pointers
  For i=0 To gri
    xx=gr(i)\num
    yy=19
    DrawingMode(#PB_2DDrawing_Default)
    Circle(xx,yy,5,gr(i)\rgb)
    DrawingMode(#PB_2DDrawing_Outlined)
    Circle(xx,yy,5,0)
  Next i
  
  StopDrawing()
  
EndProcedure


Procedure sortg()
  t.gradp
  For i=0 To gri-1
    For j=i+1 To gri
      If gr(i)\num>gr(j)\num
        t=gr(i)
        gr(i)=gr(j)
        gr(j)=t
      EndIf
    Next j
  Next i
EndProcedure

Procedure dispg()
  For i=0 To gri
    Debug Str(i)+":"+Str(gr(i)\num)+"/#"+Str(gr(i)\rgb)
  Next i
EndProcedure

Procedure chco(coln)
  Color = ColorRequester()
  If Color > -1
    gr(coln)\rgb=Color
  EndIf
EndProcedure

Procedure btnimg()
  StartDrawing(ImageOutput(0))
  Box(0,0,200,200,gr(0)\rgb);$FF0000)
  StopDrawing()
  StartDrawing(ImageOutput(1))
  Box(0,0,200,200,gr(gri)\rgb);$FFff00)
  StopDrawing()
  SetGadgetAttribute(#bl,#PB_Button_Image,ImageID(0))
  SetGadgetAttribute(#br,#PB_Button_Image,ImageID(1))
  
  
EndProcedure

Procedure ClickHandler()
  
  x = GetGadgetAttribute(#ca, #PB_Canvas_MouseX)
  y = GetGadgetAttribute(#ca, #PB_Canvas_MouseY)
  SetWindowTitle(0, Str(x)+":"+Str(y) )
  If GetGadgetAttribute(#ca, #PB_Canvas_Buttons) & #PB_Canvas_LeftButton
    If y<=20 And y>14
      ;find point
      For i=1 To gri-1
        If Sqr((x-gr(i)\num)*(x-gr(i)\num)+(y-19)*(y-19))<=5
          If EventType() = #PB_EventType_MouseMove And GetGadgetAttribute(#ca, #PB_Canvas_Buttons) & #PB_Canvas_LeftButton
            gr(i)\num=x
            drgrad2()
            Break
          EndIf
        EndIf
      Next i
    EndIf 
    ;   StartDrawing(CanvasOutput(#ca))
    ;   Box(0,0,256,20,grc)
    ;   
    ;   For i=0 To gri
    ;     xx=gr(i)\num
    ;     yy=19
    ;     Circle(xx,yy,5,gr(i)\rgb)
    ;     DrawingMode(#PB_2DDrawing_Outlined)
    ;     Circle(xx,yy,5,0)
    ;   Next i
    ;    StopDrawing()
  EndIf
  
  
EndProcedure


If OpenWindow(0, 0, 0, 256, 256, "Gradient generator", #PB_Window_SystemMenu | #PB_Window_ScreenCentered|#PB_Window_MinimizeGadget)
  CanvasGadget(#ca, 0, 0, 256, 128)
  ButtonImageGadget(#bl, 0, 129, 20, 20, ImageID(0))
  ButtonImageGadget(#br, 236, 129, 20, 20, ImageID(1))
  
  
  sortg()
  drgrad2()
  btnimg()
  
  BindGadgetEvent(#ca, @ClickHandler(), #PB_EventType_MouseMove)
  
  Repeat
    Event = WaitWindowEvent()
    If GetAsyncKeyState_(#VK_ESCAPE)&32768
      Break
    EndIf
    
    If Event = #PB_Event_Gadget
      Select EventGadget()
          ;         Case #ca
          ;           x = GetGadgetAttribute(#ca, #PB_Canvas_MouseX)
          ;           y = GetGadgetAttribute(#ca, #PB_Canvas_MouseY)
          ;           SetWindowTitle(0, Str(x)+":"+Str(y) )
          ;           
          ;           If y<=20 And y>14
          ;             ;find point
          ;             For i=1 To gri-1
          ;               If gr(i)\num>x-5 And gr(i)\num<x+5
          ;               ;If Sqr()
          ;                 If EventType() = #PB_EventType_MouseMove And GetGadgetAttribute(#ca, #PB_Canvas_Buttons) & #PB_Canvas_LeftButton
          ;                   gr(i)\num=x
          ;                   drgrad2()
          ;                   Break
          ;                 ElseIf EventType()=#PB_EventType_LeftDoubleClick;dbl click
          ;                   chco(i)
          ;                   drgrad2()
          ;                   Break
          ;                 EndIf
          ;               EndIf
          ;             ;EndIf
          ;           Next i
          ;         EndIf         
        Case #bl
          chco(0)
          drgrad2()
          btnimg()
        Case #br
          chco(gri)
          drgrad2()
          btnimg()
      EndSelect
    EndIf
    
    
  Until Event = #PB_Event_CloseWindow
EndIf
FreeImage(0)
FreeImage(1)
FreeImage(2)

0

2

egons
Не разбирался в коде, попробовал пример и видно что когда мышь выпадает из круга, то теряет привязку, при этом надо понимать что движение мыши вниз или вверх стабильно приведёт к выпаданию из круга, а также небольшой зависон в обработке событий. Из этого вывод, надо мышь привязывать не к кругу а событию нажатия мыши в круге, далее отвязка происходит только при отпуске кнопки мыши, а пока есть привязка вычисляется горизонтальная позиция, если она за гранью горизонтального диапазона, то кружок передвигается в тот край, за который зашла мышь, а если мышь внутри горизонтального диапазона, то выставляем круг в этой позиции. Вертикальная позиция (y-координата) в этом случае вообще не используется для вычислений.
Кстати в правый край в конец приводит к ошибке в 83-й строке. Деление на 0

Код:
    If nn = 0
    	nn + 1
    EndIf

Отредактировано AZJIO (08.02.2022 20:15:48)

0

3

Спасибо, такое решение помогло

Код:
Enumeration
  #ca
  #bl
  #br
EndEnumeration

Structure gradp
  num.a
  rgb.l
EndStructure

Global grc=GetSysColor_(#COLOR_BTNFACE)

Global ci.l=-1;current drag index

Global gri=2 ; gradient index
Global Dim gr.gradp(255)
With gr(0)
  \num=0
  \rgb=$FF0000
EndWith

With gr(1)
  \num=255
  \rgb=$FFFF00
EndWith

With gr(2)
  \num=127
  \rgb=$00FFFF
EndWith

CreateImage(2,256,128)

Procedure drgrad2()
  StartDrawing(ImageOutput(2))
  
  x=0
  For j=0 To gri-1
    r1=Red(gr(j)\rgb)
    g1=Green(gr(j)\rgb)
    b1=Blue(gr(j)\rgb)
    
    r2=Red(gr(j+1)\rgb)
    g2=Green(gr(j+1)\rgb)
    b2=Blue(gr(j+1)\rgb)
    
    ;
    k=0
    nn=gr(j+1)\num-gr(j)\num
    For i=gr(j)\num To gr(j+1)\num
      r=r1+(k*(r2-r1)/nn)
      g=g1+(k*(g2-g1)/nn)
      b=b1+(k*(b2-b1)/nn)
      LineXY(x,0,x,128,RGB(r,g,b))
      k+1
      x+1
    Next i
  Next j
  
  StopDrawing()
  StartDrawing(CanvasOutput(#ca))
  DrawImage(ImageID(2),0,0)
  Box(0,0,256,20,grc)
  
  ;pointers
  For i=0 To gri
    xx=gr(i)\num
    yy=19
    DrawingMode(#PB_2DDrawing_Default)
    Circle(xx,yy,5,gr(i)\rgb)
    DrawingMode(#PB_2DDrawing_Outlined)
    Circle(xx,yy,5,0)
  Next i
  
  StopDrawing()
  
EndProcedure


Procedure sortg()
  t.gradp
  For i=0 To gri-1
    For j=i+1 To gri
      If gr(i)\num>gr(j)\num
        t=gr(i)
        gr(i)=gr(j)
        gr(j)=t
      EndIf
    Next j
  Next i
EndProcedure

Procedure dispg()
  For i=0 To gri
    Debug Str(i)+":"+Str(gr(i)\num)+"/#"+Str(gr(i)\rgb)
  Next i
EndProcedure

Procedure chco(coln)
  Color = ColorRequester()
  If Color > -1
    gr(coln)\rgb=Color
  EndIf
EndProcedure


If OpenWindow(0, 0, 0, 256, 256, "Gradient generator", #PB_Window_SystemMenu | #PB_Window_ScreenCentered|#PB_Window_MinimizeGadget)
  CanvasGadget(#ca, 0, 0, 256, 128)
  
  sortg()
  drgrad2()
  
  Repeat
    Event = WaitWindowEvent()
    If GetAsyncKeyState_(#VK_ESCAPE)&32768
      Break
    EndIf
    
    If Event = #PB_Event_Gadget
      Select EventGadget()
        Case #ca
          mx = GetGadgetAttribute(#ca, #PB_Canvas_MouseX)
          my = GetGadgetAttribute(#ca, #PB_Canvas_MouseY)
          Select EventType()
            Case #PB_EventType_MouseMove
              If ci<>-1 And GetGadgetAttribute(#ca, #PB_Canvas_Buttons) & #PB_Canvas_LeftButton
                gr(ci)\num=mx
                drgrad2()
              EndIf
            Case #PB_EventType_LeftButtonDown
              ci=-1
              For i=1 To gri-1
                If Sqr((mx-gr(i)\num)*(mx-gr(i)\num)+(my-19)*(my-19))<=5
                  ;gr(i)\num=x
                  ci=i
                  Break
                EndIf
              Next i
            Case #PB_EventType_LeftButtonUp
              If ci<>-1
                gr(ci)\num=mx
                ci=-1
                sortg()
                drgrad2()
              EndIf
          EndSelect
      EndSelect
    EndIf
    
    
  Until Event = #PB_Event_CloseWindow
EndIf
FreeImage(2)

0

4

egons
На 0 делить нельзя, так что после определения "nn" надо проверить что не равен 0

Код:
    nn=gr(j+1)\num-gr(j)\num
    If nn = 0
    	nn + 1
    EndIf

получение координаты "y" перенести под #PB_EventType_LeftButtonDown, так как только там нужна my и она не будет запрашиваться сотню раз в секунду, в то время как она не требуется при перемещении.

Код:
            Case #PB_EventType_LeftButtonDown
            	my = GetGadgetAttribute(#ca, #PB_Canvas_MouseY)

Мне пришлось вчера объявлять переменные

Код:
Procedure ClickHandler()
	Protected i, x, y

Procedure chco(coln)
	Protected Color

Procedure dispg()
	Protected i

Procedure sortg()
	Protected i, j, t.gradp

Procedure drgrad2()
	Protected x, j , k, r1, g1, b1, r2 ,g2 ,b2, r ,g ,b, nn, i, xx, yy

Отредактировано AZJIO (09.02.2022 11:06:55)

0

5

AZJIO написал(а):

На 0 делить нельзя, так что после определения "nn" надо проверить что не равен 0

так правильнее:

Код:
      If nn
        r=r1+(k*(r2-r1)/nn)
        g=g1+(k*(g2-g1)/nn)
        b=b1+(k*(b2-b1)/nn)
      EndIf

зачем Protected для переменных?

0

6

egons написал(а):

зачем Protected для переменных?

Чтобы явно задать область видимости.

0


Вы здесь » PureBasic - форум » PureBasic для Windows » мышь и CanvasGadget