PureBoard

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

Farbauswahl ähnlich wie in PB - Basisroutinen

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

Seite 1 von 2

Farbauswahl ähnlich wie in PB - Basisroutinen

Verfasst: 19.07.2008 18:24
von hjbremer
einfach ausprobieren, sieht gewaltiger aus als es ist

Umfasst nur die Farbauswahl mit Trackbars, die Buttons für Farben speichern etc, kann jeder sich selbst bauen, wenn man diese denn braucht.

Edit: Problem mit Farbwahl beseitigt, siehe folgende Postings und Anzeiger von Pfeil auf Kreuz geändert.

Code: Alles auswählen

;BasisRoutinen für Farbauswahl wie bei PB 
;HJBremer Juli 2008 Win XP PB 4.2

Declare myImageGadgetProcIni()
Declare myImageGadgetProcMakeRGB()
Declare myImageGadgetProcMakeSlide()
Declare myImageGadgetProcMakeRgbCursor()
Declare myImageGadgetProcMakeSlideCursor()
Declare myImageGadgetProcMakeDemo()
Declare myImageGadgetProcMakeDemoNew(newcolor)
Declare myImageGadgetProcMakeSlideNew(newcolor)
Declare myImageGadgetProcRGB(hWnd, message,wParam,lParam) 
Declare myImageGadgetProcSlide(hWnd, message,wParam,lParam) 
Declare Api_FarbverlaufRect(*var)
Declare Api_FarbverlaufTriangle(*var)

Declare myFarbenTrackBarIni()
Declare myFarbenTrackBarSet(farbe)
Declare myFarbenTrackBarState(wb)

Structure GRADIENT_TRIANGLE   ;diese Structur fehlt immer noch in PB 
  Vertex1.l
  Vertex2.l
  Vertex3.l
EndStructure

Structure myFarbVerlauf
  dc.l
  trifarbe.l[3]
  tripos.point[3]
  trivert.TRIVERTEX[3]
  trirect.GRADIENT_TRIANGLE
  gradrect.GRADIENT_RECT
  richtung.l
EndStructure

Structure myImgGadgetProcStruktur 

  hdcursor.l
  lpPrevFunc.l
  
  imgnr.l
  imgid.l
  imgsp.l
  imgze.l 
  imgbr.l
  imghh.l 
  imgHV.l  
  imgnrA.l
  imgnrB.l
  
  imgCursor1nr.l
  imgCursor1id.l
  imgCursor2nr.l
  imgCursor2id.l
  imgCursorbr.l
  imgCursorhh.l
  
  imgColor.l
  mauspress.l
  curpos.point
  
EndStructure

Structure myFarbTrackbar

  tracksp.l
  trackze.l
  gesamtbr.l  
  
  trackbarNrR.l
  trackbarNrG.l
  trackbarNrB.l
  trackbarNrX.l
  tracktxtNrR.l
  tracktxtNrG.l
  tracktxtNrB.l
  tracktxtNrX.l
  tracktxt.s{8}    
  
  r.c ;Farbwerte intern
  g.c
  b.c
  wert.l
 
EndStructure

Enumeration
#window
#butnrRGB
#butnrDemo
#butnrSlide
EndEnumeration

myRGBvar.myImgGadgetProcStruktur
myDemovar.myImgGadgetProcStruktur
mySlidevar.myImgGadgetProcStruktur
myTrackvar.myFarbTrackbar

;==============================

