PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Trackbar selber Zeichnen

https://www.purebasic.fr/german/viewtopic.php?t=5938

Seite 1 von 1

Trackbar selber Zeichnen

Verfasst: 07.12.2005 20:34
von roherter
Hi,Ich möchte gerne eine Trackbar selbst erstellen,was ist hier der beste lösungsansatz das über imagegadgets zu lösen oder sie über ownerdraw selbst erstellen!

Kennt jemand ein beispiel zum selberzeichnen mit ownerdraw?

Verfasst: 07.12.2005 20:36
von edel
Weder noch , ich wuerde einfach nen neues Control nehmen und ueber wm_paint malen .

Verfasst: 07.12.2005 20:40
von roherter
Jo, hast du vileicht ein kleines beispiel zum anschauen für mich,ich habe zwar den Petzold hier liegen aber ich steige da so auf anhieb nicht hinter?

Verfasst: 07.12.2005 20:42
von edel

Code: Alles auswählen

  ;#########################################################
  
  Procedure GadgetListHandle()
    !EXTRN _PB_Gadget_CurrentObject
    !MOV Eax, [_PB_Gadget_CurrentObject]
    ProcedureReturn
    CreateGadgetList(0)
  EndProcedure 
   
  ;#########################################################

  Procedure MAKELONG(low,high)
    ProcedureReturn low | (high<<16)
  EndProcedure 
  
  ;#########################################################
  
  Procedure _PTINRECT(*rc.RECT,x,y) 
    If x <= *rc\right And x => *rc\left 
      If y <= *rc\bottom And y => *rc\top 
        ProcedureReturn #True
      EndIf
    EndIf 
    ProcedureReturn #False
  EndProcedure
  
  ;#########################################################
  
  Procedure _GET_X_LPARAM(lParam)
    ProcedureReturn lParam & $FFFF
  EndProcedure
  
  ;#########################################################  
  
  Procedure _GET_Y_LPARAM(lParam)
    ProcedureReturn (lParam>>16) & $FFFF
  EndProcedure 
  
  ;#########################################################
  
  Structure CData
    Value.l
    Min.f
    Max.f
    rect.RECT
  EndStructure
  
  Enumeration #WM_USER
    #WM_QSPIN_UP        ; wParam = 0,lParam = count
    #WM_QSPIN_DOWN      ; wParam = 0,lParam = count
    #WM_QSPIN_GETVALUE  ; wParam = 0,lParam = 0
    #WM_QSPIN_SETVALUE  ; wParam = 0,lParam = value
    #WM_QSPIN_SETMIN    ; wParam = 0,lParam = value
    #WM_QSPIN_SETMAX    ; wParam = 0,lParam = value
  EndEnumeration
  
  ;#########################################################
  
  Procedure GradientFill_(hdc,pVertex,dwNumVertex,pMesh,dwNumMesh,dwMode)
    Static GDI_Lib
    Static GdiGradientFill
    
    If GDI_Lib = 0
      GDI_Lib = OpenLibrary(#PB_Any,"gdi32.dll")
      GdiGradientFill = IsFunction(GDI_Lib,"GdiGradientFill")
    EndIf 
    
    ProcedureReturn CallFunctionFast(GdiGradientFill,hdc,pVertex,dwNumVertex,pMesh,dwNumMesh,dwMode)
  EndProcedure
  
  #GRADIENT_FILL_RECT_H = 0
  #GRADIENT_FILL_RECT_V = 1
  
  Structure GRADIENT_RECT
    UpperLeft.l
    LowerRight.l
  EndStructure
  
   Structure TRIVERTEX
    x.l
    y.l
    Red.w
    Green.w
    Blue.w
    Alpha.w
  EndStructure
  
  ;#########################################################
  
  Procedure CProc(hwnd,msg,wParam,lParam)
    
    Protected ps.PAINTSTRUCT
    Protected rc.RECT
    Protected x.l,y.l
    Protected *daten.CData
    Protected *cc.CREATESTRUCT
    Protected *temp.LONG
    Protected x2.f
    Protected Spektrum.l
    Protected hpen1.l,hpen2.l,hbrush.l
    Protected *vert.TRIVERTEX
    Protected gRect.GRADIENT_RECT
    
    Select msg
      Case #WM_QSPIN_SETMAX
        *daten = GetProp_(hwnd,"PROP_DATA")
        
        If lParam > *daten\Min
          *daten\Max = lParam
          
          If *daten\Value > lParam
            *daten\Value = lParam 
          EndIf 
          
          InvalidateRect_(hwnd,#Null,#True)
          
          ProcedureReturn #True
        EndIf 
        
        ProcedureReturn #False
        
      Case #WM_QSPIN_SETMIN
        *daten = GetProp_(hwnd,"PROP_DATA")
        
        If lParam < *daten\Max
          *daten\Min = lParam
          
          If *daten\Value < lParam
            *daten\Value = lParam
            
          EndIf 
          
          InvalidateRect_(hwnd,#Null,#True)
          
          ProcedureReturn #True
        EndIf 
        
        ProcedureReturn #False
        
      Case #WM_QSPIN_SETVALUE
        
        *daten = GetProp_(hwnd,"PROP_DATA")
        
        If (lParam <= *daten\Max) And (lParam >= *daten\Min)
          *daten\Value = lParam
          InvalidateRect_(hwnd,#Null,#True)
          ProcedureReturn #True
        EndIf 
        
        ProcedureReturn #False
        
      Case #WM_QSPIN_GETVALUE
        *daten = GetProp_(hwnd,"PROP_DATA")
        
        ProcedureReturn *daten\Value
        
      Case #WM_QSPIN_UP  
        *daten = GetProp_(hwnd,"PROP_DATA")
        
          If *daten\Value + lParam > *daten\Max
            *daten\Value = *daten\Max 
          Else
            *daten\Value + lParam
          EndIf  
          
          InvalidateRect_(hwnd,#Null,#True)
          
      Case #WM_QSPIN_DOWN
        *daten = GetProp_(hwnd,"PROP_DATA")
        
        If *daten\Value - lParam < *daten\Min
          *daten\Value = *daten\Min 
        Else
          *daten\Value - lParam
        EndIf  
        
        InvalidateRect_(hwnd,#Null,#True)
        
        
      Case #WM_CREATE
        
        *cc = lParam
        
        *temp = *cc\lpCreateParams
        
        SetProp_(hwnd,"PROP_DATA",*temp\l)
        
        
        ProcedureReturn #False
        
      Case #WM_DESTROY
        
        *daten = GetProp_(hwnd,"PROP_DATA")  
        FreeMemory(*daten) 
        RemoveProp_(hwnd,"PROP_DATA")
        DestroyWindow_(hwnd) 
        
        ProcedureReturn #False
        
      Case #WM_PAINT
        
        *daten = GetProp_(hwnd,"PROP_DATA") 
        
        Spektrum  = (Abs(*daten\Value - *daten\Min)/(*daten\Max   - *daten\Min)) * (*daten\rect\right - *daten\rect\left) 
        
        BeginPaint_(hwnd,ps)
        
        If Spektrum >= 0 And Spektrum <= *daten\rect\right 
                    
          hpen1  =  CreatePen_(#PS_SOLID,1,GetSysColor_(#COLOR_BTNSHADOW))
          hpen2  =  CreatePen_(#PS_SOLID,1,GetSysColor_(#COLOR_BTNHILIGHT))
           
          SelectObject_(ps\hdc,hpen2) 
          
          MoveToEx_(ps\hdc,0,0,0)
          LineTo_(ps\hdc,Spektrum,0) 
          MoveToEx_(ps\hdc,0,0,0)
          LineTo_(ps\hdc,0,*daten\rect\bottom)
          
          SelectObject_(ps\hdc,hpen1) 
          
          MoveToEx_(ps\hdc,Spektrum,0,0)
          LineTo_(ps\hdc,Spektrum,*daten\rect\bottom-1)
          
          MoveToEx_(ps\hdc,0,*daten\rect\bottom-*daten\rect\top-3,0)
          LineTo_(ps\hdc,Spektrum,*daten\rect\bottom-*daten\rect\top-3)
          
          DeleteObject_(hpen1)
          DeleteObject_(hpen2)
          
          ;{ Kann ausgeklammert werden !
          *vert = AllocateMemory(SizeOf(TRIVERTEX)*3)
          
          *vert\x      = 0
          *vert\y      = 0
          *vert\Red    = $F000
          *vert\Green  = $F000
          *vert\Blue   = $F000
          
          *vert + SizeOf(TRIVERTEX)
          
          *vert\x      = Spektrum 
          *vert\y      = *daten\rect\bottom-*daten\rect\top
          *vert\Red    = $8000
          *vert\Green  = $8000
          *vert\Blue   = $8000
          
          gRect\UpperLeft  = 0
          gRect\LowerRight = 1
          
          *vert - SizeOf(TRIVERTEX)
          
          If GradientFill_(ps\hdc,*vert,2,@gRect,1,#GRADIENT_FILL_RECT_V) = #False
            Debug GetLastError_()
          EndIf
          
          FreeMemory(*vert)
          
          ;}
          
        EndIf 
        
        EndPaint_(hwnd,ps)
        
        ProcedureReturn #False
        
      Case #WM_MOUSEMOVE
        
        
        If wParam & #MK_LBUTTON
          
          x = _GET_X_LPARAM(lParam)
          y = _GET_Y_LPARAM(lParam)
          
          *daten = GetProp_(hwnd,"PROP_DATA") 
            
          If _PTINRECT(*daten\rect,x,y)  
            x2 = (x - *daten\rect\left) / (*daten\rect\right - *daten\rect\left) * 100 
            *daten\Value = ((*daten\Max - *daten\Min) / 100) * x2 + *daten\Min  
            InvalidateRect_(hwnd,#Null,#True)
          EndIf  
        EndIf 
        
        ProcedureReturn #False
      Case #WM_LBUTTONDOWN
        
        x = _GET_X_LPARAM(lParam)
        y = _GET_Y_LPARAM(lParam)
        
        *daten = GetProp_(hwnd,"PROP_DATA")
        
        If _PTINRECT(*daten\rect,x,y) 
          x2 = (x - *daten\rect\left) / (*daten\rect\right - *daten\rect\left) * 100 
          *daten\Value = ((*daten\Max - *daten\Min) / 100) * x2 + *daten\Min   
          InvalidateRect_(hwnd,#Null,#True)
        EndIf  
        
        ProcedureReturn #False
        
      Case #WM_SIZE 
    EndSelect
    
    ProcedureReturn DefWindowProc_(hwnd,msg,wParam,lParam)
  EndProcedure
  
  ;#########################################################
  
  Procedure QSpinGadget(id,x,y,cx,cy,Min,Max,Value,flags)
    
    Protected isRegister.l
    Protected wndC.WNDCLASS
    Protected style.l
    Protected hInstance.l
    Protected *daten.CData
    Protected cc.CREATESTRUCT
    Protected rc.RECT
    
    hInstance = GetModuleHandle_(0)
    
    If isRegister = #False
       
      wndC\lpfnWndProc    = @CProc() 
      wndC\hInstance      = hInstance 
      wndC\hCursor        = LoadCursor_(0, #IDC_ARROW) 
      wndC\hbrBackground  = GetSysColorBrush_(#COLOR_BTNFACE)
      wndC\lpszClassName  = @"QSPIN"
      
      If RegisterClass_(wndC)
        isRegister = #True
      EndIf 
      
    EndIf  
    
    parent = GadgetListHandle()
    
    If parent <> 0
        
      *daten = AllocateMemory(SizeOf(CData)) 
       
      *daten\Min         = Min
      *daten\Max         = Max 
      *daten\Value       = Value
      *daten\rect\right  = cx - 1
      *daten\rect\bottom = cy 
      
      cc\lpCreateParams = *daten
       
      style = #WS_VISIBLE|#WS_CHILD
       
      hwnd  = CreateWindowEx_(#WS_EX_STATICEDGE,"QSPIN",0,style,x,y,cx+2,cy,parent,id,hInstance,@cc)  

    EndIf
    
    ProcedureReturn hwnd 
  EndProcedure

  ;##################################################################################################################
  ;#
  ;# Test
  
  
  *win.LONG = OpenWindow(#PB_Any,0,0,400,400,1|#WS_SYSMENU,"")
  CreateGadgetList(*win\l)
 
  spin = QSpinGadget(0,10,10,350,15,0,100,20,0)
  
  ButtonGadget(1,200,300,20,20,"-")
  ButtonGadget(2,220,300,20,20," ")
  ButtonGadget(3,240,300,20,20,"+")
  ButtonGadget(4,220,320,20,20,"10")
  ButtonGadget(5,200,320,20,20,"5")
  ButtonGadget(6,240,320,20,20,"50")
  
  Repeat
    event = WaitWindowEvent()
    
    If event = #PB_Event_Gadget
        
      Select EventGadgetID() 
        Case 1 :  SendMessage_(spin,#WM_QSPIN_DOWN,0,1) 
        Case 3 :  SendMessage_(spin,#WM_QSPIN_UP,0,1) 
        Case 2 :  SetWindowTitle(*win,Str(SendMessage_(spin,#WM_QSPIN_GETVALUE,0,0)))
        Case 4 :  SendMessage_(spin,#WM_QSPIN_SETMAX,0,10) 
        Case 5 :  SendMessage_(spin,#WM_QSPIN_SETMIN,0,5) 
        Case 6 :  SendMessage_(spin,#WM_QSPIN_SETMAX,0,50)
      EndSelect
      
    EndIf 
    
  Until event = #WM_CLOSE
 
  End

Verfasst: 07.12.2005 21:40
von roherter
Danke dir ich werde es mal durcharbeiten!

Verfasst: 07.12.2005 21:46
von ts-soft
@hallodri
Bild
Muß nur noch der Cursor ausgetauscht werden. Klasse

Verfasst: 20.12.2005 23:01
von Hroudtwolf
Muß nur noch der Cursor ausgetauscht werden. Klasse
An dieser Stelle ....

Code: Alles auswählen

     wndC\lpfnWndProc    = @CProc()
      wndC\hInstance      = hInstance
-----------------------------------------------------------------------------------
\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
      wndC\hCursor        = LoadCursor_(0, #IDC_ARROW)
/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
------------------------------------------------------------------------------------
      wndC\hbrBackground  = GetSysColorBrush_(#COLOR_BTNFACE)
      wndC\lpszClassName  = @"QSPIN"
....den Code gegen zum Beispiel ....

Code: Alles auswählen

     wndC\lpfnWndProc    = @CProc()
      wndC\hInstance      = hInstance
-----------------------------------------------------------------------------------
\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
      wndC\hCursor        = LoadCursor_(0, #IDC_CROSS)
/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
------------------------------------------------------------------------------------
      wndC\hbrBackground  = GetSysColorBrush_(#COLOR_BTNFACE)
      wndC\lpszClassName  = @"QSPIN"
....austauschen.

Verfasst: 21.12.2005 00:06
von edel
Denke nicht das ts-soft das so gemeint hat. Beim einfachen Klick kein
Wechsel und beim ziehen nen Sizecursor oder so . Beispiel folgt :

Viel interessanter waere ein "Infoblase" (komm nicht auf den Namen) mit der Position .

Code: Alles auswählen


  ;#########################################################
 
Procedure GadgetListHandle()
  !EXTRN _PB_Gadget_CurrentObject
  !MOV Eax, [_PB_Gadget_CurrentObject]
  ProcedureReturn
  CreateGadgetList(0)
EndProcedure
   
  ;#########################################################

Procedure MAKELONG(low,high)
  ProcedureReturn low | (high<<16)
EndProcedure
 
  ;#########################################################
 
Procedure _PTINRECT(*rc.RECT,x,y)
  If x <= *rc\right And x => *rc\left
    If y <= *rc\bottom And y => *rc\top
      ProcedureReturn #True
    EndIf
  EndIf
  ProcedureReturn #False
EndProcedure
 
  ;#########################################################
 
Procedure _GET_X_LPARAM(lParam)
  ProcedureReturn lParam & $FFFF
EndProcedure
 
  ;######################################################### 
 
Procedure _GET_Y_LPARAM(lParam)
  ProcedureReturn (lParam>>16) & $FFFF
EndProcedure
 
  ;#########################################################
 
Structure CData
  Value.l
  Min.f
  Max.f
  rect.RECT
EndStructure
 
Enumeration #WM_USER
  #WM_QSPIN_UP        ; wParam = 0,lParam = count
  #WM_QSPIN_DOWN      ; wParam = 0,lParam = count
  #WM_QSPIN_GETVALUE  ; wParam = 0,lParam = 0
  #WM_QSPIN_SETVALUE  ; wParam = 0,lParam = value
  #WM_QSPIN_SETMIN    ; wParam = 0,lParam = value
  #WM_QSPIN_SETMAX    ; wParam = 0,lParam = value
EndEnumeration
 
  ;#########################################################
 
Procedure GradientFill_(hdc,pVertex,dwNumVertex,pMesh,dwNumMesh,dwMode)
  Static GDI_Lib
  Static GdiGradientFill
  
  If GDI_Lib = 0
    GDI_Lib = OpenLibrary(#PB_Any,"gdi32.dll")
    GdiGradientFill = IsFunction(GDI_Lib,"GdiGradientFill")
  EndIf
  
  ProcedureReturn CallFunctionFast(GdiGradientFill,hdc,pVertex,dwNumVertex,pMesh,dwNumMesh,dwMode)
EndProcedure
 
#GRADIENT_FILL_RECT_H = 0
#GRADIENT_FILL_RECT_V = 1
 
Structure GRADIENT_RECT
  UpperLeft.l
  LowerRight.l
EndStructure
 
Structure TRIVERTEX
  x.l
  y.l
  Red.w
  Green.w
  Blue.w
  Alpha.w
EndStructure
 
  ;#########################################################
 
Procedure CProc(hwnd,msg,wParam,lParam)
  
  Protected ps.PAINTSTRUCT
  Protected rc.RECT
  Protected x.l,y.l
  Protected *daten.CData
  Protected *cc.CREATESTRUCT
  Protected *temp.LONG
  Protected x2.f
  Protected Spektrum.l
  Protected hpen1.l,hpen2.l,hbrush.l
  Protected *vert.TRIVERTEX
  Protected gRect.GRADIENT_RECT
  
  Select msg
    Case #WM_QSPIN_SETMAX
      *daten = GetProp_(hwnd,"PROP_DATA")
      
      If lParam > *daten\Min
        *daten\Max = lParam
        
        If *daten\Value > lParam
          *daten\Value = lParam
        EndIf
        
        InvalidateRect_(hwnd,#Null,#True)
        
        ProcedureReturn #True
      EndIf
      
      ProcedureReturn #False
      
    Case #WM_QSPIN_SETMIN
      *daten = GetProp_(hwnd,"PROP_DATA")
      
      If lParam < *daten\Max
        *daten\Min = lParam
        
        If *daten\Value < lParam
          *daten\Value = lParam
          
        EndIf
        
        InvalidateRect_(hwnd,#Null,#True)
        
        ProcedureReturn #True
      EndIf
      
      ProcedureReturn #False
      
    Case #WM_QSPIN_SETVALUE
      
      *daten = GetProp_(hwnd,"PROP_DATA")
      
      If (lParam <= *daten\Max) And (lParam >= *daten\Min)
        *daten\Value = lParam
        InvalidateRect_(hwnd,#Null,#True)
        ProcedureReturn #True
      EndIf
      
      ProcedureReturn #False
      
    Case #WM_QSPIN_GETVALUE
      *daten = GetProp_(hwnd,"PROP_DATA")
      
      ProcedureReturn *daten\Value
      
    Case #WM_QSPIN_UP 
      *daten = GetProp_(hwnd,"PROP_DATA")
      
      If *daten\Value + lParam > *daten\Max
        *daten\Value = *daten\Max
      Else
        *daten\Value + lParam
      EndIf 
      
      InvalidateRect_(hwnd,#Null,#True)
      
    Case #WM_QSPIN_DOWN
      *daten = GetProp_(hwnd,"PROP_DATA")
      
      If *daten\Value - lParam < *daten\Min
        *daten\Value = *daten\Min
      Else
        *daten\Value - lParam
      EndIf 
      
      InvalidateRect_(hwnd,#Null,#True)
      
      
    Case #WM_CREATE
      
      *cc = lParam
      
      *temp = *cc\lpCreateParams
      
      SetProp_(hwnd,"PROP_DATA",*temp\l)
      
      
      ProcedureReturn #False
      
    Case #WM_DESTROY
      
      *daten = GetProp_(hwnd,"PROP_DATA") 
      FreeMemory(*daten)
      RemoveProp_(hwnd,"PROP_DATA")
      DestroyWindow_(hwnd)
      
      ProcedureReturn #False
      
    Case #WM_PAINT
      
      *daten = GetProp_(hwnd,"PROP_DATA")
      
      Spektrum  = (Abs(*daten\Value - *daten\Min)/(*daten\Max   - *daten\Min)) * (*daten\rect\right - *daten\rect\left)
      
      BeginPaint_(hwnd,ps)
      
      If Spektrum >= 0 And Spektrum <= *daten\rect\right
        
        hpen1  =  CreatePen_(#PS_SOLID,1,GetSysColor_(#COLOR_BTNSHADOW))
        hpen2  =  CreatePen_(#PS_SOLID,1,GetSysColor_(#COLOR_BTNHILIGHT))
        
        SelectObject_(ps\hdc,hpen2)
        
        MoveToEx_(ps\hdc,0,0,0)
        LineTo_(ps\hdc,Spektrum,0)
        MoveToEx_(ps\hdc,0,0,0)
        LineTo_(ps\hdc,0,*daten\rect\bottom)
        
        SelectObject_(ps\hdc,hpen1)
        
        MoveToEx_(ps\hdc,Spektrum,0,0)
        LineTo_(ps\hdc,Spektrum,*daten\rect\bottom-1)
        
        MoveToEx_(ps\hdc,0,*daten\rect\bottom-*daten\rect\top-3,0)
        LineTo_(ps\hdc,Spektrum,*daten\rect\bottom-*daten\rect\top-3)
        
        DeleteObject_(hpen1)
        DeleteObject_(hpen2)
        
        ;{ Kann ausgeklammert werden !
        *vert = AllocateMemory(SizeOf(TRIVERTEX)*3)
        
        *vert\x      = 0
        *vert\y      = 0
        *vert\Red    = $F000
        *vert\Green  = $F000
        *vert\Blue   = $F000
        
        *vert + SizeOf(TRIVERTEX)
        
        *vert\x      = Spektrum
        *vert\y      = *daten\rect\bottom-*daten\rect\top
        *vert\Red    = $8000
        *vert\Green  = $8000
        *vert\Blue   = $8000
        
        gRect\UpperLeft  = 0
        gRect\LowerRight = 1
        
        *vert - SizeOf(TRIVERTEX)
        
        If GradientFill_(ps\hdc,*vert,2,@gRect,1,#GRADIENT_FILL_RECT_V) = #False
          Debug GetLastError_()
        EndIf
        
        FreeMemory(*vert)
        
        ;}
        
      EndIf
      
      EndPaint_(hwnd,ps)
      
      ProcedureReturn #False
      
    Case #WM_MOUSEMOVE
      
      
      If wParam & #MK_LBUTTON
        
        x = _GET_X_LPARAM(lParam)
        y = _GET_Y_LPARAM(lParam)
        
        *daten = GetProp_(hwnd,"PROP_DATA")
        
        SetCursor_(LoadCursor_(0,#IDC_SIZEWE))
        
        If _PTINRECT(*daten\rect,x,y) 
          x2 = (x - *daten\rect\left) / (*daten\rect\right - *daten\rect\left) * 100
          *daten\Value = ((*daten\Max - *daten\Min) / 100) * x2 + *daten\Min 
          InvalidateRect_(hwnd,#Null,#True)
        EndIf 
      Else
        SetCursor_(LoadCursor_(0,#IDC_ARROW))
      EndIf
      
      ProcedureReturn #False
    Case #WM_LBUTTONDOWN
      
      x = _GET_X_LPARAM(lParam)
      y = _GET_Y_LPARAM(lParam)
      
      *daten = GetProp_(hwnd,"PROP_DATA")
      
      If _PTINRECT(*daten\rect,x,y)
        x2 = (x - *daten\rect\left) / (*daten\rect\right - *daten\rect\left) * 100
        *daten\Value = ((*daten\Max - *daten\Min) / 100) * x2 + *daten\Min   
        InvalidateRect_(hwnd,#Null,#True)
      EndIf 
      
      ProcedureReturn #False
      
    Case #WM_SIZE
  EndSelect
  
  ProcedureReturn DefWindowProc_(hwnd,msg,wParam,lParam)
EndProcedure
 
  ;#########################################################
 
Procedure QSpinGadget(id,x,y,cx,cy,Min,Max,Value,flags)
  
  Protected isRegister.l
  Protected wndC.WNDCLASS
  Protected style.l
  Protected hInstance.l
  Protected *daten.CData
  Protected cc.CREATESTRUCT
  Protected rc.RECT
  
  hInstance = GetModuleHandle_(0)
  
  If isRegister = #False
    
    wndC\lpfnWndProc    = @CProc()
    wndC\hInstance      = hInstance
    wndC\hCursor        = LoadCursor_(0, #IDC_ARROW)
    wndC\hbrBackground  = GetSysColorBrush_(#COLOR_BTNFACE)
    wndC\lpszClassName  = @"QSPIN"
    
    If RegisterClass_(wndC)
      isRegister = #True
    EndIf
    
  EndIf 
  
  parent = GadgetListHandle()
  
  If parent <> 0
    
    *daten = AllocateMemory(SizeOf(CData))
    
    *daten\Min         = Min
    *daten\Max         = Max
    *daten\Value       = Value
    *daten\rect\right  = cx - 1
    *daten\rect\bottom = cy
    
    cc\lpCreateParams = *daten
    
    style = #WS_VISIBLE|#WS_CHILD
    
    hwnd  = CreateWindowEx_(#WS_EX_STATICEDGE,"QSPIN",0,style,x,y,cx+2,cy,parent,id,hInstance,@cc) 
    
  EndIf
  
  ProcedureReturn hwnd
EndProcedure

  ;##################################################################################################################
  ;#
  ;# Test
 
 
*win.LONG = OpenWindow(#PB_Any,0,0,400,400,1|#WS_SYSMENU,"")
CreateGadgetList(*win\l)
 
spin = QSpinGadget(0,10,10,350,15,0,100,20,0)
 
ButtonGadget(1,200,300,20,20,"-")
ButtonGadget(2,220,300,20,20," ")
ButtonGadget(3,240,300,20,20,"+")
ButtonGadget(4,220,320,20,20,"10")
ButtonGadget(5,200,320,20,20,"5")
ButtonGadget(6,240,320,20,20,"50")
 
Repeat
  event = WaitWindowEvent()
  
  If event = #PB_Event_Gadget
    
    Select EventGadgetID()
      Case 1 :  SendMessage_(spin,#WM_QSPIN_DOWN,0,1)
      Case 3 :  SendMessage_(spin,#WM_QSPIN_UP,0,1)
      Case 2 :  SetWindowTitle(*win,Str(SendMessage_(spin,#WM_QSPIN_GETVALUE,0,0)))
      Case 4 :  SendMessage_(spin,#WM_QSPIN_SETMAX,0,10)
      Case 5 :  SendMessage_(spin,#WM_QSPIN_SETMIN,0,5)
      Case 6 :  SendMessage_(spin,#WM_QSPIN_SETMAX,0,50)
    EndSelect
    
  EndIf
  
Until event = #WM_CLOSE
 
End
pb 4.5 Beta

Code: Alles auswählen

  ;#########################################################

Procedure MAKELONG(low,high)
  ProcedureReturn low | (high<<16)
EndProcedure

  ;#########################################################

Procedure _PTINRECT(*rc.RECT,x,y)
  If x <= *rc\right And x => *rc\left
    If y <= *rc\bottom And y => *rc\top
      ProcedureReturn #True
    EndIf
  EndIf
  ProcedureReturn #False
EndProcedure

  ;#########################################################

Procedure _GET_X_LPARAM(lParam)
  ProcedureReturn lParam & $FFFF
EndProcedure

  ;#########################################################

Procedure _GET_Y_LPARAM(lParam)
  ProcedureReturn (lParam>>16) & $FFFF
EndProcedure

  ;#########################################################

Structure CData
  Value.l
  Min.f
  Max.f
  rect.RECT
EndStructure

Enumeration #WM_USER
  #WM_QSPIN_UP        ; wParam = 0,lParam = count
  #WM_QSPIN_DOWN      ; wParam = 0,lParam = count
  #WM_QSPIN_GETVALUE  ; wParam = 0,lParam = 0
  #WM_QSPIN_SETVALUE  ; wParam = 0,lParam = value
  #WM_QSPIN_SETMIN    ; wParam = 0,lParam = value
  #WM_QSPIN_SETMAX    ; wParam = 0,lParam = value
EndEnumeration

  ;#########################################################

Procedure GradientFill_(hdc,pVertex,dwNumVertex,pMesh,dwNumMesh,dwMode)
  Static GDI_Lib
  Static GdiGradientFill
 
  If GDI_Lib = 0
    GDI_Lib = OpenLibrary(#PB_Any,"gdi32.dll")
    GdiGradientFill = GetFunction(GDI_Lib,"GdiGradientFill")
  EndIf
 
  ProcedureReturn CallFunctionFast(GdiGradientFill,hdc,pVertex,dwNumVertex,pMesh,dwNumMesh,dwMode)
EndProcedure

#GRADIENT_FILL_RECT_H = 0
#GRADIENT_FILL_RECT_V = 1


  ;#########################################################

Procedure CProc(hwnd,msg,wParam,lParam)
 
  Protected ps.PAINTSTRUCT
  Protected rc.RECT
  Protected x.l,y.l
  Protected *daten.CData
  Protected *cc.CREATESTRUCT
  Protected *temp.LONG
  Protected x2.f
  Protected Spektrum.l
  Protected hpen1.l,hpen2.l,hbrush.l
  Protected *vert.TRIVERTEX
  Protected gRect.GRADIENT_RECT
 
  Select msg
    Case #WM_QSPIN_SETMAX
      *daten = GetProp_(hwnd,"PROP_DATA")
     
      If lParam > *daten\Min
        *daten\Max = lParam
       
        If *daten\Value > lParam
          *daten\Value = lParam
        EndIf
       
        InvalidateRect_(hwnd,#Null,#True)
       
        ProcedureReturn #True
      EndIf
     
      ProcedureReturn #False
     
    Case #WM_QSPIN_SETMIN
      *daten = GetProp_(hwnd,"PROP_DATA")
     
      If lParam < *daten\Max
        *daten\Min = lParam
       
        If *daten\Value < lParam
          *daten\Value = lParam
         
        EndIf
       
        InvalidateRect_(hwnd,#Null,#True)
       
        ProcedureReturn #True
      EndIf
     
      ProcedureReturn #False
     
    Case #WM_QSPIN_SETVALUE
     
      *daten = GetProp_(hwnd,"PROP_DATA")
     
      If (lParam <= *daten\Max) And (lParam >= *daten\Min)
        *daten\Value = lParam
        InvalidateRect_(hwnd,#Null,#True)
        ProcedureReturn #True
      EndIf
     
      ProcedureReturn #False
     
    Case #WM_QSPIN_GETVALUE
      *daten = GetProp_(hwnd,"PROP_DATA")
     
      ProcedureReturn *daten\Value
     
    Case #WM_QSPIN_UP
      *daten = GetProp_(hwnd,"PROP_DATA")
     
      If *daten\Value + lParam > *daten\Max
        *daten\Value = *daten\Max
      Else
        *daten\Value + lParam
      EndIf
     
      InvalidateRect_(hwnd,#Null,#True)
     
    Case #WM_QSPIN_DOWN
      *daten = GetProp_(hwnd,"PROP_DATA")
     
      If *daten\Value - lParam < *daten\Min
        *daten\Value = *daten\Min
      Else
        *daten\Value - lParam
      EndIf
     
      InvalidateRect_(hwnd,#Null,#True)
     
     
    Case #WM_CREATE
     
      *cc = lParam
     
      *temp = *cc\lpCreateParams
     
      SetProp_(hwnd,"PROP_DATA",*temp\l)
     
     
      ProcedureReturn #False
     
    Case #WM_DESTROY
     
      *daten = GetProp_(hwnd,"PROP_DATA")
      FreeMemory(*daten)
      RemoveProp_(hwnd,"PROP_DATA")
      DestroyWindow_(hwnd)
     
      ProcedureReturn #False
     
    Case #WM_PAINT
     
      *daten = GetProp_(hwnd,"PROP_DATA")
     
      Spektrum  = (Abs(*daten\Value - *daten\Min)/(*daten\Max   - *daten\Min)) * (*daten\rect\right - *daten\rect\left)
     
      BeginPaint_(hwnd,ps)
     
      If Spektrum >= 0 And Spektrum <= *daten\rect\right
       
        hpen1  =  CreatePen_(#PS_SOLID,1,GetSysColor_(#COLOR_BTNSHADOW))
        hpen2  =  CreatePen_(#PS_SOLID,1,GetSysColor_(#COLOR_BTNHILIGHT))
       
        SelectObject_(ps\hdc,hpen2)
       
        MoveToEx_(ps\hdc,0,0,0)
        LineTo_(ps\hdc,Spektrum,0)
        MoveToEx_(ps\hdc,0,0,0)
        LineTo_(ps\hdc,0,*daten\rect\bottom)
       
        SelectObject_(ps\hdc,hpen1)
       
        MoveToEx_(ps\hdc,Spektrum,0,0)
        LineTo_(ps\hdc,Spektrum,*daten\rect\bottom-1)
       
        MoveToEx_(ps\hdc,0,*daten\rect\bottom-*daten\rect\top-3,0)
        LineTo_(ps\hdc,Spektrum,*daten\rect\bottom-*daten\rect\top-3)
       
        DeleteObject_(hpen1)
        DeleteObject_(hpen2)
       
        ;{ Kann ausgeklammert werden !
        *vert = AllocateMemory(SizeOf(TRIVERTEX)*3)
       
        *vert\x      = 0
        *vert\y      = 0
        *vert\Red    = $F000
        *vert\Green  = $F000
        *vert\Blue   = $F000
       
        *vert + SizeOf(TRIVERTEX)
       
        *vert\x      = Spektrum
        *vert\y      = *daten\rect\bottom-*daten\rect\top
        *vert\Red    = $8000
        *vert\Green  = $8000
        *vert\Blue   = $8000
       
        gRect\UpperLeft  = 0
        gRect\LowerRight = 1
       
        *vert - SizeOf(TRIVERTEX)
       
        If GradientFill_(ps\hdc,*vert,2,@gRect,1,#GRADIENT_FILL_RECT_V) = #False
          Debug GetLastError_()
        EndIf
       
        FreeMemory(*vert)
       
        ;}
       
      EndIf
     
      EndPaint_(hwnd,ps)
     
      ProcedureReturn #False
     
    Case #WM_MOUSEMOVE
     
     
      If wParam & #MK_LBUTTON
       
        x = _GET_X_LPARAM(lParam)
        y = _GET_Y_LPARAM(lParam)
       
        *daten = GetProp_(hwnd,"PROP_DATA")
       
        SetCursor_(LoadCursor_(0,#IDC_SIZEWE))
       
        If _PTINRECT(*daten\rect,x,y)
          x2 = (x - *daten\rect\left) / (*daten\rect\right - *daten\rect\left) * 100
          *daten\Value = ((*daten\Max - *daten\Min) / 100) * x2 + *daten\Min
          InvalidateRect_(hwnd,#Null,#True)
        EndIf
      Else
        SetCursor_(LoadCursor_(0,#IDC_ARROW))
      EndIf
     
      ProcedureReturn #False
    Case #WM_LBUTTONDOWN
     
      x = _GET_X_LPARAM(lParam)
      y = _GET_Y_LPARAM(lParam)
     
      *daten = GetProp_(hwnd,"PROP_DATA")
     
      If _PTINRECT(*daten\rect,x,y)
        x2 = (x - *daten\rect\left) / (*daten\rect\right - *daten\rect\left) * 100
        *daten\Value = ((*daten\Max - *daten\Min) / 100) * x2 + *daten\Min   
        InvalidateRect_(hwnd,#Null,#True)
      EndIf
     
      ProcedureReturn #False
     
    Case #WM_SIZE
  EndSelect
 
  ProcedureReturn DefWindowProc_(hwnd,msg,wParam,lParam)
EndProcedure

  ;#########################################################

Procedure QSpinGadget(parent,id,x,y,cx,cy,Min,Max,Value,flags)
 
  Protected isRegister.l
  Protected wndC.WNDCLASS
  Protected style.l
  Protected hInstance.l
  Protected *daten.CData
  Protected cc.CREATESTRUCT
  Protected rc.RECT
 
  hInstance = GetModuleHandle_(0)
 
  If isRegister = #False
   
    wndC\lpfnWndProc    = @CProc()
    wndC\hInstance      = hInstance
    wndC\hCursor        = LoadCursor_(0, #IDC_ARROW)
    wndC\hbrBackground  = GetSysColorBrush_(#COLOR_BTNFACE)
    wndC\lpszClassName  = @"QSPIN"
   
    If RegisterClass_(wndC)
      isRegister = #True
    EndIf
   
  EndIf
 
  ;parent = GadgetListHandle()
 
  If parent <> 0
   
    *daten = AllocateMemory(SizeOf(CData))
   
    *daten\Min         = Min
    *daten\Max         = Max
    *daten\Value       = Value
    *daten\rect\right  = cx - 1
    *daten\rect\bottom = cy
   
    cc\lpCreateParams = *daten
   
    style = #WS_VISIBLE|#WS_CHILD
   
    hwnd  = CreateWindowEx_(#WS_EX_STATICEDGE,"QSPIN",0,style,x,y,cx+2,cy,parent,id,hInstance,@cc)
   
  EndIf
 
  ProcedureReturn hwnd
EndProcedure

  ;##################################################################################################################
  ;#
  ;# Test


*win.LONG = OpenWindow(#PB_Any,0,0,400,400,"",1|#WS_SYSMENU)

spin = QSpinGadget(*win\l,0,10,10,350,15,0,100,20,0)

ButtonGadget(1,200,300,20,20,"-")
ButtonGadget(2,220,300,20,20," ")
ButtonGadget(3,240,300,20,20,"+")
ButtonGadget(4,220,320,20,20,"10")
ButtonGadget(5,200,320,20,20,"5")
ButtonGadget(6,240,320,20,20,"50")

Repeat
  event = WaitWindowEvent()
 
  If event = #PB_Event_Gadget
   
    Select EventGadget()
      Case 1 :  SendMessage_(spin,#WM_QSPIN_DOWN,0,1)
      Case 3 :  SendMessage_(spin,#WM_QSPIN_UP,0,1)
      Case 2 :  SetWindowTitle(*win,Str(SendMessage_(spin,#WM_QSPIN_GETVALUE,0,0)))
      Case 4 :  SendMessage_(spin,#WM_QSPIN_SETMAX,0,10)
      Case 5 :  SendMessage_(spin,#WM_QSPIN_SETMIN,0,5)
      Case 6 :  SendMessage_(spin,#WM_QSPIN_SETMAX,0,50)
    EndSelect
   
  EndIf
 
Until event = #WM_CLOSE

End
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de