Trackbar selber Zeichnen

Für allgemeine Fragen zur Programmierung mit PureBasic.
Antworten
Benutzeravatar
roherter
Beiträge: 1407
Registriert: 10.04.2005 18:58
Kontaktdaten:
Kontaktdaten von roherter

Trackbar selber Zeichnen

Beitrag 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?
Purebasic 5.0 32bit und 64 bit

I'm back from hell
Nach oben
Benutzeravatar
edel
Beiträge: 3667
Registriert: 28.07.2005 12:39
Computerausstattung: GameBoy
Kontaktdaten:
Kontaktdaten von edel

Beitrag von edel »

Weder noch , ich wuerde einfach nen neues Control nehmen und ueber wm_paint malen .
Nach oben
Benutzeravatar
roherter
Beiträge: 1407
Registriert: 10.04.2005 18:58
Kontaktdaten:
Kontaktdaten von roherter

Beitrag 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?
Purebasic 5.0 32bit und 64 bit

I'm back from hell
Nach oben
Benutzeravatar
edel
Beiträge: 3667
Registriert: 28.07.2005 12:39
Computerausstattung: GameBoy
Kontaktdaten:
Kontaktdaten von edel

Beitrag 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
Zuletzt geändert von edel am 10.12.2005 23:19, insgesamt 1-mal geändert.
Nach oben
Benutzeravatar
roherter
Beiträge: 1407
Registriert: 10.04.2005 18:58
Kontaktdaten:
Kontaktdaten von roherter

Beitrag von roherter »

Danke dir ich werde es mal durcharbeiten!
Purebasic 5.0 32bit und 64 bit

I'm back from hell
Nach oben
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Beitrag von ts-soft »

@hallodri
Bild
Muß nur noch der Cursor ausgetauscht werden. Klasse
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Nach oben
Benutzeravatar
Hroudtwolf
Beiträge: 1416
Registriert: 30.10.2004 23:33
Kontaktdaten:
Kontaktdaten von Hroudtwolf

Beitrag 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.
Nach oben
Benutzeravatar
edel
Beiträge: 3667
Registriert: 28.07.2005 12:39
Computerausstattung: GameBoy
Kontaktdaten:
Kontaktdaten von edel

Beitrag 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
Nach oben
Antworten

Zurück zu „Allgemein“