PureBasic - форум

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

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

Вы здесь » PureBasic - форум » Вопросы по PureBasic » 2D графика, и все связанное с ней

2D графика, и все связанное с ней

Страница: 1 2  

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

1

  • Автор: haav
  • Активный участник
  • haav
  • Зарегистрирован: 20.12.2009
  • Приглашений: 0
  • Сообщений: 440
  • Уважение: [+1/-0]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    6 дней 22 часа
  • Последний визит:
    02.12.2012 09:07:36

Команда FillArea закрашивает область, отыскивая середину этой области изначально. Поправьте, если я не прав.  То есть этот код будет закрашивать прямоугольник.Как я не пытался закрасить половину прямоугольника, у меня не получается. Что то недопонимаю я с этой командой.

Код:
Width = 270
  Height = 270
  If OpenWindow(0, 0, 0, Width, Height, "FillArea", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    If StartDrawing(WindowOutput(0))
    x=20
    y=20
     Box(x,y,100,100,$000FFF)
     LineXY(50, 20, 50, 120, $FFFFFF)
      FillArea(100, 100, -1, $0000FF) ; Replace -1 by $00FF00, and compare the result
      StopDrawing() ; This is required when drawing operations are done. Never forget it!
    EndIf
   
    Repeat : Event = WaitWindowEvent() : Until Event = #PB_Event_CloseWindow
  EndIf

0

2

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 2997
  • Уважение: [+97/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 10 дней
  • Последний визит:
    Вчера 18:39:54

Всё работает!
Просто у тебя бокс и закраска одного цвета.

Код:
Width = 270
  Height = 270
  If OpenWindow(0, 0, 0, Width, Height, "FillArea", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    If StartDrawing(WindowOutput(0))
    x=20
    y=20
     Box(x,y,100,100,$000FFF)
     LineXY(50, 20, 50, 120, $FFFFFF)
      FillArea(100, 100, -1, $FF0000) ; Replace -1 by $00FF00, and compare the result
      StopDrawing() ; This is required when drawing operations are done. Never forget it!
    EndIf
   
    Repeat : Event = WaitWindowEvent() : Until Event = #PB_Event_CloseWindow
  EndIf

0

3

  • Автор: haav
  • Активный участник
  • haav
  • Зарегистрирован: 20.12.2009
  • Приглашений: 0
  • Сообщений: 440
  • Уважение: [+1/-0]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    6 дней 22 часа
  • Последний визит:
    02.12.2012 09:07:36
Пётр написал(а):

Всё работает!Просто у тебя бокс и закраска одного цвета.

Я просто тупо подставил дополнительно букву F, посчитал, что этого достаточно для разделения цветов и даже не проверил. :D .  Действительно так.

0

4

  • Автор: daiomik
  • Активный участник
  • Зарегистрирован: 30.01.2010
  • Приглашений: 0
  • Сообщений: 601
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Провел на форуме:
    17 дней 23 часа
  • Последний визит:
    07.09.2015 11:08:26

Не подскажете, как происходит рисование на окне (или рисунке) примерно как в paint. И как лучше и ПРОЩЕ это осуществить.

0

5

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 2997
  • Уважение: [+97/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 10 дней
  • Последний визит:
    Вчера 18:39:54

Вот рисование по окну.
Рисует только при нажатой левой кнопке мышки.

Код:
Global mk

Procedure MK(EV)
  Select EV
  Case #WM_LBUTTONDOWN  : If mk=2: mk=3: Else :  mk=1 :  EndIf
  Case #WM_LBUTTONUP    : If mk=3: mk=2: Else :  mk=0 :  EndIf
  Case #WM_RBUTTONDOWN  : If mk=1: mk=3: Else :  mk=2 :  EndIf
  Case #WM_RBUTTONUP    : If mk=3: mk=1: Else :  mk=0 :  EndIf
  EndSelect
EndProcedure

OpenWindow(0,0,0,500,300,"WindowLinePainter",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
xant=WindowMouseX(0):yant=WindowMouseY(0)
StartDrawing(WindowOutput(0))
Repeat
  Event=WaitWindowEvent()
     MK(Event)
     x=WindowMouseX(0)  : y=WindowMouseY(0)
     If mk=1
       LineXY(xant,yant,x,y,RGB(0,0,0))
     EndIf
     xant=x:yant=y
Until Event=#PB_Event_CloseWindow
StopDrawing()

0

6

  • Автор: mirashic
  • Активный участник
  • mirashic
  • Зарегистрирован: 02.02.2010
  • Приглашений: 0
  • Сообщений: 306
  • Уважение: [+1/-0]
  • Позитив: [+0/-0]
  • Провел на форуме:
    9 дней 5 часов
  • Последний визит:
    27.04.2013 21:06:20

Вот тоже что то похожее :

Код:
Enumeration
  #Window_0
  #Image_0
EndEnumeration


Global Image0


Image0 = CreateImage(#PB_Any, 380, 380)
If StartDrawing(ImageOutput(Image0))
    Box(0, 0, 380, 380, $FFFFFF)
  StopDrawing()
EndIf

Procedure Max(Value1_L.l, Value2_L.l) ; gibt den grosseren der beiden Werte zuruck
  Back_L.l
  If Value1_L > Value2_L
    Back_L = Value1_L
  Else
    Back_L = Value2_L
  EndIf
  ProcedureReturn Back_L
EndProcedure
Procedure.l AbsL(Value_L.l) ; returns the abs of a long
  Back_L.l = Value_L
  
  If Value_L < 0
    Back_L = -Value_L
  EndIf
  
  ProcedureReturn Back_L
EndProcedure 
Procedure.l MouseOverGadget(WindowID_L.l, GadgetID_L.l) ; returns 1, if the mouse is over the gadget
  Back_L.l
  wx = WindowMouseX(#Window_0)
  wy = WindowMouseY(#Window_0)
  gx = GadgetX(GadgetID_L)
  gy = GadgetY(GadgetID_L)
  
  If wx > -1 And wy > -1
    If wx- gx > 0 And wx- gx <= GadgetWidth(GadgetID_L)
      If wy- gy > 0 And wy- gy <= GadgetHeight(GadgetID_L)
        Back_L = 1
      EndIf
    EndIf
  EndIf
  
  ProcedureReturn Back_L
EndProcedure


Procedure Lin(DCHandle_L.l, x,y,x1,y1,Width,Color)
  pen=CreatePen_(#PS_SOLID,Width,Color) 
  hPenOld=SelectObject_(DCHandle_L,pen)
  MoveToEx_(DCHandle_L,x,y,0):LineTo_(DCHandle_L,x1,y1)
  DeleteObject_(pen)
  DeleteObject_(hPenOld)
EndProcedure 

Procedure Open_Window_0()
  LBtnDwn_L.l
  LastX_L.l = -1
  LastY_L.l = -1
  
  If OpenWindow(#Window_0, 216, 0, 400, 400, "New window ( 0 )",  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
    If CreateGadgetList(WindowID(#Window_0))
      ImageGadget(#Image_0, 10, 10, 380, 380, ImageID(Image0), #PB_Image_Border)
      
      
      Repeat 
        
        Event = WindowEvent()
        WindowID = EventWindow() 
        GadgetID = EventGadget() 
        EventType = EventType() 
        
        
        If GetSystemMetrics_(#SM_SWAPBUTTON)  
          LBtnDwn_L = GetAsyncKeyState_(#VK_RBUTTON) & $8000 
        Else
          LBtnDwn_L = GetAsyncKeyState_(#VK_LBUTTON) & $8000
        EndIf
        
        If GadgetID = #Image_0
          If MouseOverGadget(#Window_0, #Image_0)
            If LBtnDwn_L
              IDC = StartDrawing(ImageOutput(Image0))
                If IDC
                  wx = WindowMouseX(#Window_0)
                  wy = WindowMouseY(#Window_0)
                  gx = GadgetX(#Image_0)
                  gy = GadgetY(#Image_0)
                  
                  If LastX_L = -1 Or LastY_L = -1
                   ; Circle(wx - gx, wy - gy, 4, $00FF00)
                  Else
                    Lin(IDC, LastX_L, LastY_L, wx- gx, wy- gy, 2, RGB(251, 6, 4))
                  EndIf
                  LastX_L = wx- gx
                  LastY_L = wy- gy
                StopDrawing()
              EndIf
              SetGadgetState(#Image_0, ImageID(Image0))
              
            Else
              LastX_L = -1
              LastY_L = -1
            EndIf
          EndIf
        EndIf
        
        Delay(1)
      Until Event = #PB_Event_CloseWindow ; End of the event loop
      
    EndIf
  EndIf
EndProcedure

Open_Window_0()

End

Отредактировано mirashic (05.04.2010 19:43:14)

0

7

  • Автор: mirashic
  • Активный участник
  • mirashic
  • Зарегистрирован: 02.02.2010
  • Приглашений: 0
  • Сообщений: 306
  • Уважение: [+1/-0]
  • Позитив: [+0/-0]
  • Провел на форуме:
    9 дней 5 часов
  • Последний визит:
    27.04.2013 21:06:20

Вот ещё нашел пример :
http://www.mirashic.narod.ru/draw.rar

0

8

  • Автор: haav
  • Активный участник
  • haav
  • Зарегистрирован: 20.12.2009
  • Приглашений: 0
  • Сообщений: 440
  • Уважение: [+1/-0]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    6 дней 22 часа
  • Последний визит:
    02.12.2012 09:07:36

Чего то я не пойму. Данный пример превосходно работает в 4.31 и ниже, но в начиная с 4.40 работает не так как надо. Прямоугольник должен двигаться и не оставлять след за собой, а в новых версиях за ним тянется вереница.  o.O   

Код:
If InitSprite()=0 Or InitKeyboard()=0
   End
EndIf

If OpenScreen(640, 480, 32, "")
   
   
   
   x=100 : y=100
   
   Repeat                    
      
      ClearScreen(RGB(0, 0, 100))
      
      
      
      StartDrawing(ScreenOutput())
         Box(x, y, 20, 20, RGB(Random(255), Random(255), Random(255)))
      StopDrawing()
      
      FlipBuffers()
      
      ExamineKeyboard()
      
      
  
      If KeyboardPushed(#PB_Key_Right)
         x+2
      ElseIf KeyboardPushed(#PB_Key_Left)
         x-2
      ElseIf KeyboardPushed(#PB_Key_Up)
         y-2
      ElseIf KeyboardPushed(#PB_Key_Down)
         y+2
      EndIf
      
   Until KeyboardPushed(#PB_Key_Escape)
   
   
Else
   MessageRequester("", "Неа.. кина не будет")
EndIf

End

0

9

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 2997
  • Уважение: [+97/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 10 дней
  • Последний визит:
    Вчера 18:39:54
haav написал(а):

но в начиная с 4.40 работает не так как надо. Прямоугольник должен двигаться и не оставлять след за собой, а в новых версиях за ним тянется вереница

Проверил в 4.31, 4.40 и 4.41.
Ничего не тянется, следа нет!

0

10

  • Автор: haav
  • Активный участник
  • haav
  • Зарегистрирован: 20.12.2009
  • Приглашений: 0
  • Сообщений: 440
  • Уважение: [+1/-0]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    6 дней 22 часа
  • Последний визит:
    02.12.2012 09:07:36

Проверил в 4.31, 4.40 и 4.41.
Ничего не тянется, следа нет!

Получается опять что то с виндой, недавно ведь менял  :(

0

11

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 2997
  • Уважение: [+97/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 10 дней
  • Последний визит:
    Вчера 18:39:54
haav написал(а):

опять что то с виндой

Что за винда?
Случайно не зверь?

0

12

  • Автор: haav
  • Активный участник
  • haav
  • Зарегистрирован: 20.12.2009
  • Приглашений: 0
  • Сообщений: 440
  • Уважение: [+1/-0]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    6 дней 22 часа
  • Последний визит:
    02.12.2012 09:07:36

Нет, у меня стоит нормальная полная версия. Хотя и есть желание в будующем поставить CHIP EDITION  покрасивше выглядит. Это единственная сборка у меня.

0

13

  • Автор: daiomik
  • Активный участник
  • Зарегистрирован: 30.01.2010
  • Приглашений: 0
  • Сообщений: 601
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Провел на форуме:
    17 дней 23 часа
  • Последний визит:
    07.09.2015 11:08:26

Подскажите пожалуйста, каким способом на окне расположить обычную картинку в виде фона.

0

14

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 2997
  • Уважение: [+97/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 10 дней
  • Последний визит:
    Вчера 18:39:54

Выбираем рисунк, равный размеру окна и помещаем его в окно с помощью ImageGadget http://depositfiles.com/files/b9pc9f44j

Код:
UseJPEGImageDecoder()
OpenWindow(1,0,0,374,500,"",#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered|#PB_Window_Invisible)
  
  CatchImage(1,?M1, ?M2-?M1) ; Загружаем рисунок из памяти
  ImageGadget(1,0,0,374,500, ImageID(1) ) ; Отображаем его
  DisableGadget(1, #True)
  
  ButtonGadget(2, 200,100,100,24,"Кнопка")
  
HideWindow(1,0)  
Repeat ; Начало главного цикла Repeat-Until
 Event=WaitWindowEvent() ; Получаем текущий идентификатор события
 
Until Event=#PB_Event_CloseWindow ; Прерываем цикл при попытке закрыть окно (щелчёк по крестику в заголовке окна)
End ; Завершаем работу программы

DataSection
 M1:
  IncludeBinary "PB4-Developer.jpg"
 M2:
EndDataSection

0

15

  • Автор: daiomik
  • Активный участник
  • Зарегистрирован: 30.01.2010
  • Приглашений: 0
  • Сообщений: 601
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Провел на форуме:
    17 дней 23 часа
  • Последний визит:
    07.09.2015 11:08:26

Спасибо.

0

16

  • Автор: lakomet
  • Активный участник
  • Откуда: г.Ангарск Иркутская обл.
  • Зарегистрирован: 18.12.2009
  • Приглашений: 0
  • Сообщений: 138
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 53 [1971-11-06]
  • Провел на форуме:
    10 дней 22 часа
  • Последний визит:
    12.11.2023 02:39:13

Доброго времени. Вопрос к тем кто знает asm, вот здесь есть код на asme-вращение, как его прикрутить к Пурику?

0

17

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 2997
  • Уважение: [+97/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 10 дней
  • Последний визит:
    Вчера 18:39:54
lakomet написал(а):

вот здесь есть код на asme-вращение

Из того кода, создаётся 16-битное приложение с расширением COM под DOS.

Во код на пурике, позволяющий вращать рисунки

Код:
Define.w OrigBreite,OrigHoehe,OrigXDrehpunkt,OrigYDrehpunkt,ZielBreite,ZielHoehe,Rand

; Standardvariablen definieren
#GFX_Mittelwertfilter = 1
OrigBreite=220
OrigHoehe=200
OrigXDrehpunkt=45
OrigYDrehpunkt=45
ZielBreite=OrigBreite
ZielHoehe=OrigHoehe
Rand=20
Filterung.b=#GFX_Mittelwertfilter
Filterung.b=0
Dim OrigPoint(OrigBreite+1,OrigHoehe+1)

If OpenWindow(0,10,10,OrigBreite*2+Rand*3,OrigHoehe+Rand*2," 2D Image-Rotation  <ESC>-Ende   <Space>-Pause   <F>-Filter",0)
  If CreateImage(1,OrigBreite,OrigHoehe)
    ; original Ausgangsbild erzeugen
    If StartDrawing(ImageOutput(1))
      Box(1,1,OrigBreite-2,OrigHoehe-2,RGB(255,255,255))
      Box(20,30,OrigBreite-40,30,RGB(20,200,200))
      ;Circle(OrigXDrehpunkt,OrigYDrehpunkt,4,RGB(0,0,255))
      ;Circle(OrigXDrehpunkt,OrigYDrehpunkt,2,RGB(255,255,255))
      Circle(40,OrigHoehe-41,30,RGB(200,33,33))
      ; Daten des Originalbildes in einem Array zwischenspeichern
      For x.w = 1 To OrigBreite
        For y.w = 1 To OrigHoehe
          OrigPoint(x,y)=Point(x-1,y-1)
        Next y
      Next x
      StopDrawing()
    EndIf
    If StartDrawing(WindowOutput(0))
      Hintergrundfarbe = Point(1,1)
      ; Im Bildpuffer einen Rahmen in Hintergrundfarbe um das Bild legen (fьr Filter)
      For x=0 To OrigBreite : OrigPoint(x,0)=Hintergrundfarbe : OrigPoint(x,OrigHoehe+1)=Hintergrundfarbe  : Next x
      For Y=0 To OrigHoehe  : OrigPoint(0,y)=Hintergrundfarbe : OrigPoint(OrigBreite+1,y)=Hintergrundfarbe : Next y
      ; Originalbild auf Fenster ausgeben
      OrigImageID=ImageID(1)
      DrawImage(OrigImageID,Rand,Rand)
      StopDrawing()
    EndIf
    If CreateImage(2,ZielBreite,ZielHoehe)
      Repeat
        For w = 0 To 359
          Winkel.f = 3.141/180*w
          ; mehrfach benutzte Berechnungen puffern
          SinWinkel.f = Sin(Winkel)
          CosWinkel.f = Cos(Winkel)
          ZielImageID=ImageID(2)
          If StartDrawing(ImageOutput(2))
            ; Zielimage lцschen
            Box(0,0,ZielBreite,ZielHoehe,Hintergrundfarbe)
            StartTimer = ElapsedMilliseconds()
            For x.w = 1 To OrigBreite
              ; mehrfach benutzte Berechnungen puffern
              xSinWinkel.f = (x-OrigXDrehpunkt)*SinWinkel
              xCosWinkel.f = (x-OrigXDrehpunkt)*CosWinkel
              For y.w = 1 To OrigHoehe
                zx.f=(xCosWinkel-(y-OrigYDrehpunkt)*SinWinkel)+OrigXDrehpunkt
                zy.f=(xSinWinkel+(y-OrigYDrehpunkt)*CosWinkel)+OrigYDrehpunkt
                Select Filterung
                  Case #GFX_Mittelwertfilter
                    ; Berechnung mit Filter
                    zxi = Int(zx+0.5)
                    zyi = Int(zy+0.5)
                    If zx>0 And zx<ZielBreite+1 And zy>0 And zy<ZielHoehe+1
                      PixelFarbe1 = OrigPoint(zxi,zyi)
                      If zx<zxi
                        PixelFarbe2 = OrigPoint(zxi-1,zyi)
                      Else
                        PixelFarbe2 = OrigPoint(zxi+1,zyi)
                      EndIf
                      Gewichtung2.f=Abs(zx-zxi)
                      If zy>zyi
                        PixelFarbe3 = OrigPoint(zxi,zyi+1)
                      Else
                        PixelFarbe3 = OrigPoint(zxi,zyi-1)
                      EndIf
                      Gewichtung3.f=Abs(zy-zyi)
                      Gewichtung1.f=1-Gewichtung2-Gewichtung3
                      ; Pixelgewichtung berechnen
                      PixelRed=Red(PixelFarbe1)*Gewichtung1+Red(PixelFarbe2)*Gewichtung2+Red(PixelFarbe3)*Gewichtung3
                      PixelGreen=Green(PixelFarbe1)*Gewichtung1+Green(PixelFarbe2)*Gewichtung2+Green(PixelFarbe3)*Gewichtung3
                      PixelBlue=Blue(PixelFarbe1)*Gewichtung1+Blue(PixelFarbe2)*Gewichtung2+Blue(PixelFarbe3)*Gewichtung3
                      Plot(x-1,y-1,RGB(PixelRed,PixelGreen,PixelBlue))
                    EndIf
                  Default
                    ; Berechnung ohne Filter
                    If zx>=1 And zx<ZielBreite+1 And zy>=1 And zy<ZielHoehe+1
                      Plot(x-1,y-1,OrigPoint(Int(zx),Int(zy)))
                    EndIf
                EndSelect
              Next y
            Next x
            StopDrawing()
            SetWindowTitle(0," 2D Image-Rotation  <ESC>-Ende   <Space>-Pause   <F>-Filter     FPS: "+Str(1000/(ElapsedMilliseconds()-StartTimer+1)))
          EndIf
          If StartDrawing(WindowOutput(0))
            ; gedrehtes Image auf Fenster ausgeben
            DrawImage(ZielImageID,rand*2+OrigBreite,Rand)
            StopDrawing()
          EndIf
          Event=WindowEvent()
          If Event = #WM_KEYDOWN
            If EventwParam() = #VK_SPACE
              Repeat
                Event=WaitWindowEvent()
              Until Event = #WM_KEYDOWN
            ElseIf EventwParam() = #VK_F
              Filterung = #GFX_Mittelwertfilter-Filterung
            ElseIf EventwParam() = #VK_ESCAPE
              Break 2
            EndIf
          EndIf
        Next w
      ForEver
    EndIf
  EndIf
EndIf
End

0

18

  • Автор: daiomik
  • Активный участник
  • Зарегистрирован: 30.01.2010
  • Приглашений: 0
  • Сообщений: 601
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Провел на форуме:
    17 дней 23 часа
  • Последний визит:
    07.09.2015 11:08:26

При запуске примера, написанным Петром у меня вылетает ошибка, при этом прога нормально запускается. В чем проблема? Библиотеки установил
Скрин:
http://i058.radikal.ru/1007/17/da190e9c9058.gif
Код:

Код:
; Программа для сниятия скриншотов.
; Нужен компилятор PureBasic 4.00 или выше. Требуются библиотеки Droopy Library и XP_Menu_Lib

Enumeration 0
  #Window_0
EndEnumeration

;- Gadget Constants
;
Enumeration
  #Text_0
  #Path
  #Button_Path
  #Frame3D_0
  #Radio_BMP
  #Radio_JPEG
  #Radio_PNG
  #Text_1
  #Spin_0
  #CheckBox_0
  #Text_2
  #Text_3
  #Text_4
  #Text_5
EndEnumeration

;- Fonts
Global FontID1
FontID1 = LoadFont(1, "MS Sans Serif", 8, #PB_Font_Bold)

UseJPEGImageEncoder()
UsePNGImageEncoder()

#ProgName="Skrinhot v1.0"


Procedure IconWidth(Icon) 
  BmpInf.BITMAP:GetIconInfo_(Icon,Info.ICONINFO) 
  GetObject_(Info\hbmColor,SizeOf(BmpInf),BmpInf) 
  ProcedureReturn BmpInf\bmWidth 
EndProcedure 

Procedure IconHeight(Icon) 
  BmpInf.BITMAP:GetIconInfo_(Icon,Info.ICONINFO) 
  GetObject_(Info\hbmColor,SizeOf(BmpInf),BmpInf) 
  ProcedureReturn BmpInf\bmHeight 
EndProcedure 

Procedure ConvertIcon2Image(ImageNr,Icon,IconWidth,IconHeight) 
 
    CreateImage(ImageNr, IconWidth, IconHeight) 
    StartDrawing(ImageOutput(ImageNr)) 
    DrawImage(Icon,0,0) 
    StopDrawing()
EndProcedure 



Procedure SkrinActiveWindow(FileName.s,ImagePlugin,Pak)

 Handle=ForegroundWindowGet()
  If Handle
   WindowSize.RECT 
   GetWindowRect_(Handle, @WindowSize) 
   IconWidth=WindowSize\Right - WindowSize\Left 
   IconHeight=WindowSize\Bottom - WindowSize\Top 
   *Image= CaptureScreenPart(WindowSize\Left, WindowSize\Top, IconWidth,IconHeight) 
  EndIf


If *Image=0
 ProcedureReturn
EndIf

ConvertIcon2Image(1,*Image,IconWidth,IconHeight)

 If IsImage(1)>0
  SaveImage(1,FileName,ImagePlugin,Pak)
 
 EndIf

;FreeMemory(*Image)
EndProcedure




Procedure Open_Window_0()
  If OpenWindow(#Window_0, 275, 242, 383, 276, "Настройки "+#ProgName,  #PB_Window_SystemMenu | #PB_Window_Invisible | #PB_Window_TitleBar | #PB_Window_ScreenCentered )
    If CreateGadgetList(WindowID(#Window_0))
      TextGadget(#Text_0, 15, 15, 105, 15, "Папка для снимков")
      StringGadget(#Path, 15, 30, 325, 20, "")
      ButtonGadget(#Button_Path, 345, 30, 25, 20, "...")
      Frame3DGadget(#Frame3D_0, 15, 70, 325, 85, "Сохранять как")
      OptionGadget(#Radio_BMP, 30, 90, 110, 15, "BMP (без сжатия)")
      OptionGadget(#Radio_JPEG, 30, 110, 105, 15, "JPEG")
      OptionGadget(#Radio_PNG, 30, 130, 110, 15, "PNG")
      TextGadget(#Text_1, 170, 110, 90, 15, "Степень сжатия")
      SpinGadget(#Spin_0, 265, 105, 40, 20, 1, 100)
      CheckBoxGadget(#CheckBox_0, 25, 250, 215, 15, "Добавить программу в автозагрузку")
      TextGadget(#Text_2, 10, 170, 240, 15, "Горячая клавиша для снимка всего экрана —")
      TextGadget(#Text_3, 265, 170, 100, 15, "PrintScreen")
      SetGadgetFont(#Text_3, FontID1)
      TextGadget(#Text_4, 10, 195, 245, 15, "Горячая клавиша для снимка активного окна —")
      TextGadget(#Text_5, 265, 195, 115, 15, "Ctrl + PrintScreen")
      SetGadgetFont(#Text_5, FontID1)
      
    EndIf
  EndIf
EndProcedure


Procedure CreateSkrinAll()
  If GetGadgetState(#Radio_BMP)=1
   Part.s=".BMP" : ImagePlugin=#PB_ImagePlugin_BMP 
  ElseIf  GetGadgetState(#Radio_JPEG)=1
   Part.s=".JPEG" : ImagePlugin=#PB_ImagePlugin_JPEG 
  ElseIf  GetGadgetState(#Radio_PNG)=1
   Part.s=".PNG" : ImagePlugin=#PB_ImagePlugin_PNG  
  EndIf
  
  File.s=GetGadgetText(#Path)+FormatDate("%hh_%ii_%ss", Date())+Part
  CaptureFullScreen()
  SaveCapture(File,ImagePlugin,GetGadgetState(#Spin_0)/10)
EndProcedure

Procedure CreateSkrinWindow()

  If GetGadgetState(#Radio_BMP)=1
   Part.s=".BMP" : ImagePlugin=#PB_ImagePlugin_BMP 
  ElseIf  GetGadgetState(#Radio_JPEG)=1
   Part.s=".JPEG" : ImagePlugin=#PB_ImagePlugin_JPEG 
  ElseIf  GetGadgetState(#Radio_PNG)=1
   Part.s=".PNG" : ImagePlugin=#PB_ImagePlugin_PNG  
  EndIf
  
  File.s=GetGadgetText(#Path)+FormatDate("%hh_%ii_%ss", Date())+Part
  
 SkrinActiveWindow(File,ImagePlugin,GetGadgetState(#Spin_0)/10)
 
EndProcedure

Procedure GlavWindowCallback(WindowID, Message, wParam, lParam)
 XP_Menu_CB(WindowID, Message, wParam, lParam)
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure


Procedure SetStyleMenu(Style, IconState)
 
 If Style>0 And Style<8
 
   XP_MenuRegister(MenuID(0), #XP_RegMenu, #XP_RegPopupMenu)   
   XP_SetMenuStyle(Style-1)
   SetMenuItemState(0,18,IconState)
   DisableMenuItem(0,18,0)
   
    If IconState=1
      XP_SetMenuIcon(MenuID(0),1,ImageID(3))
      XP_SetMenuIcon(MenuID(0),2,ImageID(4))
      XP_SetMenuIcon(MenuID(0),3,ImageID(5))
      XP_SetMenuIcon(MenuID(0),4,ImageID(2))
      
    Else
     XP_SetMenuIcon(MenuID(0),1,0)
      XP_SetMenuIcon(MenuID(0),2,0)
      XP_SetMenuIcon(MenuID(0),3,0)
      XP_SetMenuIcon(MenuID(0),4,0)
    EndIf
    For i=6 To 12
     If i=Style+5
      SetMenuItemState(0,i,1)
     Else
      SetMenuItemState(0,i,0)
     EndIf
    Next i
       
 Else
     SetMenuItemState(0,5,1)
     For i=6 To 12
      SetMenuItemState(0,i,0)
     Next i
     XP_MenuRegister(MenuID(0), #XP_DelMenu, #XP_RegPopupMenu)
     SetMenuItemState(0,18,0)
     DisableMenuItem(0,18,1)
 EndIf
 
 
 
  
 
DrawMenuBar_(WindowID(0))
EndProcedure


Open_Window_0()
SetWindowCallback(@GlavWindowCallback())

DirTemp.s=GetTemporaryDirectory()
PathPref.s=DirTemp+"Skrinhot v1.0.ini"

Gosub OpenPreferences
Gosub WinS

CatchImage(2,?IconClose, ?IconCloseEnd-?IconClose)
CatchImage(3,?IconOpenDir, ?IconOpenDirEnd-?IconOpenDir)
CatchImage(4,?IconPreference, ?IconPreferenceEnd-?IconPreference)
CatchImage(5,?Iconhelp, ?IconhelpEnd-?Iconhelp)


If CreatePopupMenu(0)
 MenuItem(1,"Папка снимков")
 MenuBar()
 OpenSubMenu("Стиль меню")
  MenuItem(5,"Стандартный")
  MenuItem(6,"Офис 2000")
  MenuItem(7,"Офис XP")
  MenuItem(8,"Офис 2003")
  MenuItem(9,"Фиолетовый")
  MenuItem(10,"Чёрный")
  MenuItem(11,"Серый")
  MenuItem(12,"Зелёный")
  MenuBar()
  MenuItem(18,"Значки")
 CloseSubMenu()
 MenuItem(2,"Настройки")
 MenuItem(3,"О программе")
 MenuBar()
 MenuItem(4,"Выход")
EndIf
 SetStyleMenu(StyleMenu, IconState)
 

 If AddSysTrayIcon(1,WindowID(#Window_0),CatchImage(1,?Icon,?IconEnd-?Icon))=0
  MessageRequester("Skrinhot v1.0", "Не удалось создать иконку в трее", #MB_OK|#MB_ICONERROR)
  End
 EndIf
 
 Exit=0
 
 HotKeysInit()
 HotKeyAdd(WindowID(#Window_0), 44, @CreateSkrinAll(), "SkrinAll", 0,0,0)
 HotKeyAdd(WindowID(#Window_0), 44, @CreateSkrinWindow(), "SkrinWin", 0,0,1)

 Repeat
 Event=HotkeyWaitWindowEvent()
 Gadget=EventGadget()
 Menu=EventMenu()
 Type=EventType()
 
  If Event=#PB_Event_SysTray
   If Type=#PB_EventType_RightClick
    DisplayPopupMenu(0, WindowID(#Window_0)) ; показ вспывающего меню
   EndIf
   
   If Type=#PB_EventType_LeftDoubleClick 
     If IsWindow(#Window_0)=0
      Open_Window_0()
      Gosub WinS
      HideWindow(#Window_0,0)
     Else
      SetActiveWindow(#Window_0)
      HideWindow(#Window_0,0)
     EndIf
   EndIf
   
  EndIf
  
  If Event=#PB_Event_Menu
   Select Menu
    Case 1
     PathDir.s=GetGadgetText(#Path)
     If PathDir<>""
      If FileSize(PathDir)= -2
       RunProgram(PathDir)
      EndIf
     EndIf
    Case 2
     If IsWindow(#Window_0)=0
      Open_Window_0()
      Gosub WinS
      HideWindow(#Window_0,0)
     Else
      SetActiveWindow(#Window_0)
      HideWindow(#Window_0,0)
     EndIf
    Case 3
     MessageRequester("О программе", #ProgName+" — программа для снятия скриншотов с экрана компьютера"+Chr(10)+"Она была разработана в системе PureBasic — http://pbasic.spb.ru/"+Chr(10)+Chr(10)+"Автор:    Пётр"+Chr(10)+"E-Mail:     purik4.0@rambler.ru", #MB_OK|#MB_ICONINFORMATION)
    Case 4
     Exit=1
     
    Case 5 To 12
     For i=5 To 12
      If i=Menu
       SetMenuItemState(0,i,1)
      Else
       SetMenuItemState(0,i,0)
      EndIf
     Next i
     
     StyleMenu=Menu-5
     SetStyleMenu(StyleMenu, IconState)
      If OpenPreferences(PathPref)
       WritePreferenceLong("StyleMenu",StyleMenu)
       WritePreferenceLong("IconState",IconState)
       ClosePreferences()
      EndIf
    Case 18
     IconState=GetMenuItemState(0,18)!1
     SetMenuItemState(0,18,IconState)
     SetStyleMenu(StyleMenu, IconState)
     If OpenPreferences(PathPref)
      WritePreferenceLong("StyleMenu",StyleMenu)
      WritePreferenceLong("IconState",IconState)
      ClosePreferences()
     EndIf
     
   EndSelect
  EndIf
  
  If Event=#PB_Event_Gadget
   Select Gadget
    Case #Button_Path
     TempPath.s=PathRequester("Выберите папку, где будут сохранятся снимки.",PathSkrin.s)
      If TempPath<>""
       SetGadgetText(#Path,TempPath) : PathSkrin=TempPath
      EndIf
      
    Case #Spin_0
     SetGadgetText(#Spin_0,Str(GetGadgetState(#Spin_0)))
     
    Case #Radio_BMP
     DisableGadget(#Text_1,1) :  DisableGadget(#Spin_0,1)
    Case #Radio_JPEG
     DisableGadget(#Text_1,0) :  DisableGadget(#Spin_0,0)
    Case #Radio_PNG 
     DisableGadget(#Text_1,1) :  DisableGadget(#Spin_0,1)
   EndSelect
  EndIf
  
  If Event=#PB_Event_CloseWindow
   PathSkrin.s=GetGadgetText(#Path)
   
   If GetGadgetState(#Radio_BMP)=1
    SkrinType=0
   ElseIf GetGadgetState(#Radio_JPEG)=1
    SkrinType=1
   ElseIf GetGadgetState(#Radio_PNG)=1
    SkrinType=2
   EndIf
   
   JPGPAK=GetGadgetState(#Spin_0)
   AutoRunState=GetGadgetState(#CheckBox_0)
 
     If AutoRunState=1
      If IsProgramRunAtStartup(0,1,"Skrinhot")=""
       RunProgramAtStartup(0,1,"Skrinhot",HandleToFileName(WindowID(#Window_0)))
      EndIf
     ElseIf AutoRunState=0
      If IsProgramRunAtStartup(0,1,"Skrinhot")<>""
       DelProgramAtStartup(0,1,"Skrinhot")
      EndIf
     EndIf

   
   Gosub SavePreferences
   HideWindow(#Window_0,1)
  EndIf
 
 
 Until Exit=1
 TimerKill(1,WindowID(#Window_0))
 End
 
OpenPreferences:
PathPrefState=OpenPreferences(PathPref)
PathSkrin.s=ReadPreferenceString("PathSkrin",GetPathPart(GetProgramName()))
SkrinType=ReadPreferenceLong("SkrinType",0)
JPGPAK=ReadPreferenceLong("JPGPAK",85)
AutoRunState=ReadPreferenceLong("AutoRunState",0)
StyleMenu=ReadPreferenceLong("StyleMenu",3)
IconState=ReadPreferenceLong("IconState",1)

 If PathPrefState=0
  CreatePreferences(PathPref)
 EndIf
 ClosePreferences()
Return 


SavePreferences:
If OpenPreferences(PathPref)
 WritePreferenceString("PathSkrin",PathSkrin.s)
 WritePreferenceLong("SkrinType",SkrinType)
 WritePreferenceLong("JPGPAK",JPGPAK)
 WritePreferenceLong("AutoRunState",AutoRunState)
 WritePreferenceLong("StyleMenu",StyleMenu)
 WritePreferenceLong("IconState",IconState)
 ClosePreferences()
EndIf
Return 

WinS:
SetGadgetText(#Path,PathSkrin)

 Select SkrinType
  Case 0
   SetGadgetState(#Radio_BMP,1) : DisableGadget(#Text_1,1) :  DisableGadget(#Spin_0,1)
  Case 1
   SetGadgetState(#Radio_JPEG,1) : DisableGadget(#Text_1,0) :  DisableGadget(#Spin_0,0)
  Case 2
   SetGadgetState(#Radio_PNG,1) : DisableGadget(#Text_1,1) :  DisableGadget(#Spin_0,1)
 EndSelect
 
 SetGadgetState(#Spin_0,JPGPAK)
 SetGadgetText(#Spin_0,Str(JPGPAK))
 
 SetGadgetState(#CheckBox_0,AutoRunState)

Return

DataSection

Icon:
IncludeBinary "Значки\Значок.ico"
IconEnd:

IconClose:
IncludeBinary "Значки\Close.ico"
IconCloseEnd:

IconOpenDir:
IncludeBinary "Значки\OpenDir.ico"
IconOpenDirEnd:

IconPreference:
IncludeBinary "Значки\Preference.ico"
IconPreferenceEnd:

Iconhelp:
IncludeBinary "Значки\help.ico"
IconhelpEnd:

EndDataSection

Отредактировано daiomik (25.07.2010 21:08:32)

0

19

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 2997
  • Уважение: [+97/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 10 дней
  • Последний визит:
    Вчера 18:39:54
daiomik написал(а):

В чем проблема?

При компиляции других исходников этой ошибки нет?
Должна быть!

В меню "Инструменты" выбери "Настройка инструментов" и сними галку напротив имени этой проги.

PS.
Ты установил новую версию пурика поверх старой?

0

20

  • Автор: daiomik
  • Активный участник
  • Зарегистрирован: 30.01.2010
  • Приглашений: 0
  • Сообщений: 601
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Провел на форуме:
    17 дней 23 часа
  • Последний визит:
    07.09.2015 11:08:26
Пётр написал(а):

При компиляции других исходников этой ошибки нет?

Пётр написал(а):

В меню "Инструменты" выбери "Настройка инструментов" и сними галку напротив имени этой проги.

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

Пётр написал(а):

При компиляции других исходников этой ошибки нет?Должна быть!

да была

Пётр написал(а):

Ты установил новую версию пурика поверх старой?

сначала да, но все стер подчистую и сейчас поставил отдельно в разные папки PureBasic_4.31 и PureBasic_4.50. Правильно ли сделал? и не будет ли конфликта в данной ситуации. И как быть если нет версий библиотек на новую версию PB?

0

21

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 2997
  • Уважение: [+97/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 10 дней
  • Последний визит:
    Вчера 18:39:54
daiomik написал(а):

будет ли конфликта в данной ситуации

Файлы с настройками будут общие.
В принципе, это не страшно, но если это не желательно, то можно запускать PB с параметром  /PORTABLE

http://s58.radikal.ru/i159/1007/5e/b72911eedb13.png

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

И как быть если нет версий библиотек на новую версию PB

Не использовать библиотеки или ждать пока появятся.

0

22

  • Автор: lakomet
  • Активный участник
  • Откуда: г.Ангарск Иркутская обл.
  • Зарегистрирован: 18.12.2009
  • Приглашений: 0
  • Сообщений: 138
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 53 [1971-11-06]
  • Провел на форуме:
    10 дней 22 часа
  • Последний визит:
    12.11.2023 02:39:13

Доброго времени. Как в процедуру передать изображение или хотя бы как получить изображение из процедуры, если в процедуру его передать в виде массива. Я полагаю, что через адрес, но как до меня не доходит.

0

23

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 2997
  • Уважение: [+97/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 10 дней
  • Последний визит:
    Вчера 18:39:54

Массив можно передать через аргументы процедуры

Код:
Dim test.c(10)

Procedure x(Array test.c(1) )

 For i= 1 To 10
   test(i) = i
 Next i

EndProcedure

x( test() )

For i= 1 To 10
  Debug test(i)
Next i

0

24

  • Автор: lakomet
  • Активный участник
  • Откуда: г.Ангарск Иркутская обл.
  • Зарегистрирован: 18.12.2009
  • Приглашений: 0
  • Сообщений: 138
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 53 [1971-11-06]
  • Провел на форуме:
    10 дней 22 часа
  • Последний визит:
    12.11.2023 02:39:13

Пётр
Я видимо не правильно сформулировал вопрос. Как передать массив в процедуру, где то встречал(найду), меня интересует как без сохранения на диск получить изображение из функции. Для чего это нужно? - в пурике нет(или не нашел) функции поворота изображения. Я подшаманил малееенько Ваш пример из 17 поста(теперь изображение поворачивается без обрезки краёв), так вот хотелось бы сделать юзерлибу rotate.
Возможно надо использовать DrawingBuffer(), но я не знаю как.

0

25

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 2997
  • Уважение: [+97/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 10 дней
  • Последний визит:
    Вчера 18:39:54
lakomet написал(а):

как без сохранения на диск получить изображение из функции

Данные из картинки где хранятся? В массиве?
Тогда просто передаем массив в процедуру и после заврешения работы процедцуры, читаем данные из массива.

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

так вот хотелось бы сделать юзерлибу rotate

В этом случае, лучше передавать процедуре ID рисунка оригинала и ID рисунка, в котором будет сохранена повёрнутая копия.

0

26

  • Автор: lakomet
  • Активный участник
  • Откуда: г.Ангарск Иркутская обл.
  • Зарегистрирован: 18.12.2009
  • Приглашений: 0
  • Сообщений: 138
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 53 [1971-11-06]
  • Провел на форуме:
    10 дней 22 часа
  • Последний визит:
    12.11.2023 02:39:13

Полагаю как-то так

Код:
If CreateImage(#Image,Shirina,Visota)
     Rotate(ImageID(#Image),x1,y1,x2,y2,parametr1,parametr2,parametr3)
Endif

а в процедуре

Код:
ProcedureDLL Rotate(ID_Image,x1,y1,x2,y2,parametr1,parametr2,parametr3)
          If StartDrawing(ID_Image)
            Box(x1+10,y1+10,x2-10,y2-10,4000)
          EndIf
EndProcedure

Правильно?

0

27

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 2997
  • Уважение: [+97/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 10 дней
  • Последний визит:
    Вчера 18:39:54

Думаю что лучше так

Код:
Rotate(SourceImage, NewImage, UgolPovorota)

0

28

  • Автор: lakomet
  • Активный участник
  • Откуда: г.Ангарск Иркутская обл.
  • Зарегистрирован: 18.12.2009
  • Приглашений: 0
  • Сообщений: 138
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 53 [1971-11-06]
  • Провел на форуме:
    10 дней 22 часа
  • Последний визит:
    12.11.2023 02:39:13

Как вывести в  ImageGadget, одновременно два полупрозрачных изображения, так чтобы было видно их оба, и при необходимости можно было удалить одно изображение.

0

29

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 2997
  • Уважение: [+97/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 10 дней
  • Последний визит:
    Вчера 18:39:54
lakomet написал(а):

Как вывести в  ImageGadget, одновременно два полупрозрачных изображения, так чтобы было видно их оба

Где-то здесь mirashic выкладывал подобный пример.

По идее (сам не пробовал), один полупрозрачный рисунок можно наложить на другой с помощью DrawAlphaImage.

0

30

  • Автор: lakomet
  • Активный участник
  • Откуда: г.Ангарск Иркутская обл.
  • Зарегистрирован: 18.12.2009
  • Приглашений: 0
  • Сообщений: 138
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 53 [1971-11-06]
  • Провел на форуме:
    10 дней 22 часа
  • Последний визит:
    12.11.2023 02:39:13

Пётр
Вы когда нибудь использовали изображения SVG в пурике? Вот здесь Seymour Clufley даёт код .pbi, как его использовать(если можно пример) и нужен ли для этого WebGadget()?

0

Страница: 1 2  

Вы здесь » PureBasic - форум » Вопросы по PureBasic » 2D графика, и все связанное с ней