hwnd = OpenWindow(#window, 100, 100, 420, 420,"Slider",#PB_Window_SystemMenu)
       CreateGadgetList(hwnd)         
         myImageGadgetProcIni()

Repeat 

    EventID = WaitWindowEvent() 
    If EventID = #PB_Event_Gadget 
                      
        wButton = EventGadget() 
        myFarbenTrackBarState(wbutton)
        
        ;Debug Hex(myRGBvar\imgcolor)    ;Farbe aus dem großen Farbfeld
        ;Debug Hex(mySlidevar\imgcolor)  ;Farbe aus dem Farbbalken
        ;Debug Hex(myDemovar\imgcolor)   ;Farbe aus dem Demofeld         <----------
        
        ;Select wButton 
        ;  case xyz                   
        ;EndSelect
            
    EndIf
            
Until eventid = #PB_Event_CloseWindow 

End

;==============================

Procedure myImageGadgetProcIni()

Shared myRGBvar.myImgGadgetProcStruktur
Shared myDemovar.myImgGadgetProcStruktur
Shared mySlidevar.myImgGadgetProcStruktur
Shared myTrackvar.myFarbTrackbar

;großes Farbfeld
With myRGBvar

  \imgsp = 10   ;Position
  \imgze = 10  
  \imgbr = 200  ;Größe
  \imghh = 300
   
  \imgnr = CreateImage(#PB_Any, \imgbr, \imghh)
  \imgid = ImageID(\imgnr)

  ;Startwert für mauspress im großen Farbfeld
  ;wenn 0, dann muß erst ins Farbfeld geklickt werden
  ;wenn 1, dann werden die Farben sofort geändert sowie Maus Farbfeld berührt
  ;  allerdings kann man Feld erst verlassen, nach drücken und loslassen der Maustaste
  \mauspress = 0  

  myImageGadgetProcMakeRGB    ()
  myImageGadgetProcMakeRgbCursor  ()
  
  ContainerGadget(#PB_Any, \imgsp, \imgze, \imgbr+6, \imghh+6,#PB_Container_Raised)
    ImageGadget(#butnrRGB, 0, 0, 0, 0, \imgid)
    SetClassLong_(GadgetID(#butnrRGB),#GCL_HCURSOR, 0)  ;muß sein, wegen flackern
    \lpPrevFunc = SetWindowLong_(GadgetID(#butnrRGB),#GWL_WNDPROC,@myImageGadgetProcRGB()) 
  CloseGadgetList()
  
EndWith          
  
;Farbbalken
With mySlidevar

  ;ergibt waagerechten Balken
  ;\imgsp = 240  
  ;\imgze = 10 
  ;\imgbr = 160 
  ;\imghh = 50  
  ;\imgHV = #GRADIENT_FILL_RECT_H

  ;ergibt senkrechten Balken
  \imgsp = 240
  \imgze = 10  
  \imgbr = 50
  \imghh = 240
  \imgHV = #GRADIENT_FILL_RECT_V

  \imgnr = CreateImage(#PB_Any, \imgbr, \imghh)
  \imgid = ImageID(\imgnr)
  
  If \imgHV = #GRADIENT_FILL_RECT_V
    \imgnrA = CreateImage(#PB_Any, \imgbr, \imghh / 2)
    \imgnrB = CreateImage(#PB_Any, \imgbr, \imghh / 2)
    \curpos\y = \imghh / 2
  Else  
    \imgnrA = CreateImage(#PB_Any, \imgbr / 2, \imghh)
    \imgnrB = CreateImage(#PB_Any, \imgbr / 2, \imghh)
    \curpos\x = \imgbr / 2
  EndIf
  
  \imgcolor = #Gray
  
  myImageGadgetProcMakeSlide  ()
  myImageGadgetProcMakeSlideCursor()
  
  ContainerGadget(#PB_Any, \imgsp, \imgze, \imgbr+6, \imghh+6,#PB_Container_Raised)
    ImageGadget(#butnrSlide, 0, 0, 0, 0, \imgid)
    SetClassLong_(GadgetID(#butnrSlide),#GCL_HCURSOR, 0)  ;muß sein, wegen flackern 
    \lpPrevFunc = SetWindowLong_(GadgetID(#butnrSlide),#GWL_WNDPROC,@myImageGadgetProcSlide()) 
  CloseGadgetList()
  
EndWith

;Demofeld
With myDemovar
  
  \imgsp = 240
  \imgze = 260  
  \imgbr = 50
  \imghh = 50
  
  \imgnr = CreateImage(#PB_Any, \imgbr, \imghh)
  \imgid = ImageID(\imgnr)
  
  myImageGadgetProcMakeDemo()

  ContainerGadget(#PB_Any, \imgsp, \imgze, \imgbr+6, \imghh+6,#PB_Container_Raised) 
    ImageGadget(#butnrDemo, 0, 0, 0, 0, \imgid)  
  CloseGadgetList() 
  
EndWith 

;Trackbars
With myTrackvar

  \tracksp = 10
  \trackze = 330
  \gesamtbr = 300  
    
  myFarbenTrackBarIni()
  
EndWith

;nur zur Demo
;ImageGadget(#PB_Any, 360, 10, 0, 0,ImageID(myRGBvar\imgCursor1nr))
;ImageGadget(#PB_Any, 360, 40, 0, 0,ImageID(myRGBvar\imgCursor2nr))
;ImageGadget(#PB_Any, 360, 70, 0, 0,ImageID(mySlidevar\imgCursor1nr))
;ImageGadget(#PB_Any, 360, 120, 0, 0,ImageID(mySlidevar\imgCursor2nr))

EndProcedure
Procedure myImageGadgetProcMakeRGB()

Shared myRGBvar.myImgGadgetProcStruktur

With myRGBvar
  
  br = \imgbr
  hh = \imghh
  nr = \imgnr

EndWith
  
With var.myFarbverlauf

  \dc = StartDrawing(ImageOutput(nr)) 

            farbemitte  = $707070  ;grau
            farbe_rot   = #Red
            farbe_blau  = #Blue
            farbe_gruen = $90ff00
            farbe_gelb  = #Yellow
           
            ; p[0] = mittelpunkt des Rechtecks bzw. Spitze des Dreiecks
            ; p[1] = linker punkt Basis des Dreiecks
            ; p[2] = rechter punkt Basis des Dreiecks
      
            \tripos[0]\x=br / 2  ;spalte Mittelpunkt bzw. Spitze des Dreiecks
            \tripos[0]\y=hh / 2  ;zeile  Mittelpunkt
            
            ;Dreieck unten
            \tripos[1]\x=0: \tripos[1]\y=hh   ;linker punkt Basis des Dreiecks
            \tripos[2]\x=br: \tripos[2]\y=hh  ;rechter punkt Basis des Dreiecks
            
            \trifarbe[0] = farbemitte  ;Spitze des Dreiecks, bleibt immer gleich
            \trifarbe[1] = farbe_rot   ;linker punkt Basis des Dreiecks
            \trifarbe[2] = farbe_blau  ;rechter punkt Basis des Dreiecks
            
            Api_FarbverlaufTriangle(var) 
            
            ;Dreieck rechts
            \tripos[1]\x=br: \tripos[1]\y=hh
            \tripos[2]\x=br: \tripos[2]\y=0
            
            \trifarbe[1] = farbe_blau
            \trifarbe[2] = farbe_gruen
            
            Api_FarbverlaufTriangle(var) 
            
            ;Dreieck oben
            \tripos[1]\x=br: \tripos[1]\y=0
            \tripos[2]\x=0: \tripos[2]\y=0
            
            \trifarbe[1] = farbe_gruen
            \trifarbe[2] = farbe_gelb
            
            Api_FarbverlaufTriangle(var) 
            
            ;Dreieck links
            \tripos[1]\x=0: \tripos[1]\y=0
            \tripos[2]\x=0: \tripos[2]\y=hh
            
            \trifarbe[1] = farbe_gelb
            \trifarbe[2] = farbe_rot
            
            Api_FarbverlaufTriangle(var) 
            
        StopDrawing()
             
EndWith              

EndProcedure
Procedure myImageGadgetProcMakeRgbCursor()

;diese Images werden nicht verändert, darum kann CreateImage(#PB_Any...) hier stehen

;die Farben stehen im direkten Zusammenhang mit den Parametern 
;von BitBlt_(..., #SRCPAINT) + BitBlt_(..., #SRCAND) in myImageGadgetProcRGB ()
;werden die Farben vertauscht, müssen auch die Parameter vertauscht werden !
;siehe auch Reihenfolge von Farben und Parameter in den Slide Prozeduren

Shared myRGBvar.myImgGadgetProcStruktur

With myRGBvar

  \hdcursor = LoadCursor_(0, #IDC_CROSS) 
  
  \imgCursorbr = 18
  \imgCursorhh = 18
  
  \imgCursor1nr = CreateImage(#PB_Any, \imgCursorbr, \imgCursorhh) 
  \imgCursor1id = ImageID(\imgCursor1nr)
  
                StartDrawing(ImageOutput(\imgCursor1nr)) 
                 Box(0, 0, \imgCursorbr, \imgCursorhh,#White)   ;hier White, bei BitBlt SCRAND benutzen
                StopDrawing() 

  \imgCursor2nr = CreateImage(#PB_Any, \imgCursorbr, \imgCursorhh) 
  \imgCursor2id = ImageID(\imgCursor2nr)
  
                StartDrawing(ImageOutput(\imgCursor2nr)) 
                 Box(0, 0, \imgCursorbr, \imgCursorhh,#Black)   ;hier Black, bei BitBlt SCRPAINT benutzen
                 ;Pfeil oder kleines Kreuz
                 ;DrawImage(LoadCursor_(0, #IDC_ARROW),-10,-9)  ;
                 Line(0,3,7,0,#White)
                 Line(3,0,0,7,#White)
                StopDrawing() 
              
EndWith              

EndProcedure
Procedure myImageGadgetProcMakeSlide()

Shared mySlidevar.myImgGadgetProcStruktur

With mySlidevar
  
  br = \imgbr 
  hh = \imghh
  
  nr  = \imgnr  
  nrA = \imgnrA
  nrB = \imgnrB
  
  farbe = \imgcolor   
  richtung = \imgHV
    
EndWith

With var.myFarbverlauf
    
  ;richtung
  \richtung = richtung  ;#GRADIENT_FILL_RECT_V oder #GRADIENT_FILL_RECT_H
  
  If \richtung = #GRADIENT_FILL_RECT_V
    tp1sp = br
    tp1ze = hh / 2
    nrBsp = 0
    nrBze = tp1ze
  Else
    tp1sp = br / 2
    tp1ze = hh 
    nrBsp = tp1sp
    nrBze = 0
  EndIf  

  ;oben links vom halben Balken
  \tripos[0]\x = 0  ;spalte
  \tripos[0]\y = 0  ;zeile
  
  ;unten rechts vom halben Balken
  \tripos[1]\x = tp1sp 
  \tripos[1]\y = tp1ze
      
  \dc = StartDrawing(ImageOutput(nrA))    ;dieses dc ist für Api_FarbverlaufRect 
          \trifarbe[0] = $200000          ;oder #Black, Startwert für Schwarz
          \trifarbe[1] = farbe      
          Api_FarbverlaufRect(var)
        StopDrawing()
  
  \dc = StartDrawing(ImageOutput(nrB))    ;dieses dc ist für Api_FarbverlaufRect  
          \trifarbe[0] = farbe
          \trifarbe[1] = #White
          Api_FarbverlaufRect(var)
        StopDrawing()
  
        StartDrawing(ImageOutput(nr)) 
          DrawImage(ImageID(nrA), 0, 0)
          DrawImage(ImageID(nrB), nrBsp, nrBze)
        StopDrawing()     

EndWith

EndProcedure
Procedure myImageGadgetProcMakeSlideCursor()

;diese Images werden nicht verändert, darum kann CreateImage(#PB_Any...) hier stehen

Shared mySlidevar.myImgGadgetProcStruktur

With mySlidevar

  \hdcursor = LoadCursor_(0, #IDC_CROSS) 

  If \imgHV = #GRADIENT_FILL_RECT_V
    \imgCursorbr = \imgbr
    \imgCursorhh = 9
  Else
    \imgCursorbr = 9
    \imgCursorhh = \imghh
  EndIf

  \imgCursor1nr = CreateImage(#PB_Any, \imgCursorbr, \imgCursorhh) 
  \imgCursor1id = ImageID(\imgCursor1nr) 
  
                StartDrawing(ImageOutput(\imgCursor1nr)) 
                 Box(0, 0, \imgCursorbr, \imgCursorhh, #White)    ;hier White, bei BitBlt SCRAND benutzen
                StopDrawing() 

  \imgCursor2nr = CreateImage(#PB_Any, \imgCursorbr, \imgCursorhh) 
  \imgCursor2id = ImageID(\imgCursor2nr)
  
                StartDrawing(ImageOutput(\imgCursor2nr)) 
                 Box(0, 0, \imgCursorbr, \imgCursorhh, #Black)    ;hier Black, bei BitBlt SCRPAINT benutzen  
                 If \imgHV = #GRADIENT_FILL_RECT_V        ;werden Boxwerte geändert 
                      Box(2, 2, \imgCursorbr-4, 6,#White)     ;ändern sich auch BitBltwerte in myImageGadgetProcSlide
                      Box(4, 4, \imgCursorbr-8, 2, #Magenta)  ;#red geht auch
                 Else
                      Box(2, 2, \imgCursorbr-4, \imgCursorhh-4,#White)
                      Box(4, 4, \imgCursorbr-8, \imgCursorhh-8, #Red)
                 EndIf 
                StopDrawing() 

EndWith

EndProcedure
Procedure myImageGadgetProcMakeDemo()

Shared myDemovar.myImgGadgetProcStruktur

With myDemovar

  StartDrawing(ImageOutput(\imgnr)) 
    Box(0, 0, \imgbr, \imghh, \imgcolor)
  StopDrawing() 

EndWith

EndProcedure
Procedure myImageGadgetProcMakeDemoNew(newcolor)

Shared myDemovar.myImgGadgetProcStruktur

    myDemovar\imgcolor = newcolor
    
    myImageGadgetProcMakeDemo()
    
    SetGadgetState(#butnrdemo,ImageID(myDemovar\imgnr))
    
EndProcedure
Procedure myImageGadgetProcMakeSlideNew(newcolor)

Shared mySlidevar.myImgGadgetProcStruktur

    mySlidevar\imgcolor = newcolor
    
    myImageGadgetProcMakeSlide()
    
    SetGadgetState(#butnrslide,ImageID(myslidevar\imgnr))
    
EndProcedure
Procedure myImageGadgetProcRGB(hWnd, message,wParam,lParam) 
;Dank an Danilo + Fluid Byte für die Beispiele als Anregung

;die Werte für curpos + mauspress sind Static durch die Strukturvariable

Shared myRGBvar.myImgGadgetProcStruktur

With myRGBvar
    
    SetCursor_(\hdcursor)
    
    Select message 

      Case #WM_PAINT 

          dc = BeginPaint_(hwnd,paint.PAINTSTRUCT) 
        
              hdkopie = CreateCompatibleBitmap_(dc, \imgbr, \imghh) 
                                
              hdmemdc1 = CreateCompatibleDC_(dc) 
              SelectObject_(hdmemdc1, hdkopie) 
               
              hdmemdc2 = CreateCompatibleDC_(dc)               
              SelectObject_(hdmemdc2, \imgid)
               
              BitBlt_(hdmemdc1, 0, 0, \imgbr, \imghh, hdmemdc2, 0, 0,#SRCCOPY) 
              
              ;Farbe holen
              \imgColor = GetPixel_(hdmemdc1, \curpos\x, \curpos\y)  
              
              ;Cursor
              SelectObject_(hdmemdc2, \imgCursor1id)    
              BitBlt_(hdmemdc1, \curpos\x, \curpos\y, \imgCursorbr, \imgCursorhh, hdmemdc2, 0, 0,#SRCAND) 
               
              SelectObject_(hdmemdc2, \imgCursor2id) 
              BitBlt_(hdmemdc1, \curpos\x, \curpos\y, \imgCursorbr, \imgCursorhh, hdmemdc2, 0, 0,#SRCPAINT)       
              
              ;Bild fertig
              BitBlt_(dc, 0, 0, \imgbr, \imghh, hdmemdc1, 0, 0,#SRCCOPY)       
    
              DeleteDC_(hdmemdc1)        
              DeleteDC_(hdmemdc2) 
              DeleteObject_(hdkopie)       

              ;\imgColor = GetPixel_(dc, \curpos\x-0, \curpos\y-0)  ;anstatt 0 eine 1, verschiebt GetPixel
              
          EndPaint_(hwnd,paint) 
          
          myImageGadgetProcMakeSlideNew(\imgcolor)  ;Farbbalken aktualisieren
                            
      Case #WM_LBUTTONDOWN, #WM_MOUSEMOVE 
      
          If message = #WM_LBUTTONDOWN: \mauspress = 1: EndIf
          
          If \mauspress            

              GetWindowRect_(hwnd,r.rect)         ;wo ist Image auf Screen
              r\right - 1: r\bottom - 4           ;damit Cursor nicht ganz verschwindet
              ClipCursor_(r)                      ;sorgt dafür, das Maus im Image bleibt
              GetCursorPos_(\curpos)              ;wo ist Maus im Screen
              ScreenToClient_(hwnd, \curpos)      ;umrechnen auf Image
              InvalidateRect_(hwnd, 0, 0)         ;Image aktualisieren
              
          EndIf 
             
      Case #WM_LBUTTONUP       

          \mauspress = 0 
          ClipCursor_(0)

    EndSelect 
      
    ProcedureReturn CallWindowProc_(\lpPrevFunc, hWnd, message,wParam,lParam)
    
EndWith
     
EndProcedure 
Procedure myImageGadgetProcSlide(hWnd, message,wParam,lParam) 
;Dank an Danilo + Fluid Byte für die Beispiele als Anregung

;die Werte für curpos + mauspress sind Static durch die Strukturvariable
;die Cursorwerte für BitBlt(..., SRCINVERT) durch probieren ermittelt

Shared mySlidevar.myImgGadgetProcStruktur

With mySlidevar
    
    SetCursor_(\hdcursor)
    
    Select message 

      Case #WM_PAINT 

          dc = BeginPaint_(hwnd,paint.PAINTSTRUCT) 
        
              hdkopie = CreateCompatibleBitmap_(dc, \imgbr, \imghh) 
                                
              hdmemdc1 = CreateCompatibleDC_(dc) 
              SelectObject_(hdmemdc1, hdkopie) 
               
              hdmemdc2 = CreateCompatibleDC_(dc)               
              SelectObject_(hdmemdc2, \imgid)
               
              BitBlt_(hdmemdc1, 0, 0, \imgbr, \imghh, hdmemdc2, 0, 0,#SRCCOPY) 
              
              ;Farbe holen
              \imgColor = GetPixel_(dc, \curpos\x, \curpos\y) 
              
              ;Cursor
              SelectObject_(hdmemdc2, \imgCursor1id)    
              BitBlt_(hdmemdc1, \curpos\x, \curpos\y, \imgCursorbr, \imgCursorhh, hdmemdc2, 0, 0,#SRCAND) 
              
              SelectObject_(hdmemdc2, \imgCursor2id) 
              BitBlt_(hdmemdc1, \curpos\x, \curpos\y, \imgCursorbr, \imgCursorhh, hdmemdc2, 0, 0,#SRCPAINT)        
              
              BitBlt_(hdmemdc1, \curpos\x+4, \curpos\y+4, \imgCursorbr-8, \imgCursorhh-7, hdmemdc2, 4, 4,#SRCINVERT) 
              
              ;neues Bild zum dc              
              BitBlt_(dc, 0, 0, \imgbr, \imghh, hdmemdc1, 0, 0,#SRCCOPY)       
    
              DeleteDC_(hdmemdc1)        
              DeleteDC_(hdmemdc2) 
              DeleteObject_(hdkopie)       

          EndPaint_(hwnd,paint) 
          
          myImageGadgetProcMakeDemoNew(\imgcolor)   ;Demofeld aktualisieren
          myFarbenTrackBarSet(\imgcolor)            ;Trackbars aktualisieren
           
      Case #WM_LBUTTONDOWN, #WM_MOUSEMOVE 
      
          If message = #WM_LBUTTONDOWN: \mauspress = 1: EndIf
          
          If \mauspress            
              
              GetWindowRect_(hwnd,r.rect)         ;wo ist Image auf Screen
              r\right - 4: r\bottom - 4           ;damit Cursor nicht ganz verschwindet
              ClipCursor_(r)                      ;sorgt dafür, das Maus im Image bleibt
              GetCursorPos_(\curpos)              ;wo ist Maus im Screen
              ScreenToClient_(hwnd, \curpos)      ;umrechnen auf Image
              InvalidateRect_(hwnd, 0, 0)         ;Image aktualisieren
              
              If \imgHV = #GRADIENT_FILL_RECT_V
                \curpos\x = 0
              Else
                \curpos\y = 0
              EndIf

          EndIf 

      Case #WM_LBUTTONUP       

          \mauspress = 0 
          ClipCursor_(0)  ;Maus freigeben von ClipCursor-Bereich

    EndSelect 
      
    ProcedureReturn CallWindowProc_(\lpPrevFunc, hWnd, message,wParam,lParam)
    
EndWith
     
EndProcedure 
Procedure myFarbenTrackBarIni()

Shared myTrackvar.myFarbTrackbar

fontid = GetStockObject_(#ANSI_FIXED_FONT)    ;Systemfont holen
GetObject_(fontid,SizeOf(LOGFONT),lg.LOGFONT) ;Eigenschaften holen
fontid = CreateFontIndirect_(lg)              ;Font create

dc = StartDrawing(WindowOutput(#window))
     DrawingFont(FontID) 
     GetTextExtentPoint32_(dc,"",8, size.size)  ;bei FixFont kann man auf Text verzichten
     StopDrawing()

With myTrackvar

  zr = 1
  hh = size\cy + 6 ;20 
  br = size\cx + 1 ;60
  sp = \tracksp
  ze1= \trackze 
  ze2= ze1 + hh + zr
  ze3= ze2 + hh + zr
  ze4= ze3 + hh + zr
 
  \tracktxtNrR = TextGadget(#PB_Any, sp, ze1, br, hh, "$00 000",#PB_Text_Center|#PB_Text_Border) 
  \tracktxtNrG = TextGadget(#PB_Any, sp, ze2, br, hh, "$00 000",#PB_Text_Center|#PB_Text_Border) 
  \tracktxtNrB = TextGadget(#PB_Any, sp, ze3, br, hh, "$00 000",#PB_Text_Center|#PB_Text_Border) 
  \tracktxtNrX = TextGadget(#PB_Any, sp, ze4, br, hh, "$000000",#PB_Text_Center|#WS_DLGFRAME|#SS_NOTIFY) 
      
  SetGadgetFont(\tracktxtNrR, fontid) 
  SetGadgetFont(\tracktxtNrG, fontid) 
  SetGadgetFont(\tracktxtNrB, fontid)
  SetGadgetFont(\tracktxtNrX, fontid)
  
  SetGadgetColor(\tracktxtNrR, #PB_Gadget_BackColor, $8080FF)
  SetGadgetColor(\tracktxtNrG, #PB_Gadget_BackColor, $74B416)
  SetGadgetColor(\tracktxtNrB, #PB_Gadget_BackColor, $E3776F)
  SetGadgetColor(\tracktxtNrX, #PB_Gadget_BackColor,  #Black)
  SetGadgetColor(\tracktxtNrR, #PB_Gadget_FrontColor, #White)
  SetGadgetColor(\tracktxtNrG, #PB_Gadget_FrontColor, #White)
  SetGadgetColor(\tracktxtNrB, #PB_Gadget_FrontColor, #White)
  SetGadgetColor(\tracktxtNrX, #PB_Gadget_FrontColor, #White)
  
  GadgetToolTip(\tracktxtNrX, "Hex-Farbwert zum Clipboard") 
 
  sp + br + zr
  br = \gesamtbr - sp
  ze1= \trackze 
  ze2= ze1 + hh + zr
  ze3= ze2 + hh + zr
  ze4= ze3 + hh + zr
  
  \trackbarNrR = TrackBarGadget(#PB_Any, sp, ze1, br, hh, 0, 255) 
  \trackbarNrG = TrackBarGadget(#PB_Any, sp, ze2, br, hh, 0, 255) 
  \trackbarNrB = TrackBarGadget(#PB_Any, sp, ze3, br, hh, 0, 255) 
  \trackbarNrX = TrackBarGadget(#PB_Any, sp, ze4, br, hh, 0, 64) 
  
EndWith  
  
EndProcedure
Procedure myFarbenTrackBarSet(farbe)

Shared myTrackvar.myFarbTrackbar

With myTrackvar

  \wert = farbe
  
  \r=Red(farbe):   SetGadgetState(\trackbarNrR,\r)
  \g=Green(farbe): SetGadgetState(\trackbarNrG,\g)
  \b=Blue(farbe):  SetGadgetState(\trackbarNrB,\b)

  ;r = \r / 8: g = \g / 8: b = \b / 8
  ;SetGadgetState(\trackbarNrX, r+g+b)
  
  \tracktxt = "$" + RSet(Hex(\r),2,"0") + " " + RSet(Str(\r),3,"0")
  SetGadgetText(\tracktxtNrR, \tracktxt)

  \tracktxt = "$" + RSet(Hex(\g),2,"0") + " " + RSet(Str(\g),3,"0")
  SetGadgetText(\tracktxtNrG, \tracktxt)

  \tracktxt = "$" + RSet(Hex(\b),2,"0") + " " + RSet(Str(\b),3,"0")
  SetGadgetText(\tracktxtNrB, \tracktxt)

  \tracktxt = "$" + RSet(Hex(farbe),6,"0")
  SetGadgetText(\tracktxtNrX, \tracktxt)

EndWith

EndProcedure
Procedure myFarbenTrackBarState(wb)

Static x, xx
Shared myTrackvar.myFarbTrackbar

With myTrackvar  

    Select wB
            
        Case \tracktxtNrX: SetClipboardText("$" + RSet(Hex(\wert),6,"0"))
        
        Case \trackbarNrR: \r = GetGadgetState(\trackbarnrR): \wert = RGB(\r, \g, \b): myFarbenTrackBarSet(\wert)
        Case \trackbarNrG: \g = GetGadgetState(\trackbarnrG): \wert = RGB(\r, \g, \b): myFarbenTrackBarSet(\wert)
        Case \trackbarNrB: \b = GetGadgetState(\trackbarnrB): \wert = RGB(\r, \g, \b): myFarbenTrackBarSet(\wert)
        Case \trackbarNrX 
        
              If EventwParam() = 1
                  xx = GetGadgetState(\trackbarnrX)
                  If xx > x 
                    \r + 8: \g + 8: \b + 8
                  ElseIf xx < x
                    \r - 8: \g - 8: \b - 8
                  EndIf               
                  x = xx
                  \wert = RGB(\r, \g, \b)
                  myFarbenTrackBarSet(\wert)
              EndIf
              
    EndSelect    
    
    myImageGadgetProcMakeDemoNew(\wert)
            
EndWith

EndProcedure
Procedure Api_FarbverlaufRect(*var.myFarbverlauf)
  
;richtung
;#GRADIENT_FILL_RECT_V = 1  
;#GRADIENT_FILL_RECT_H = 0  
  
With *var

  ;UpperLeft = oben links vom Viereck
  \trivert[0]\x     = \tripos[0]\x 
  \trivert[0]\y     = \tripos[0]\y
  \trivert[0]\Red   = Red(\trifarbe[0])  <<8 
  \trivert[0]\Green = Green(\trifarbe[0])<<8 
  \trivert[0]\Blue  = Blue(\trifarbe[0]) <<8 
  
  ;LowerRight = unten rechts
  \trivert[1]\x     = \tripos[1]\x
  \trivert[1]\y     = \tripos[1]\y
  \trivert[1]\Red   = Red(\trifarbe[1])  <<8 
  \trivert[1]\Green = Green(\trifarbe[1])<<8 
  \trivert[1]\Blue  = Blue(\trifarbe[1]) <<8 
   
  \gradrect\UpperLeft  = 0  ;an diesen Werten nicht rumspielen
  \gradrect\LowerRight = 1  ;sonst Memory Fehler
  
  Gradientfill_(\dc, \trivert, 2, \gradrect, 1, \richtung) 

EndWith

EndProcedure
Procedure Api_FarbverlaufTriangle(*var.myFarbverlauf)

With *var

  ;oben
  \trivert[0]\x     = \tripos[0]\x 
  \trivert[0]\y     = \tripos[0]\y
  \trivert[0]\Red   = Red(\trifarbe[0])  <<8 
  \trivert[0]\Green = Green(\trifarbe[0])<<8 
  \trivert[0]\Blue  = Blue(\trifarbe[0]) <<8 
  
  ;links
  \trivert[1]\x     = \tripos[1]\x 
  \trivert[1]\y     = \tripos[1]\y 
  \trivert[1]\Red   = (Red(\trifarbe[1])  <<8) 
  \trivert[1]\Green = (Green(\trifarbe[1])<<8) 
  \trivert[1]\Blue  = (Blue(\trifarbe[1]) <<8) 
  
  ;rechts
  \trivert[2]\x     = \tripos[2]\x
  \trivert[2]\y     = \tripos[2]\y
  \trivert[2]\Red   = (Red(\trifarbe[2])  <<8) 
  \trivert[2]\Green = (Green(\trifarbe[2])<<8) 
  \trivert[2]\Blue  = (Blue(\trifarbe[2]) <<8) 

  \trirect\Vertex1 = 0         ;nicht rumspielen
  \trirect\Vertex2 = 1         ;sonst Memory Fehler
  \trirect\Vertex3 = 2  
  
  Gradientfill_(\dc, \trivert, 3, \trirect, 1, #GRADIENT_FILL_TRIANGLE) 
  
EndWith  

EndProcedure

Verfasst: 19.07.2008 18:34
von RSBasic
@hjbremer
Klasse :allright:

Verfasst: 19.07.2008 19:44
von marco2007
Absolut top :allright:
Alles läuft flüssig. Respekt!!

Verfasst: 19.07.2008 20:09
von scholly
Wenn ich in das linke (bunte) FarbverlaufsGadget klicke,
wandelt sich die Cursor-Pfeil in ein Cursor-Kreuz,
aber der Pfeil bleibt weiß in dem Gadget zurück und
bewegt sich unter dem Kreuz, wenn die linke Maustaste gedrückt wird.

Ist das Absicht?

Verfasst: 19.07.2008 20:19
von ts-soft
Das Farbverlaufsfeld sieht genauso aus wie das Werkzeug der IDE, lediglich
ich bekomme nichtmal ähnliche Farben wie gewählt?

Der hängenbleibende Mauszeiger im Farbfeld sieht auch komisch aus.

Wäre ne schöne Sache, wenns denn mal funktionieren würde :cry:

Verfasst: 19.07.2008 21:40
von hjbremer
das ist Absicht !
Wer keinen Pfeil mag, kann auch einen Kreis machen oder ein Kreuz oder was auch immer. Mir gefällt der Pfeil zum Anzeigen der letzten Position !

siehe myImageGadgetProcMakeRgbCursor() und da die Zeile DrawImage(LoadCursor_(0, #IDC_ARROW),-10,-9). Kann auch Circle(...) heißen.

Verfasst: 19.07.2008 21:50
von ts-soft
Werde Dir das Problem mal bildlich machen :wink:
Bild

Gruß
Thomas

Verfasst: 19.07.2008 22:02
von marco2007
Auf Vista? Bei mir auf XP scheint`s korrekt zu sein.
Ich habe jetzt nicht haargenau den selben Punkt erwischt.
Bild

Rosa ist natürlich extrem schlimm. Thomas, hast Du einen warmen PC? :mrgreen:

Verfasst: 19.07.2008 22:26
von hjbremer
TSSOFT: dann tausch mal den Cursor gegen ein Kreuz aus.

Code: Alles auswählen

;DrawImage(LoadCursor_(0, #IDC_ARROW),-10,-9)
Line(0,3,7,0,#White)
Line(3,0,0,7,#White)
oder wenn du den Pfeil lieber magst

Code: Alles auswählen

DrawImage(LoadCursor_(0, #IDC_ARROW),-5,-5)
bei den Zahlen muß man unter Vista wohl etwas probieren
und da ich kein Vista habe, kann ich dir die genauen Werte nicht sagen.

Verfasst: 19.07.2008 22:27
von ts-soft
Unter XP SP3

Hab mir den Code nicht weiter angeschaut, nur ausgeführt, aber
vielleicht kommt er mit grossen Bildschirmen nicht klar? Oder mit Dual-Screen?

Oder es liegt an der PB Version?

Keine Ahnung was da nicht stimmt.

Werde es morgen mal unter Vista testen.
Alle Zeiten sind UTC+02:00
Seite 1 von 2

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de