Task: Color wheel





Java: import java.awt.*;
import javax.swing.*;

public class ColorWheel {
    public static void main(String[] args) {
        SwingUtilities.invokeLater(new Runnable() {
            public void run() {
                ColorWheelFrame frame = new ColorWheelFrame();
                frame.setVisible(true);
            }
        });
    }

    private static class ColorWheelFrame extends JFrame {
        private ColorWheelFrame() {
            super("Color Wheel");
            setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE);
            getContentPane().add(new ColorWheelPanel());
            pack();
        }
    }

    private static class ColorWheelPanel extends JComponent {
        private ColorWheelPanel() {
            setPreferredSize(new Dimension(400, 400));
        }
        public void paint(Graphics g) {
            Graphics2D g2 = (Graphics2D)g;
            int w = getWidth();
            int h = getHeight();
            int margin = 10;
            int radius = (Math.min(w, h) - 2 * margin)/2;
            int cx = w/2;
            int cy = h/2;
            float[] dist = {0.F, 1.0F};
            g2.setColor(Color.BLACK);
            g2.fillRect(0, 0, w, h);
            for (int angle = 0; angle < 360; ++angle) {
                Color color = hsvToRgb(angle, 1.0, 1.0);
                Color[] colors = {Color.WHITE, color};
                RadialGradientPaint paint = new RadialGradientPaint(cx, cy,
                        radius, dist, colors);
                g2.setPaint(paint);
                g2.fillArc(cx - radius, cy - radius, radius*2, radius*2,
                        angle, 1);
            }
        }
    }

    private static Color hsvToRgb(int h, double s, double v) {
        double hp = h/60.0;
        double c = s * v;
        double x = c * (1 - Math.abs(hp % 2.0 - 1));
        double m = v - c;
        double r = 0, g = 0, b = 0;
        if (hp <= 1) {
            r = c;
            g = x;
        } else if (hp <= 2) {
            r = x;
            g = c;
        } else if (hp <= 3) {
            g = c;
            b = x;
        } else if (hp <= 4) {
            g = x;
            b = c;
        } else if (hp <= 5) {
            r = x;
            b = c;
        } else {
            r = c;
            b = x;
        }
        r += m;
        g += m;
        b += m;
        return new Color((int)(r * 255), (int)(g * 255), (int)(b * 255));
    }
}




VB: Option explicit

Class ImgClass
  Private ImgL,ImgH,ImgDepth,bkclr,loc,tt
  private xmini,xmaxi,ymini,ymaxi,dirx,diry
  public ImgArray()  
  private filename   
  private Palette,szpal 
  
  public property get xmin():xmin=xmini:end property  
  public property get ymin():ymin=ymini:end property  
  public property get xmax():xmax=xmaxi:end property  
  public property get ymax():ymax=ymaxi:end property  
  public property let depth(x)
  if x<>8 and x<>32 then err.raise 9
  Imgdepth=x
  end property     
  
  public sub set0 (x0,y0) 
    if x0<0 or x0>=imgl or y0<0 or y0>imgh then err.raise 9 
    xmini=-x0
    ymini=-y0
    xmaxi=xmini+imgl-1
    ymaxi=ymini+imgh-1    
  end sub
  
  
  Public Default Function Init(name,w,h,orient,dep,bkg,mipal)
  
  dim i,j
  ImgL=w
  ImgH=h
  tt=timer
  loc=getlocale
  
  set0 0,0   
  redim imgArray(ImgL-1,ImgH-1)
  bkclr=bkg
  if bkg<>0 then 
    for i=0 to ImgL-1 
      for j=0 to ImgH-1 
        imgarray(i,j)=bkg
      next
    next  
  end if 
  Select Case orient
    Case 1: dirx=1 : diry=1   
    Case 2: dirx=-1 : diry=1
    Case 3: dirx=-1 : diry=-1
    Case 4: dirx=1 : diry=-1
  End select    
  filename=name
  ImgDepth =dep
  
  if imgdepth=8 then  
    loadpal(mipal)
  end if       
  set init=me
  end function

  private sub loadpal(mipale)
    if isarray(mipale) Then
      palette=mipale
      szpal=UBound(mipale)+1
    Else
      szpal=256  
    
    

