PureBasic - форум

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

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


Вы здесь » PureBasic - форум » Вопросы по PureBasic » Электронная линейка


Электронная линейка

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

1

Существует дизайнерская программа - Atrise Golden Section, программа очень удобная.
В двух словах - это линейка.
Полностью прозрачное окно, только вертикальные и горизонтальные линии видно.
И текст,  показывающий ширину и высоту при изменении размеров.
Пробую что то похожее сделать на PureBasic.
Если убрать бордюр окна, то не получается изменять размер?
При изменении размера сильное мерцание?
Можно каким то образом сделать окно полностью прозрачное, а линии нет?

Код:
Enumeration 
 #Window_0
 #x
 #y
 #wid
 #y0
 #y1
 #x0
 #x1
EndEnumeration

; ///////////////////////Гаджет линия/////////////////////////////////
Procedure LineGadgetHeight(Gadget, x, y, Height, color)
Im=CreateImage(#PB_Any, 1, Height)
If Im
 If StartDrawing(ImageOutput(Im))
    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,1 ,color)       
  StopDrawing()
  ImageGadget(Gadget,x, y, Width,1,ImageID(Im))
 EndIf
EndIf
EndProcedure
; //////////////////////////////////////////////////////////////////////

hWnd = OpenWindow (#Window_0, 0, 0, 700, 200, "Линейка", #PB_Window_SystemMenu |#PB_Window_ScreenCentered|#PB_Window_SizeGadget|#PB_Window_BorderLess ) 
StickyWindow(#Window_0, 1)
SetWindowColor(#Window_0,$000000)
SmartWindowRefresh(#Window_0 ,1)  ; для уменьшения мигания окна при изменении размера

  
    TextGadget(#wid, 0, 0,  50, 14, "")  ;  текст малого окна
    SetGadgetColor(#wid, #PB_Gadget_BackColor,  $000000)
    SetGadgetColor(#wid, #PB_Gadget_FrontColor, $ffffff)

  LineGadgetWidth(#x0,0,0 ,  1680, $0000FF)                          ; горизонтальная  линия первая
  LineGadgetWidth(#x, 0, WindowHeight(#Window_0)/2, 1680, $0000FF)   ; горизонтальная линия средняя
  LineGadgetWidth(#x1, 0, 199, 1680, $0000FF)  ; горизонтальная линия последняя

  LineGadgetHeight(#y0, 0,0 ,  1050, $0000FF)                        ; вертикальная  линия первая
  LineGadgetHeight(#y, WindowWidth(#Window_0)/2,0 ,  1050, $0000FF)  ; вертикальная  линия средняя
  LineGadgetHeight(#y1, 699,0 ,  1050, $0000FF)                      ; вертикальная  линия последняя

Repeat
Event =  WaitWindowEvent() 

SetGadgetText(#wid,  Str(WindowWidth(#Window_0)/2)+" x "+Str(WindowHeight(#Window_0)/2))  ; параметры малого окна


SetWindowTitle(#Window_0, "ширина: "+Str(WindowWidth(#Window_0))+"     высота: "+Str(WindowHeight(#Window_0))) ; изменяем заголовок 

ResizeGadget(#x, #PB_Ignore,WindowHeight(#Window_0)/2, #PB_Ignore, #PB_Ignore)
ResizeGadget(#y, WindowWidth(#Window_0)/2,#PB_Ignore, #PB_Ignore, #PB_Ignore)


ResizeGadget(#x1,#PB_Ignore,WindowHeight(#Window_0)-1,#PB_Ignore,#PB_Ignore)
ResizeGadget(#y1, WindowWidth(#Window_0)-1,#PB_Ignore, #PB_Ignore, #PB_Ignore)


SetWindowsTransparency(hWnd, 170)  ; полупрозрачное окно


If Event = #PB_Event_CloseWindow
Break   
EndIf
ForEver

Отредактировано mirashic (10.02.2010 22:08:53)

0

2

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

Можно каким то образом сделать окно полностью прозрачное, а линии нет?

Можно вот так попробовать

Код:
Enumeration 
 #Window_0
 #x
 #y
 #wid
 #y0
 #y1
 #x0
 #x1
EndEnumeration

; ///////////////////////Гаджет линия/////////////////////////////////
Procedure LineGadgetHeight(Gadget, x, y, Height, color)
Im=CreateImage(#PB_Any, 1, Height)
If Im
 If StartDrawing(ImageOutput(Im))
    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,1 ,color)       
  StopDrawing()
  ImageGadget(Gadget,x, y, Width,1,ImageID(Im))
 EndIf
EndIf
EndProcedure
; //////////////////////////////////////////////////////////////////////

hWnd = OpenWindow (#Window_0, 0, 0, 700, 200, "Линейка", #PB_Window_ScreenCentered|#PB_Window_BorderLess ) 
;StickyWindow(#Window_0, 1)
SetWindowColor(#Window_0,$000000)
;SmartWindowRefresh(#Window_0 ,1)  ; для уменьшения мигания окна при изменении размера

  
    TextGadget(#wid, 0, 0,  50, 14, "")  ;  текст малого окна
    SetGadgetColor(#wid, #PB_Gadget_BackColor,  $000000)
    SetGadgetColor(#wid, #PB_Gadget_FrontColor, $ffffff)

  LineGadgetWidth(#x0,0,0 ,  1680, $0000FF)                          ; горизонтальная  линия первая
  LineGadgetWidth(#x, 0, WindowHeight(#Window_0)/2, 1680, $0000FF)   ; горизонтальная линия средняя
  LineGadgetWidth(#x1, 0, 199, 1680, $0000FF)  ; горизонтальная линия последняя

  LineGadgetHeight(#y0, 0,0 ,  1050, $0000FF)                        ; вертикальная  линия первая
  LineGadgetHeight(#y, WindowWidth(#Window_0)/2,0 ,  1050, $0000FF)  ; вертикальная  линия средняя
  LineGadgetHeight(#y1, 699,0 ,  1050, $0000FF)                      ; вертикальная  линия последняя

     SetWindowPos_(WindowID(#Window_0),#HWND_TOPMOST,0,0,0,0,#SWP_NOSIZE | #SWP_NOMOVE) 
     SetWindowLong_(WindowID(#Window_0),#GWL_EXSTYLE,GetWindowLong_(WindowID(#Window_0),#GWL_EXSTYLE)|$00080000) 
     SetLayeredWindowAttributes_(WindowID(#Window_0),0,0,1) 
     SetWindowLong_(WindowID(#Window_0),#GWL_HWNDPARENT,GetDesktopWindow_() )
Repeat
Event =  WaitWindowEvent() 

; SetGadgetText(#wid,  Str(WindowWidth(#Window_0)/2)+" x "+Str(WindowHeight(#Window_0)/2))  ; параметры малого окна
; 
; 
; SetWindowTitle(#Window_0, "ширина: "+Str(WindowWidth(#Window_0))+"     высота: "+Str(WindowHeight(#Window_0))) ; изменяем заголовок 
; 
; ResizeGadget(#x, #PB_Ignore,WindowHeight(#Window_0)/2, #PB_Ignore, #PB_Ignore)
; ResizeGadget(#y, WindowWidth(#Window_0)/2,#PB_Ignore, #PB_Ignore, #PB_Ignore)
; 
; 
; ResizeGadget(#x1,#PB_Ignore,WindowHeight(#Window_0)-1,#PB_Ignore,#PB_Ignore)
; ResizeGadget(#y1, WindowWidth(#Window_0)-1,#PB_Ignore, #PB_Ignore, #PB_Ignore)
; 
; 
; SetWindowsTransparency(hWnd, 170)  ; полупрозрачное окно

   If Event = #WM_LBUTTONDOWN
      SendMessage_(WindowID(#Window_0), #WM_NCLBUTTONDOWN, #HTCAPTION, 0) ; Это перетасиквание окна
   EndIf


If Event = #PB_Event_CloseWindow
Break   
EndIf
ForEver

0

3

Упорно не перетаскивается и не изменяет размер ?

0

4

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

Упорно не перетаскивается и не изменяет размер ?

Я что ты хотел?
Окна-то по сути нет! Есть только линии.

0

5

В том то и дело, что в оригинальной програмее окно перетаскивается и можно менять размер.
http://www.mirashic.narod.ru/Atrise.png

Отредактировано mirashic (10.02.2010 23:31:52)

0

6

Нашел в CodeArchiv пример растягивания окна без рамки, на его основе пробую сделать
программу. Получается, правда не все моменты в коде до конца понимаю.
Программа работает, но не устойчиво, если быстро менять размер окна - зависает. ?
Для версии 4.30

Код:
#Window_0 = 1 
#True  = 1 
#False = 0 
#Tex  = 2
Global hwnd.l 

;Procedure SetWinOpacity (hWin.l, Opacity.l)       
  ;SetWindowLong_(hWin, #GWL_EXSTYLE, $00080000)   
  ;SetLayeredWindowAttributes_(hWin, 0, Opacity, 2) 
;EndProcedure
 
Procedure PaintWindowBackground() 
  ww.l = WindowWidth(#Window_0) 
  wh.l = WindowHeight(#Window_0) 

  hBmp.l    = CreateImage(0, ww, wh) 

  hDC = StartDrawing( ImageOutput(0) )             
    Box( 0, 0, ww, wh, RGB(170, 170, 170))
    Box( 0, 20, ww, wh-20, RGB(255, 0, 0))
    Box( 1, 20, ww-2, wh-21, $fffffff ) 
    FillRgn_( hDC, hRgn1, hBrush1 ) 
    Line( ww-15,  5, 10, 10, RGB(255, 0, 0)) 
    Line( ww-15, 14, 10,-10, RGB(255, 0, 0)) 
    
   
    Line( ww-7, wh-2, 6,-6, RGB(255, 0, 0)) 
    Line( ww-6, wh-2, 5,-5, RGB(255, 0, 0))
    Line( ww-5, wh-2, 4,-4, RGB(255, 0, 0))
    Line( ww-4, wh-2, 3,-3, RGB(255, 0, 0))
    Line( ww-3, wh-2, 2,-2, RGB(255, 0, 0))
    Line( ww-2, wh-2, 1,-1, RGB(255, 0, 0))
    
    Line( 0, 19, ww,  0, $0000FF)
    Line( ww/2, 19, 0,  wh, $0000FF)
    Line( 0, wh/2+9, ww,  0, $0000FF)
  
  StopDrawing() 

  hBrush2.l = CreatePatternBrush_(hBmp)            
  SetClassLong_(hwnd, #GCL_HBRBACKGROUND, hBrush2) 
  InvalidateRect_(hwnd, #Null, #True)              

  ;SetWindowRgn_(hwnd, hRgn2, #True)                

  ;DeleteObject_( hBrush2 ) 
EndProcedure 

hwnd = OpenWindow(#Window_0, 0, 0, 400, 180, "линейка", #PB_Window_BorderLess|#PB_Window_ScreenCentered)
  StickyWindow(#Window_0, 1) ;  окно сверху
  TextGadget(#Tex, 5, 2, 60, 16, "400 x 180")
  SetGadgetColor(#Tex, #PB_Gadget_FrontColor, RGB(54, 54, 54))
  SetGadgetColor(#Tex, #PB_Gadget_BackColor,RGB(170, 170, 170))
  



;If hwnd <> 0 
  ;SetWinOpacity( hwnd, 0) 
  ResizeWindow(#Window_0,#PB_Ignore,#PB_Ignore,401, 200) 
  ww.l = 401 
  wh.l = 200 
  ;PaintWindowBackground() 
  ;For i=0 To 255 Step 10 
    ;SetWinOpacity( hwnd, i) : While WindowEvent() : Wend 
  ;Next 
  ;SetWinOpacity( hwnd, 255)
;ndIf  
  
  
    SetWindowLong_(WindowID(#Window_0),#GWL_EXSTYLE,GetWindowLong_(WindowID(#Window_0),#GWL_EXSTYLE)|$00080000) 
    SetLayeredWindowAttributes_(WindowID(#Window_0),0,0,1) 
   

Repeat 
  EventID.l = WaitWindowEvent() 
   
    mx.l = WindowMouseX(#Window_0) 
    my.l = WindowMouseY(#Window_0) 

SetGadgetText(#Tex, Str(WindowWidth(#Window_0)-1)+" x "+Str(WindowHeight(#Window_0)-20))

    Select EventID 
      Case #WM_PAINT 
        PaintWindowBackground() 
        While WindowEvent() : Wend 
      Case #WM_LBUTTONDBLCLK 
   
        ;If (mx > 30 And (mx < ww-30) And my > 0 And my < 30) 
          ;ShowWindow_(hwnd, #SW_MINIMIZE) 
        ;EndIf 

      Case #WM_LBUTTONDOWN
        ; перетаскивание 
        If WindowMouseX(#Window_0) >= 0 And WindowMouseX(#Window_0) <= ww-20 And WindowMouseY(#Window_0) >= 0 And WindowMouseY(#Window_0) <= 20 
          ReleaseCapture_() 
          SendMessage_(hwnd, #WM_NCLBUTTONDOWN, #HTCAPTION, NULL) 
        EndIf 
        
        ; закрыть 
        If ((mx > ww-20 And mx < ww-3) And (my > 3 And my < 15)) 
          EventID = #PB_Event_CloseWindow 
        EndIf 

        ; растягивать 
        If ((mx > ww-30 And mx < ww) And (my > wh-30 And my < wh)) 
          ReleaseCapture_() 
          SendMessage_(hwnd, #WM_NCLBUTTONDOWN, #HTBOTTOMRIGHT , NULL) 
        EndIf 
        
        ww.l = WindowWidth(#Window_0)  
        wh.l = WindowHeight(#Window_0) 
        
 
        ;If ww<90 
          ;ww=90 
        ;EndIf 
        ;If wh<60 
          ;wh=60 
        ;EndIf 
        ;ResizeWindow(#Window_0,#PB_Ignore,#PB_Ignore,ww, wh) 
    EndSelect 

  Until EventID = #PB_Event_CloseWindow 

End

Отредактировано mirashic (13.02.2010 11:10:02)

0

7

Что нибудь можно сделать, чтоб не зависала ?

0

8

Нужно освобождать ресурсы.
Вот в проге создаются кисти, hBrush2.l = CreatePatternBrush_(hBmp), но не освобождаются.
В этом и проблема.
Возникает она не из-за быстрого изменения размера, а из-за превышения лимита кистей для проги.
Просто если изменять размер медленно, то на это потребуется больше времени.

Код:
#Window_0 = 1 
#True  = 1 
#False = 0 
#Tex  = 2
Global hwnd.l 

;Procedure SetWinOpacity (hWin.l, Opacity.l)       
  ;SetWindowLong_(hWin, #GWL_EXSTYLE, $00080000)   
  ;SetLayeredWindowAttributes_(hWin, 0, Opacity, 2) 
;EndProcedure
 
Procedure PaintWindowBackground() 
Shared hBrush2Temp
  ww.l = WindowWidth(#Window_0) 
  wh.l = WindowHeight(#Window_0) 

  hBmp.l    = CreateImage(0, ww, wh) 

  hDC = StartDrawing( ImageOutput(0) )             
    Box( 0, 0, ww, wh, RGB(170, 170, 170))
    Box( 0, 20, ww, wh-20, RGB(255, 0, 0))
    Box( 1, 20, ww-2, wh-21, $fffffff ) 
    FillRgn_( hDC, hRgn1, hBrush1 ) 
    Line( ww-15,  5, 10, 10, RGB(255, 0, 0)) 
    Line( ww-15, 14, 10,-10, RGB(255, 0, 0)) 
    
   
    Line( ww-7, wh-2, 6,-6, RGB(255, 0, 0)) 
    Line( ww-6, wh-2, 5,-5, RGB(255, 0, 0))
    Line( ww-5, wh-2, 4,-4, RGB(255, 0, 0))
    Line( ww-4, wh-2, 3,-3, RGB(255, 0, 0))
    Line( ww-3, wh-2, 2,-2, RGB(255, 0, 0))
    Line( ww-2, wh-2, 1,-1, RGB(255, 0, 0))
    
    Line( 0, 19, ww,  0, $0000FF)
    Line( ww/2, 19, 0,  wh, $0000FF)
    Line( 0, wh/2+9, ww,  0, $0000FF)
  
  StopDrawing() 

  hBrush2.l = CreatePatternBrush_(hBmp)            
  SetClassLong_(hwnd, #GCL_HBRBACKGROUND, hBrush2) 
  ;InvalidateRect_(hwnd, #Null, #True)              

  SetWindowRgn_(hwnd, hRgn2, #True)                
  DeleteObject_( hBrush2Temp ) 
  hBrush2Temp=hBrush2
EndProcedure 

hwnd = OpenWindow(#Window_0, 0, 0, 400, 180, "линейка", #PB_Window_BorderLess|#PB_Window_ScreenCentered)
  StickyWindow(#Window_0, 1) ;  окно сверху
  TextGadget(#Tex, 5, 2, 60, 16, "400 x 180")
  SetGadgetColor(#Tex, #PB_Gadget_FrontColor, RGB(54, 54, 54))
  SetGadgetColor(#Tex, #PB_Gadget_BackColor,RGB(170, 170, 170))
  



;If hwnd <> 0 
  ;SetWinOpacity( hwnd, 0) 
  ResizeWindow(#Window_0,#PB_Ignore,#PB_Ignore,401, 200) 
  ww.l = 401 
  wh.l = 200 
  ;PaintWindowBackground() 
  ;For i=0 To 255 Step 10 
    ;SetWinOpacity( hwnd, i) : While WindowEvent() : Wend 
  ;Next 
  ;SetWinOpacity( hwnd, 255)
;ndIf  
  
  
    SetWindowLong_(WindowID(#Window_0),#GWL_EXSTYLE,GetWindowLong_(WindowID(#Window_0),#GWL_EXSTYLE)|$00080000) 
    SetLayeredWindowAttributes_(WindowID(#Window_0),0,0,1) 
   

Repeat 
  EventID.l = WaitWindowEvent() 
   
    mx.l = WindowMouseX(#Window_0) 
    my.l = WindowMouseY(#Window_0) 

SetGadgetText(#Tex, Str(WindowWidth(#Window_0)-1)+" x "+Str(WindowHeight(#Window_0)-20))

    Select EventID 
      Case #WM_PAINT 
        PaintWindowBackground() 
        While WindowEvent() : Wend 
      Case #WM_LBUTTONDBLCLK 
   
        ;If (mx > 30 And (mx < ww-30) And my > 0 And my < 30) 
          ;ShowWindow_(hwnd, #SW_MINIMIZE) 
        ;EndIf 

      Case #WM_LBUTTONDOWN
        ; перетаскивание 
        If WindowMouseX(#Window_0) >= 0 And WindowMouseX(#Window_0) <= ww-20 And WindowMouseY(#Window_0) >= 0 And WindowMouseY(#Window_0) <= 20 
          ReleaseCapture_() 
          SendMessage_(hwnd, #WM_NCLBUTTONDOWN, #HTCAPTION, NULL) 
        EndIf 
        
        ; закрыть 
        If ((mx > ww-20 And mx < ww-3) And (my > 3 And my < 15)) 
          EventID = #PB_Event_CloseWindow 
        EndIf 

        ; растягивать 
        If ((mx > ww-30 And mx < ww) And (my > wh-30 And my < wh)) 
          ReleaseCapture_() 
          SendMessage_(hwnd, #WM_NCLBUTTONDOWN, #HTBOTTOMRIGHT , NULL) 
        EndIf 
        
        ww.l = WindowWidth(#Window_0)  
        wh.l = WindowHeight(#Window_0) 
        
 
        ;If ww<90 
          ;ww=90 
        ;EndIf 
        ;If wh<60 
          ;wh=60 
        ;EndIf 
        ;ResizeWindow(#Window_0,#PB_Ignore,#PB_Ignore,ww, wh) 
    EndSelect 

  Until EventID = #PB_Event_CloseWindow 

End

0

9

Спасибо !

0

10

Сегодня воспользовался твоим творением. Очень помогло. Скажу сразу чего мне не хватало:

1) не меняется цвет самой линейки

2) размеры между серединой и краями

0

11

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

размеры между серединой и краями

http://www.mirashic.narod.ru/line.htm  - есть

Если красным по красному фону - то не видно, надо добавить другие цвета.

Отредактировано mirashic (16.03.2010 21:51:39)

0

12

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

http://www.mirashic.narod.ru/line.htm  - есть

Да действительно, уже скачал.

0

13

Хотел применить инструмент, но почему то на семерке не отображается правильно, все линии расплываются  :( .

0


Вы здесь » PureBasic - форум » Вопросы по PureBasic » Электронная линейка