PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

New Rulergadget test Beta

https://www.purebasic.fr/english/viewtopic.php?t=14015

Page 1 of 1

New Rulergadget test Beta

Posted: Thu Feb 17, 2005 8:39 pm
by localmotion34
here is a worked up version of my Rulergadget lib with all the procedures and code. Its not the best commented yet, but give it a try. All you have to do is click over the horizontal ruler, and a line object will be drawn like any other ruler canvas. see if you can find some bugs, or make some suggestions.

Code: Select all

#pb_rulerH=$33333333
#pb_rulerV=$33333334
#Pb_rulerL=$33333335
Global VT.TB_GadgetVT,rect.RECT,rect1.RECT,MouseBtnDown
Global MouseBtnDown   , hMouseBtnDown 
Global MouseBtnDownX  , MouseBtnDownY 
Global MouseMoveCursor,cursor.POINT,image.RECT 
Global MoveMode
Structure info
  xloc.l
  yloc.l
  orient.l
  number.l
EndStructure

#pb_rulerH=$33333333
#pb_rulerV=$33333334
#Pb_rulerL=$33333335
ProcedureDLL initruler()
  NewList rulerlines.info()
  Dim overcursor(2)
  Dim addelmt(2)
  Dim currentline.l(2)
  Dim justmoving(2)
  Dim temp.l(2)
  Dim godraw(2)
  justmoving(0)=#True
  overcursor(0)=#False
  addelmt(0)=#True 
EndProcedure 

