Procedure HDPI fix

[Everything]

This simple procedure draws a color chart background for blending with x color

Code: Select all

Procedure CreateColorChartImg()
  Protected x.l, y.l
  
    ColorChart = CreateImage(#PB_Any, 256, 256, 32)
    StartDrawing(ImageOutput(ColorChart))
    DrawingMode(#PB_2DDrawing_AlphaChannel)
    Box(0, 0, 256, 256, 0)
    DrawingMode(#PB_2DDrawing_AlphaBlend)
    For x = 0 To 255
      For y = 0 To 255
        Plot(255 - x, y, RGBA($FF, $FF, $FF, x))
        Plot(255 - x, y, RGBA(0, 0, 0, y))
      Next
    Next
    StopDrawing()    

EndProcedure

and since I was going to update app that using it for HDPI support I was faced with the problem of how to rewrite this procedure so that the DPI value was involved...
I guess resizing the image will not give the most acceptable result so I want to solve this problem programmatically. How to do it in the right way?

[mk-soft]

Not tested...

Update

Code: Select all

Procedure CreateColorChartImg()
  Protected x.i, y.i, dx.i, dy.i
  
    dx = DesktopScaledX(256)
    dy = DesktopScaledY(256)
    
    ColorChart = CreateImage(#PB_Any, dx, dy, 32)
    StartDrawing(ImageOutput(ColorChart))
    DrawingMode(#PB_2DDrawing_AlphaChannel)
    Box(0, 0, dx, dy, 0)
    DrawingMode(#PB_2DDrawing_AlphaBlend)
    dx - 1
    dy - 1
    For x = 0 To dx
      For y = 0 To dy
        Plot(dx - x, y, RGBA($FF, $FF, $FF, x))
        Plot(dx - x, y, RGBA(0, 0, 0, y))
      Next
    Next
    StopDrawing()    

EndProcedure

[breeze4me]

modified code.

Code: Select all

Procedure CreateColorChartImg()
  Protected x.i, y.i, dx.i, dy.i
  
    dx = DesktopScaledX(256)
    dy = DesktopScaledY(256)
    
    ColorChart = CreateImage(#PB_Any, dx, dy, 32)
    StartDrawing(ImageOutput(ColorChart))
    DrawingMode(#PB_2DDrawing_AlphaChannel)
    Box(0, 0, dx, dy, 0)
    DrawingMode(#PB_2DDrawing_AlphaBlend)
    dx - 1
    dy - 1
    For x = 0 To dx
      For y = 0 To dy
        Plot(dx - x, y, RGBA($FF, $FF, $FF, x * 255 / dx))
        Plot(dx - x, y, RGBA(0, 0, 0, y * 255 / dy))
      Next
    Next
    StopDrawing()    

EndProcedure

[Everything]

Thx
Let me clarify some points - this is color picker chart and it must be accurate and smooth. What we want is:



in first code (Not tested one) we have



in second one



and it's close but if we look closely



there is some kind of grids inside another grid. Not accurate and not smooth at all...

Tested with

Code: Select all

dx = 320 ; DesktopScaledX(256)
dy = 320 ; DesktopScaledY(256)

[Mijikai]

Try something like this:

Code: Select all

Procedure.i CreateColorChart(Factor.f = 1)
  Protected img.i
  Protected is.i
  Protected ix.i
  Protected iy.i
  Protected id.i
  Protected xx.i
  Protected yy.i
  Protected ir.i
  ir = 256 * Round(Factor,#PB_Round_Up)
  is = 256 * Factor
  img = CreateImage(#PB_Any,ir,ir,32)
  If IsImage(img)
    If StartDrawing(ImageOutput(img))
      DrawingMode(#PB_2DDrawing_AlphaChannel)
      Box(0,0,ir,ir,$0)
      DrawingMode(#PB_2DDrawing_AlphaBlend)
      id = ir / 256
      For ix = 0 To ir - 1
        For iy = 0 To ir - 1
          Box(ir - ix,iy,id,id,RGBA($FF,$FF,$FF,ix / id))
          Box(ir - ix,iy,id,id,RGBA($00,$00,$00,iy / id))
          yy + id
        Next
        yy = 0
        xx + id
      Next
      StopDrawing()
      If ResizeImage(img,is,is)
        ProcedureReturn img
      EndIf
    EndIf
    FreeImage(img)
  EndIf
  ProcedureReturn #Null
EndProcedure

[Everything]

Mijikai
Thx, that's almost what I need, the only thing there is a small "shift bug"
Here is gif animation (reference vs code output):



1 pixel >> right

Tested with

Code: Select all

CreateColorChart(1.25)

[Mijikai]

This will fix it:

Code: Select all

;change ResizeImage(img,is,is) to:
ResizeImage(img,is,is,#PB_Image_Raw)

Smooth seems not to work as exspected.

[Everything]

This bug exist before resizing

[Mijikai]

Have u tried the fix?

[Everything]

Yes.
The only change I've notice is that left pixel stripe become darker.

[RASHAD]

My 2 cents

Code: Select all

Procedure CreateColorChartImg()
 Scale = 1.25
 ColorChart = CreateImage(#PB_Any, 256*Scale, 256*Scale, 32)
  StartVectorDrawing(ImageVectorOutput(ColorChart))
  VectorSourceLinearGradient(0, 0, 0 , VectorOutputHeight())
  VectorSourceGradientColor(RGBA(255, 255, 255, 255), 0.0)
  VectorSourceGradientColor(RGBA(0, 0, 0 , 255), 1.0)
      
 AddPathBox(0, 0, VectorOutputWidth(), VectorOutputHeight())
 FillPath()

 StopVectorDrawing()
EndProcedure

[Everything]

My 2 cents

Thanks!
If you'll add something like:

Code: Select all

SaveImage(ColorChart, "test.bmp") 

last line of your procedure you'll see that

1. image still at 256x256 ( you forgot .f)
2. and most important thing - color chart "gradient" looks absolutely not like this

vs yours

[RASHAD]

I am just pointing you to the right direction
Am I ?
The right gradient I think

Code: Select all

Global ColorChart , Scale.f
Scale = 1.5

Procedure CreateColorChartImg() 
 CreateImage(0, 256*scale, 256*scale, 24)
  StartVectorDrawing(ImageVectorOutput(0))
  For y = 1 To 256*scale
    VectorSourceLinearGradient(0, y, VectorOutputWidth() , 0)
    VectorSourceGradientColor(RGBA(255, 255, 255, 255), 0.0)
    VectorSourceGradientColor(RGBA(0, 0, 0 , 255), 1.0)
  Next    
  AddPathBox(0, 0, VectorOutputWidth(), VectorOutputHeight())
  FillPath()
 StopVectorDrawing()
 ColorChart = CreateImage(#PB_Any, 256*scale, 256*scale, 24)
 StartVectorDrawing(ImageVectorOutput(ColorChart))
    MovePathCursor(0,256*scale)    
    FlipCoordinatesY(180)
    DrawVectorImage(ImageID(0), 255)
 StopVectorDrawing()
 FreeImage(0)
 SaveImage( ColorChart, GetHomeDirectory()+"colorchart.bmp") 
EndProcedure

flags = #PB_Window_SystemMenu| #PB_Window_MaximizeGadget| #PB_Window_MinimizeGadget| #PB_Window_ScreenCentered | #PB_Window_SizeGadget
OpenWindow(0,0,0,800,600,"Test",Flags)
CreateColorChartImg()
ImageGadget(0,10,10,256*scale,256*scale,ImageID(ColorChart)) 
Repeat
           
  Select WaitWindowEvent()      
    Case #PB_Event_CloseWindow
      Quit = 1       
 
  EndSelect 

Until Quit = 1
End

In case you need it exactly as you posted

Code: Select all

Procedure CreateColorChartImg()
 CreateImage(0, 256*scale, 256*scale, 24)
  StartVectorDrawing(ImageVectorOutput(0))
  For y = 1 To 256*scale
    VectorSourceLinearGradient(0, y, VectorOutputWidth() , 0)
    VectorSourceGradientColor(RGBA(0, 0, 0 , 255), 0.0)
    VectorSourceGradientColor(RGBA(255, 255, 255, 255), 1.0)        
  Next   
  AddPathBox(0, 0, VectorOutputWidth(), VectorOutputHeight())
  FillPath()
 StopVectorDrawing()
 ColorChart = CreateImage(#PB_Any, 256*scale, 256*scale, 24)
 StartVectorDrawing(ImageVectorOutput(ColorChart))
    MovePathCursor(256*scale,0)   
    FlipCoordinatesX(180)
    DrawVectorImage(ImageID(0), 255)
 StopVectorDrawing()
 FreeImage(0)
 SaveImage( ColorChart, GetHomeDirectory()+"colorchart.bmp")
EndProcedure

[Everything]

I am just pointing you to the right direction
Am I ?

Well in fact gradients way it's the first thing I tried but things not so simple as they looks like...

Ref vs your gradient way

vs

it's a little bit more complicated than just pure linear Brightness Y \ Saturation X as you see... (in this case of course no saturation until we blend it with some color, so nevermind)
Or I miss something?

[RASHAD]

When it comes to color ask StarGate
You will get the right answer
Still I think your gradient not OK by any means

Code: Select all

EnableExplicit
;- Include

Structure ColorGadget_HSVA
   Hue.f
   Saturation.f
   Value.f
   Alpha.i
EndStructure

#ColorGadget_ChannelSize = 24

Procedure.i ColorGadget_Max(Value1.i=0, Value2.i=0, Value3.i=0, Value4.i=0)
   Protected MaxValue.i = 0
   If Value1 > MaxValue : MaxValue = Value1 : EndIf
   If Value2 > MaxValue : MaxValue = Value2 : EndIf
   If Value3 > MaxValue : MaxValue = Value3 : EndIf
   If Value4 > MaxValue : MaxValue = Value4 : EndIf
   ProcedureReturn MaxValue
EndProcedure

Procedure.i ColorGadget_Min(Value1.i=255, Value2.i=255, Value3.i=255, Value4.i=255)
   Protected MinValue.i = 255
   If Value1 < MinValue : MinValue = Value1 : EndIf
   If Value2 < MinValue : MinValue = Value2 : EndIf
   If Value3 < MinValue : MinValue = Value3 : EndIf
   If Value4 < MinValue : MinValue = Value4 : EndIf
   ProcedureReturn MinValue
EndProcedure

Procedure.l ColorGadget_SetHSVA(Hue.f, Saturation.f, Value.f, Alpha.i=255) ; [0,360[, [0,1], [0,255]
   If Hue < 0 : Hue = 0 : ElseIf Hue >= 360 : Hue = 360 : EndIf
   If Saturation > 1.0 : Saturation = 1.0 : ElseIf Saturation < 0.0 : Saturation = 0.0 : EndIf
   If Value > 255 : Value = 255 : ElseIf Value < 0 : Value = 0 : EndIf
   If Alpha > 255 : Alpha = 255 : ElseIf Alpha < 0 : Alpha = 0 : EndIf
   Protected H.i = Int(Hue/60)
   Protected f.f = (Hue/60-H)
   Protected p.i = Value * (1-Saturation)
   Protected q.i = Value * (1-Saturation*f)
   Protected t.i = Value * (1-Saturation*(1-f))
   Select H
      Case 1 : ProcedureReturn RGBA(q,Value,p,Alpha)
      Case 2 : ProcedureReturn RGBA(p,Value,t,Alpha)
      Case 3 : ProcedureReturn RGBA(p,q,Value,Alpha) 
      Case 4 : ProcedureReturn RGBA(t,p,Value,Alpha)
      Case 5 : ProcedureReturn RGBA(Value,p,q,Alpha) 
      Default : ProcedureReturn RGBA(Value,t,p,Alpha)
   EndSelect
EndProcedure

Procedure ColorGadget_GetHVSA(Color.l, *HSVA.ColorGadget_HSVA)
   Protected Max.i = ColorGadget_Max(Red(Color),Green(Color),Blue(Color))
   Protected Min.i = ColorGadget_Min(Red(Color),Green(Color),Blue(Color))
   *HSVA\Value = Max
   If Max = 0 : *HSVA\Saturation = 0 : Else : *HSVA\Saturation = (Max-Min)/Max : EndIf
   If Max = Min
      *HSVA\Hue = 0
   ElseIf Max = Red(Color)
      *HSVA\Hue = 60.0*(  (Green(Color)-Blue(Color))/(Max-Min))
      If *HSVA\Hue < 0 : *HSVA\Hue + 360 : EndIf
   ElseIf Max = Green(Color)
      *HSVA\Hue = 60.0*(2+(Blue(Color)-Red(Color))/(Max-Min))
   Else 
      *HSVA\Hue = 60.0*(4+(Red(Color)-Green(Color))/(Max-Min))
   EndIf
   *HSVA\Alpha = Alpha(Color)
EndProcedure

Procedure DrawColorGadget(Gadget.i, Color.l)
   Protected BoxWidth.i, BoxHeight.i, X.i, Y.i, Alpha.i
   Protected HSVA.ColorGadget_HSVA
   ColorGadget_GetHVSA(Color, @HSVA)
   If StartDrawing(CanvasOutput(Gadget))
      BoxWidth = OutputWidth()-#ColorGadget_ChannelSize-1
      BoxHeight = OutputHeight()-#ColorGadget_ChannelSize-1
      Box(0, 0, BoxWidth+1, BoxHeight+1, ColorGadget_SetHSVA(HSVA\Hue, 1, 255))
      DrawingMode(#PB_2DDrawing_Gradient|#PB_2DDrawing_AlphaBlend)
      LinearGradient(0, 0, 0, BoxHeight)
      GradientColor(0.0, $FFFFFFFF) : GradientColor(1.0, $00FFFFFF)
      Box(0, 0, BoxWidth+1, BoxHeight+1)
      LinearGradient(0, 0, BoxWidth, 0)
      ResetGradientColors()
      GradientColor(0.0, $FF000000) : GradientColor(1.0, $00000000)
      Box(0, 0, BoxWidth+1, BoxHeight+1)
      DrawingMode(#PB_2DDrawing_XOr)
      Box(HSVA\Value*BoxWidth/255-1, HSVA\Saturation*BoxHeight-5, 3, 11)
      Box(HSVA\Value*BoxWidth/255-5, HSVA\Saturation*BoxHeight-1, 11, 3)
      DrawingMode(#PB_2DDrawing_Default)
      For Y = 0 To BoxHeight
         Line(BoxWidth+1, Y, #ColorGadget_ChannelSize, 1, ColorGadget_SetHSVA(Y*360.0/BoxHeight, HSVA\Saturation, HSVA\Value))
      Next
      For X = 0 To BoxWidth+#ColorGadget_ChannelSize Step 6
         For Y = 0 To #ColorGadget_ChannelSize-1 Step 6
            If X%12 XOr Y%12
               Box(X, BoxHeight+1+Y, 6, 6, $A0A0A0)
            Else
               Box(X, BoxHeight+1+Y, 6, 6, $606060)
            EndIf
         Next
      Next
      DrawingMode(#PB_2DDrawing_AlphaBlend)
      For X = 0 To BoxWidth
         Alpha = X*255.0/BoxWidth
         Line(X, BoxHeight+1, 1, #ColorGadget_ChannelSize, Color&$FFFFFF|Alpha<<24)
      Next
      DrawingMode(#PB_2DDrawing_XOr)
      Box(BoxWidth+1, BoxHeight*HSVA\Hue/360-1, #ColorGadget_ChannelSize, 3)
      Box(HSVA\Alpha*BoxWidth/255-1, BoxHeight+1, 3, #ColorGadget_ChannelSize)
      DrawingMode(#PB_2DDrawing_AlphaBlend)
      Box(BoxWidth+1, BoxHeight+1, #ColorGadget_ChannelSize, #ColorGadget_ChannelSize, Color)
      StopDrawing()
   EndIf
   SetGadgetData(Gadget, Color)
EndProcedure

Procedure ColorGadget(Gadget.i, X.i, Y.i, Width.i, Height.i, DefaultColor.l=$FF000000)
   If Gadget = #PB_Any
      Gadget = CanvasGadget(Gadget, X, Y, Width, Height);, #PB_Canvas_GrabMouse)
   Else
      CanvasGadget(Gadget, X, Y, Width, Height);, #PB_Canvas_GrabMouse)
   EndIf
   DrawColorGadget(Gadget, DefaultColor)
EndProcedure

Procedure ColorGadgetEvent(Gadget.i, EventType.i)
   Static Mode.i = #Null
   Protected X.i = GetGadgetAttribute(Gadget, #PB_Canvas_MouseX)
   Protected Y.i = GetGadgetAttribute(Gadget, #PB_Canvas_MouseY)
   Protected BoxWidth.i = GadgetWidth(Gadget)-#ColorGadget_ChannelSize-1
   Protected BoxHeight.i = GadgetHeight(Gadget)-#ColorGadget_ChannelSize-1
   Protected Color = GetGadgetData(Gadget)
   Protected HSVA.ColorGadget_HSVA
   ColorGadget_GetHVSA(Color, @HSVA)
   Select EventType
      Case #PB_EventType_LeftButtonDown
         If X <= BoxWidth And Y <= BoxHeight
            Mode = 1
         ElseIf X > BoxWidth And Y <= BoxHeight
            Mode = 2
         ElseIf Y > BoxHeight And X <= BoxWidth
            Mode = 3
         EndIf
      Case #PB_EventType_LeftButtonUp
         Mode = #Null
      Case #PB_EventType_MouseMove
   EndSelect
   Select Mode
      Case 1
         SetGadgetAttribute(Gadget, #PB_Canvas_Cursor, #PB_Cursor_Arrows)
      Case 2
         SetGadgetAttribute(Gadget, #PB_Canvas_Cursor, #PB_Cursor_UpDown)
      Case 3
         SetGadgetAttribute(Gadget, #PB_Canvas_Cursor, #PB_Cursor_LeftRight)
      Default
         SetGadgetAttribute(Gadget, #PB_Canvas_Cursor, #PB_Cursor_Default)
   EndSelect
   If Mode
      Select EventType
         Case #PB_EventType_MouseMove, #PB_EventType_LeftButtonDown
            Select Mode
               Case 1
                  HSVA\Saturation = Y/BoxHeight
                  HSVA\Value = 255.0 * X/BoxWidth
               Case 2
                  HSVA\Hue = 360.0 * Y/BoxHeight
               Case 3
                  HSVA\Alpha = 255.0 * X/BoxWidth
            EndSelect
            DrawColorGadget(Gadget, ColorGadget_SetHSVA(HSVA\Hue, HSVA\Saturation, HSVA\Value, HSVA\Alpha))
            ProcedureReturn #True
      EndSelect
   EndIf
EndProcedure

Procedure GetColorGadgetColor(Gadget.i)
   ProcedureReturn GetGadgetData(Gadget)
EndProcedure

Procedure SetColorGadgetColor(Gadget.i, Color.l)
   DrawColorGadget(Gadget, Color)
EndProcedure


;- Beispiel

Enumeration
   #Window
   #ColorGadget
EndEnumeration

OpenWindow(#Window, 0, 0, 300, 300, "ColorGadget", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)

ColorGadget(#ColorGadget, 10, 10, 280, 280, $C050F0A0)

Repeat
   
   Define.i Event = WaitWindowEvent()
   
   Select Event
         
      Case #PB_Event_CloseWindow
         End
         
      Case #PB_Event_Gadget
         Select EventGadget()
            Case #ColorGadget
               ColorGadgetEvent(#ColorGadget, EventType())
         EndSelect
         
   EndSelect
   
ForEver