, not relevant
   End if  
  End Sub

  
  
  
  Private Sub Class_Terminate
    
    if err<>0 then wscript.echo "Error " & err.number
    wscript.echo "copying image to bmp file"
    savebmp
    wscript.echo "opening " & filename & " with your default bmp viewer"
    CreateObject("Shell.Application").ShellExecute filename
    wscript.echo timer-tt & "  iseconds"
  End Sub
  
    function long2wstr( x)  
      dim k1,k2,x1
      k1=  (x and &hffff&)
      k2=((X And &h7fffffff&) \ &h10000&) Or (&H8000& And (x<0))
      long2wstr=chrw(k1) & chrw(k2)
    end function 
    
    function int2wstr(x)
        int2wstr=ChrW((x and &h7fff) or (&H8000 And (X<0)))
    End Function


   Public Sub SaveBMP
    
    Dim s,ostream, x,y,loc
   
    const hdrs=54 
    dim bms:bms=ImgH* 4*(((ImgL*imgdepth\8)+3)\4)  
    dim palsize:if (imgdepth=8) then palsize=szpal*4 else palsize=0

    with  CreateObject("ADODB.Stream") 
      .Charset = "UTF-16LE"    
      .Type =  2
      .open 
      
      
      
      
      .writetext ChrW(&h4d42)                           
      .writetext long2wstr(hdrs+palsize+bms)            
      .writetext long2wstr(0)                           
      .writetext long2wstr (hdrs+palsize)               
       
      .writetext long2wstr(40)                          
      .writetext long2wstr(Imgl)                        
      .writetext long2wstr(imgh)                        
      .writetext int2wstr(1)                            
      .writetext int2wstr(imgdepth)                     
      .writetext long2wstr(&H0)                         
       
      .writetext long2wstr(bms)                         
      .writetext long2wstr(&Hc4e)                       
      .writetext long2wstr(&hc43)                       
      .writetext long2wstr(szpal)                       
      .writetext long2wstr(&H0)                         
     
      
      
       Dim x1,x2,y1,y2
       If dirx=-1 Then x1=ImgL-1 :x2=0 Else x1=0:x2=ImgL-1
       If diry=-1 Then y1=ImgH-1 :y2=0 Else y1=0:y2=ImgH-1 
       
      Select Case imgdepth
      
      Case 32
        For y=y1 To y2  step diry   
          For x=x1 To x2 Step dirx
           
           .writetext long2wstr(Imgarray(x,y))
          Next
        Next
        
      Case 8
        
        For x=0 to szpal-1
          .writetext long2wstr(palette(x))  
        Next
        
        dim pad:pad=ImgL mod 4
        For y=y1 to y2 step diry
          For x=x1 To x2 step dirx*2
             .writetext chrw((ImgArray(x,y) and 255)+ &h100& *(ImgArray(x+dirx,y) and 255))
          Next
          
          if pad and 1 then .writetext  chrw(ImgArray(x2,y))
          if pad >1 then .writetext  chrw(0)
         Next
         
      Case Else
        WScript.Echo "ColorDepth not supported : " & ImgDepth & " bits"
      End Select

      
      Dim outf:Set outf= CreateObject("ADODB.Stream") 
      outf.Type    = 1 
      outf.Open
      .position=2              
      .CopyTo outf
      .close
      outf.savetofile filename,2   
      outf.close
    end with
  End Sub
end class



function hsv2rgb( Hue, Sat, Value) 
  dim Angle, Radius,Ur,Vr,Wr,Rdim
  dim r,g,b, rgb
  Angle = (Hue-150) *0.01745329251994329576923690768489
  Ur = Value * 2.55
  Radius = Ur * tan(Sat *0.01183199)
  Vr = Radius * cos(Angle) *0.70710678  
  Wr = Radius * sin(Angle) *0.40824829  
  r = (Ur - Vr - Wr)  
  g = (Ur + Vr - Wr) 
  b = (Ur + Wr + Wr) 
  
  
 if r >255 then 
   Rdim = (Ur - 255) / (Vr + Wr)
   r = 255
   g = Ur + (Vr - Wr) * Rdim
   b = Ur + 2 * Wr * Rdim 
 elseif r < 0 then
   Rdim = Ur / (Vr + Wr)
   r = 0
   g = Ur + (Vr - Wr) * Rdim
   b = Ur + 2 * Wr * Rdim 
 end if 

 if g >255 then 
   Rdim = (255 - Ur) / (Vr - Wr)
   r = Ur - (Vr + Wr) * Rdim
   g = 255
   b = Ur + 2 * Wr * Rdim
 elseif g<0 then   
   Rdim = -Ur / (Vr - Wr)
   r = Ur - (Vr + Wr) * Rdim
   g = 0
   b = Ur + 2 * Wr * Rdim   
 end if 
 if b>255 then
   Rdim = (255 - Ur) / (Wr + Wr)
   r = Ur - (Vr + Wr) * Rdim
   g = Ur + (Vr - Wr) * Rdim
   b = 255
 elseif b<0 then
   Rdim = -Ur / (Wr + Wr)
   r = Ur - (Vr + Wr) * Rdim
   g = Ur + (Vr - Wr) * Rdim
   b = 0
 end If
 
 hsv2rgb= ((b and &hff)+256*((g and &hff)+256*(r and &hff))and &hffffff)
end function

function ang(col,row)
    
    if col =0 then  
      if row<0 then ang=90 else ang=270 end if
    else  
   if col>0 then
      ang=atn(-row/col)*57.2957795130
   else
     ang=(atn(row/-col)*57.2957795130)+180
  end if
  end if
   ang=(ang+360) mod 360  
end function 


Dim X,row,col,fn,tt,hr,sat,row2
const h=160
const w=160
const rad=159
const r2=25500
tt=timer
fn=CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2)& "\testwchr.bmp"
Set X = (New ImgClass)(fn,w*2,h*2,1,32,0,0)

x.set0 w,h


for row=x.xmin+1 to x.xmax
   row2=row*row
   hr=int(Sqr(r2-row2))
   For col=hr To 159
     Dim a:a=((col\16 +row\16) And 1)* &hffffff
     x.imgArray(col+160,row+160)=a 
     x.imgArray(-col+160,row+160)=a 
   next    
   for col=-hr to hr
     sat=100-sqr(row2+col*col)/rad *50
    
     x.imgArray(col+160,row+160)=hsv2rgb(ang(row,col)+90,100,sat)
    next
    
  next  
Set X = Nothing