Procedure WndProc(hwnd, uMsg, wParam, lParam)
  mainparent=GetParent_(hwnd)
  Result = 0
  Select uMsg
    Case #WM_LBUTTONDOWN
      If godraw(0)=#True And overcursor(0)=#True
        justmoving(0)=#False ; no longer moving around the cursor, we want to draw a line
        MouseBtnDownX = lParam&$FFFF 
        MouseBtnDownY = (lParam>>16)&$FFFF+21
        MouseBtnDown  = #True 
        hMouseBtnDown = hwnd 
        GetwindowRect_(hwnd,@rect) 
        GetwindowRect_(mainparent,@rect1)
        addelmt(0)=#False ; over a cursor, dont want to add a new line element 
        StartDrawing(WindowOutput())
        DrawingMode(2)
        LineXY(rect\left-rect1\left,MouseBtnDownY,rect\right,MouseBtnDownY)
        SelectElement(rulerlines(),currentline(0))
        StopDrawing()
        StartDrawing(WindowOutput()) 
        DrawingMode(2) 
        LineXY(rect\left-rect1\left,MouseBtnDownY,rect\right,MouseBtnDownY) 
        StopDrawing() 
        GetClientRect_(hwnd,@ClipRect.RECT) 
      ElseIf godraw(0)=#True And overcursor(0)=#False
        justmoving(0)=#False ; no longer moving around the cursor, we want to draw a line
        MouseBtnDownX = lParam&$FFFF 
        MouseBtnDownY = (lParam>>16)&$FFFF+21
        GetwindowRect_(hwnd,@rect) 
        GetwindowRect_(mainparent,@rect1)
        addelmt(0)=#True ; Now we want to add a new line element 
        StartDrawing(WindowOutput())
        DrawingMode(2)
        LineXY(rect\left-rect1\left,MouseBtnDownY,rect\right,MouseBtnDownY)
        StopDrawing()
      EndIf 
      ProcedureReturn 0 
      
    Case #WM_SIZE
      
    Case #WM_MOUSEMOVE
      y=WindowMouseY()
      If justmoving(0)=#True
        ForEach rulerlines()
          If rulerlines()\yloc=y
            cur=LoadCursor_(#Null,#IDC_SIZENS)
            SetCursor_(cur)
            overcursor(0)=#True 
            currentline(0)=rulerlines()\number
            SelectElement(rulerlines(),ListIndex(rulerlines()))
            godraw(0)=#True
            SetCapture_(hwnd)
            Break 
          Else
            cur=LoadCursor_(#Null,#IDC_ARROW	)
            SetCursor_(cur)
            overcursor(0)=#False 
            godraw(0)=#False 
            ReleaseCapture_()
          EndIf 
        Next 
      ElseIf justmoving(0)=#False  
        MouseOffsetX.w = lParam&$FFFF       - MouseBtnDownX 
        MouseOffsetY.w = (lParam>>16)&$FFFF - MouseBtnDownY +21
        StartDrawing(WindowOutput()) 
        DrawingMode(2) 
        LineXY(rect\left-rect1\left,MouseBtnDownY,rect\right,MouseBtnDownY) 
        StopDrawing() 
        MouseBtnDownX + MouseOffsetX 
        MouseBtnDownY + MouseOffsetY 
        StartDrawing(WindowOutput()) 
        DrawingMode(2) 
        LineXY(rect\left-rect1\left,MouseBtnDownY,rect\right,MouseBtnDownY) 
        StopDrawing()  
      EndIf 
      ProcedureReturn 0 
    Case #WM_PARENTNOTIFY
      buttonmessage=wParam& $FFFF 
      If buttonmessage=#WM_LBUTTONDOWN
        godraw(0)=#True
        overcursor(0)=#False 
        SendMessage_(hwnd,#WM_LBUTTONDOWN,0,0)
      ElseIf buttonmessage=#WM_LBUTTONUP
        SendMessage_(hwnd,#WM_LBUTTONUP,0,0)
      EndIf 
    Case #WM_LBUTTONUP
      GetCursorPos_(@cursor.POINT)
      GetwindowRect_(GadgetID(temp(0)),@image.RECT)
      If cursor\y< image\bottom And overcursor(0)=#True 
        DeleteElement(rulerlines())
        StartDrawing(WindowOutput())
        DrawingMode(2)
        LineXY(rect\left-rect1\left,MouseBtnDownY,rect\right,MouseBtnDownY)
        StopDrawing()
        addelmt(0)=#False 
        overcursor(0)=#False 
        ReleaseCapture_()
        justmoving(0)=#True 
        godraw(0)=#False 
      EndIf  
        y=WindowMouseY()
        If addelmt(0)=#True And overcursor(0)=#False
          LastElement(rulerlines())
          AddElement(rulerlines())  
          rulerlines()\yloc = y
          rulerlines()\number=ListIndex(rulerlines())
          justmoving(0)=#True
          RedrawWindow_(hwnd,0,0,#RDW_ALLCHILDREN	)
          ShowWindow_(hwnd,#SW_SHOWNORMAL)
          UpdateWindow_(hwnd)
          ReleaseCapture_()
        ElseIf addelmt(0)=#False And overcursor(0)=#True 
          rulerlines()\yloc = y
          justmoving(0)=#True
          RedrawWindow_(hwnd,0,0,#RDW_ALLCHILDREN	)
          ShowWindow_(hwnd,#SW_SHOWNORMAL)
          UpdateWindow_(hwnd)
          godraw(0)=#False
          overcursor(0)=#False 
          ReleaseCapture_()
          
        EndIf 
        ProcedureReturn 0
      ReleaseCapture_()
    Case #WM_MOUSEACTIVATE
      RedrawWindow_(hwnd,0,0,#RDW_ALLCHILDREN	)
      ShowWindow_(hwnd,#SW_SHOWNORMAL)
      UpdateWindow_(hwnd)
      
    Case #WM_PAINT
      If CountList(rulerlines())>0
        StartDrawing(WindowOutput())
        DrawingMode(4)
        ForEach rulerlines()
          LineXY(rect\left-rect1\left,rulerlines()\yloc+1,rect\right,rulerlines()\yloc+1)
        Next  
        StopDrawing()
      EndIf 
      RedrawWindow_(hwnd,0,0,#RDW_ALLCHILDREN)
      ShowWindow_(hwnd,#SW_SHOWNORMAL)
      UpdateWindow_(hwnd)
      hdc=GetDC_(hwnd)
      SendMessage_(hwnd,#WM_ERASEBKGND,hdc,0)
      
    Case #WM_DESTROY
      
  EndSelect
  ReleaseCapture_()
  ProcedureReturn DefWindowProc_(hwnd, uMsg, wParam, lParam)
EndProcedure


ProcedureDLL rulergadget(number, x, y, Width, Height,flags)
  hInstance = GetModuleHandle_(0)
  wc.WNDCLASSEX
  wc\cbSize = SizeOf(WNDCLASSEX)
  wc\style = #CS_DBLCLKS
  wc\lpfnWndProc = @WndProc()
  wc\hInstance = hInstance
  wc\lpszClassName = @"rulergadget"
  If RegisterClassEx_(@wc)=0:ProcedureReturn 0:EndIf
  hwnd = CreateWindowEx_(#Null, "Rulergadget", "", #WS_CHILD|#WS_CLIPSIBLINGS|#WS_VISIBLE, x, y, Width, Height, TB_UsedWindow(), number, hInstance, 0)
  If hwnd=0:ProcedureReturn 0:EndIf
  CreateGadgetList(hwnd)
  If flags=#Pb_rulerL
    LoadFont(2, "test", 7) 
    ruler=CreateImage(#PB_Any,Width,33)
    StartDrawing(ImageOutput())
    Box(0,0,Width,33,#White)
    DrawingMode(4)
    Box(0,0,Width,33,0)
    For c=b+10 To c=b+90 Step 10
      LineXY(c,0,c,6,0)
      LineXY(c,33,c,27,0)
    Next 
    For a=100 To Width Step 100
      LineXY(a,0,a,10,0)
      Locate(a-7,11)
      DrawingFont(FontID())
      DrawText(Str(a))
      LineXY(a,33,a,23,0)
      b=a
      For c=b+10 To c=b+90 Step 10
        LineXY(c,0,c,6,0)
        LineXY(c,33,c,27,0)
      Next 
    Next 
    StopDrawing()
    temp(0)=ImageGadget(#PB_Any,33,0,Width,33,UseImage(ruler))
    ruler1=CreateImage(#PB_Any,33,Width)
    StartDrawing(ImageOutput())
    Box(0,0,33,Width,#White)
    DrawingMode(4)
    Box(0,0,33,Width,0)
    For a=100 To Width Step 100
      LineXY(0,a,7,a)
      Locate(11,a-4)
      DrawingFont(FontID())
      DrawText(Str(a))
      LineXY(33,a,27,a)
      For c=0 To 90 Step 10
        LineXY(0,c,6,c)
        LineXY(33,c,27,c)
      Next 
      b=a
      For c=b+10 To c=b+90 Step 10
        LineXY(0,c,6,c)
        LineXY(33,c,27,c)
      Next 
    Next 
    StopDrawing()
    temp(1)=ImageGadget(#PB_Any,0,33,33,Width,UseImage(ruler1))
    toggleb=ButtonGadget(#PB_Any,0,0,33,33,"",#PB_Button_Toggle) 
  ElseIf flags=#pb_rulerH
    LoadFont(2, "test", 7) 
    ruler=CreateImage(#PB_Any,Width,33)
    StartDrawing(ImageOutput())
    Box(0,0,Width,33,#White)
    DrawingMode(4)
    Box(0,0,Width,33,0)
    For c=b+10 To c=b+90 Step 10
      LineXY(c,0,c,6,0)
      LineXY(c,33,c,27,0)
    Next 
    For a=100 To Width Step 100
      LineXY(a,0,a,10,0)
      Locate(a-7,11)
      DrawingFont(FontID())
      DrawText(Str(a))
      LineXY(a,33,a,23,0)
      b=a
      For c=b+10 To c=b+90 Step 10
        LineXY(c,0,c,6,0)
        LineXY(c,33,c,27,0)
      Next 
    Next 
    StopDrawing()
    temp=ImageGadget(#PB_Any,0,0,Width,33,UseImage(ruler))
  ElseIf flags=#pb_rulerV
    LoadFont(2, "test", 7)
    ruler1=CreateImage(#PB_Any,33,Width)
    StartDrawing(ImageOutput())
    Box(0,0,33,Width,#White)
    DrawingMode(4)
    Box(0,0,33,Width,0)
    For a=100 To Width Step 100
      LineXY(0,a,7,a)
      Locate(11,a-4)
      DrawingFont(FontID())
      DrawText(Str(a))
      LineXY(33,a,27,a)
      For c=0 To 90 Step 10
        LineXY(0,c,6,c)
        LineXY(33,c,27,c)
      Next 
      b=a
      For c=b+10 To c=b+90 Step 10
        LineXY(0,c,6,c)
        LineXY(33,c,27,c)
      Next 
    Next 
    StopDrawing()
    temp1=ImageGadget(#PB_Any,0,0,33,Width,UseImage(ruler1))
  EndIf 
  ShowWindow_(hwnd, #SW_SHOWNORMAL)
  UpdateWindow_(hwnd)
  ;VT\FreeGadget = @MyFreeGadget()
  ;VT\GetGadgetState = @MyGetGadgetState()
  ;VT\SetGadgetState = @MySetGadgetState()
  TB_SetGadget(number, hwnd, @VT)
  ProcedureReturn hwnd
EndProcedure
initruler()

If OpenWindow(0,0,0,645,605,#PB_Window_SystemMenu|#PB_Window_ScreenCentered,"RulerGadget") And CreateGadgetList(WindowID(0)) 
  test=rulergadget(0,60,20,550,550,#Pb_rulerL)
  
EndIf 
Repeat 
  Event=WaitWindowEvent()
  Select Event
    Case #PB_EventGadget
      Select EventGadgetID()
        
      EndSelect
    Case #PB_EventCloseWindow
      End 
  EndSelect 
Until Event=#PB_EventCloseWindow

Posted: Thu Feb 17, 2005 9:21 pm
by TerryHough
????

I get just a blink and then it is gone...

Edited later:
Installed Vs. 3.93 Beta 2.

Now it shows a stack fault message.

Posted: Thu Feb 17, 2005 10:35 pm
by Paul
On Win2K...

-Lines blinking
-Sometimes 2 lines added then only one can be moved
-Sometimes 1 line is brought down and suddenly many (4 or 5) appear and each one can be moved
-Often white lines are left after black line is moved
-Sometimes cursor changes to "move arrow" when line is not even close to cursor
-Sometimes window gets stuck and cannot be repositioned or can move for a bit then eventually jumps back to original location


These problems happen on both PB3.92 and latest beta
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited