GetColorUnderMouse - geht das auch ohne Api

[hjbremer]

brauche für einen simplen Farbeinsteller mal etwas einfaches ohne Api aber PB macht es einem schon schwer

Code: Alles auswählen

Procedure.i GetColorUnderMouse() 
   ;aus dem PBForum, http://www.purebasic.fr/german/viewtopic.php?t=2887
   
   Protected CursorPos.Point, hdc, color
   GetCursorPos_(CursorPos.POINT ) 
   hDC = GetDC_(0) 
   If hDC <> 0 
      Color = GetPixel_(hDC,CursorPos\x,CursorPos\y) 
      ReleaseDC_(0, hDC) 
      ProcedureReturn Color 
   EndIf 
   
EndProcedure 


OpenWindow(0, 0, 0, 600, 150, "Get Color with F5", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

AddKeyboardShortcut(0, #PB_Shortcut_F5, #PB_Shortcut_F5)

TextGadget(1, 10, 10, 222, 33, "Move Cursor and press F5 to get the Color")

Define event, color

Repeat
   Event = WaitWindowEvent()
   
   Select Event        
         
      Case #PB_Event_Menu
         Select EventMenu()
            Case #PB_Shortcut_F5
               color = GetColorUnderMouse() 
               Debug RSet(Hex(color), 6, "0")
         EndSelect
         
   EndSelect
Until Event = #PB_Event_CloseWindow

[jacdelad]

Ohne API geht's nur innerhalb eigener Fenster. Wenn der Mauszeiger in einem fremden Bereich ist geht's nicht ohne API.

[hjbremer]

hier nun so etwas ähnliches ohne Api mit einem Farbverlauf

allerdings bin ich mit meinem Farbverlauf nicht so ganz zufrieden

kann das jemand besser ???

Code: Alles auswählen

;https://wiki.baw.de/de/index.php/Farbverlauf:_Regenbogen,_29_Farben

LoadFont (10, "Arial", 18)
OpenWindow(0, 0, 0, 450, 250, "2DDrawing Beispiel", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

Procedure.i GradientGadget(pbnr, x, y, w, h, flag=0)
   
   Protected nr = CanvasGadget(pbnr, x, y, w, h) 
   If pbnr = #PB_Any : pbnr = nr : EndIf 
   
   StartDrawing(CanvasOutput(pbnr))

      Box(0, 0, w, h, #Black)       ;Rahmen
      Box(1, 1, w-2, h-2, #White)   ;Rahmen      
      DrawingMode(#PB_2DDrawing_Gradient)       
      BackColor(#Black)
      GradientColor(0.10, $000080) ;Brown   
      GradientColor(0.20, #Blue) 
      GradientColor(0.30, #Cyan)      
      GradientColor(0.40, #Green) 
      GradientColor(0.50, #Yellow)         
      GradientColor(0.60, $0080FF)  ;Orange      
      GradientColor(0.70, #Red)       
      GradientColor(0.80, #Magenta)       
      GradientColor(0.90, #Gray)
      GradientColor(0.95, $CFFFFF)  ;Creme      
      FrontColor(#White)       
      LinearGradient(0, w, w, w) 
      If flag: LinearGradient(h, 0, h, h): EndIf      
      Box(2, 2, w-4,h-4)      
   StopDrawing() 
   
   ProcedureReturn pbnr ;gibt immer pbnr zurück, keine id
EndProcedure

Procedure.i GetGradientColor(pbnr)
   Protected x, y, color
   x = GetGadgetAttribute(pbnr, #PB_Canvas_MouseX)
   y = GetGadgetAttribute(pbnr, #PB_Canvas_MouseY) 
   StartDrawing(CanvasOutput(pbnr))
      color = Point(x,y)
   StopDrawing()
   ProcedureReturn color
EndProcedure


GradientGadget(10, 22, 22, 220, 25)
nr = GradientGadget(#PB_Any, 250, 22, 25, 200, 1)

TextGadget(20, 20, 99, 200, 30, "Hallo", #PB_Text_Border)
SetGadgetFont(20, FontID(10))

Repeat
   Event = WaitWindowEvent()      
   Select Event            
      Case #PB_Event_Gadget
         gadget = EventGadget()
         Select gadget
            Case 10, nr :  
               If EventType() = #PB_EventType_LeftClick
                  color = GetGradientColor(gadget)
                  SetGadgetText(20, "$"+RSet(Hex(color), 6, "0"))
                  SetGadgetColor(20, #PB_Gadget_BackColor, color)
                  SetGadgetColor(20, #PB_Gadget_FrontColor, ~ color & $FFFFFF) ;invertiert die Farbe                     
               EndIf
         EndSelect
         
   EndSelect
Until Event = #PB_Event_CloseWindow

[jacdelad]

Mir gefällt's. Was stellst du dir denn unter "besser vor"?

[hjbremer]

na einen schöneren weicheren Verlauf mit gefälligen Abstufungen und möglichst vielen Farbmischungen

also die eierlegende Wollmilchsau

[jacdelad]

Da fällt mir nur ein mehr Zwischenstufen in die Gradienten einzubauen. Ne eigene Formel zusammenzuklampfen dürfte ein Stückchen Arbeit sein...

[hjbremer]

Ja das habe ich auch bemerkt,
denn was ich da habe hat auch etwas gedauert
bis ich eine Regenbogen Liste als Inspiration genommen habe.

aber könnte ja sein das ein User das schon mal gemacht hat

UND bereit ist seine Arbeit zu teilen