Palette de couleurs

Palette(20,20,16): ' appel de la sub
Terminate
' ==============================================================================
SUB Palette(x%,y%,nbc%)
  ' Affichage d'une palette de 16 ou 216 couleurs (couleurs HTML) en x%,y% de l'écran
  ' nbc% = 16 ou 216, x% et y% en valeurs absolues dans l'écran.
  ' Couleur choisie rendue en ascii dans le clipboard sous la forme "r,g,b"
  ' exemple: "192,102,64"
  IF LABEL("Chcoul") = 0 THEN LABEL Chcoul
  IF LABEL("Retpal") = 0 THEN LABEL Retpal
  DIM_LOCAL w%,h%,e%,nr%,a$,r,g,b,i,j,ff
  ff = 0
  DATA "Palette16"
  DATA 0,0,0,0,0,128,0,0,255,0,128,0,0,128,128,0,255,0,0,255,255,128,0,0
  DATA 128,0,128,128,128,0,128,128,128,192,102,192,255,0,0,255,0,255,255,255,0,255,255,255
  w% = 20: h% = 15: e% = 3
  IF nbc% <> 16 AND nbc% <> 216 THEN nbc% = 16
  nr% = 2: IF nbc% = 216 THEN nr% = 27
  PICTURE 949: FULL_SPACE 949: i=WIDTH(0)-WIDTH(949): j=HEIGHT(0)-HEIGHT(949): DELETE 949
  FORM 949: BORDER_SMALL 949: TOP 949,y%: LEFT 949,x%: WIDTH 949,w%*8+e%*8+i
    HEIGHT 949,(h%+e%)*nr%+25+j: CAPTION 949," - PALETTE  "+STR$(nbc%)+"  COULEURS -"
    FONT_NAME 949,"Arial": FONT_BOLD 949
  PICTURE 950: PARENT 950,949: WIDTH 950,w%*8+e%*7: HEIGHT 950,(h%+e%)*nr%
    ON_CLICK 950,Chcoul
  PICTURE 951: PARENT 951,949: TOP 951,HEIGHT(950): WIDTH 951,w%*2+e%
    HEIGHT 951,24: COLOR 951,0,0,0
  ALPHA 952: PARENT 952,949: TOP 952,TOP(951)-2: LEFT 952,WIDTH(951)+5
    CAPTION 952,"# 00 00 00"+CHR$(10)+" 0, 0, 0"
  BUTTON 953: PARENT 953,949: TOP 953,TOP(951): WIDTH 953,60: LEFT 953,WIDTH(950)-60
    CAPTION 953,"OK": ON_CLICK 953,Retpal
  2D_TARGET_IS 950
  SELECT nbc%
      CASE 16
          RESTORE: READ a$: WHILE a$<>"Palette16": READ a$: END_WHILE
          FOR j = 0 TO 1
              y% = j*(h%+e%)
              FOR i = 0 TO 7
                  READ r: READ g: READ b: x% = i*(w%+e%)
                  2D_FILL_COLOR r,g,b: 2D_RECTANGLE x%,y%,x%+w%,y%+h%
              NEXT i
          NEXT j
      CASE 216
          r = 0: g = 0: b = 0
          FOR j=0 TO 26
              y% = j*(h%+e%)
              FOR i = 0 TO 7
                  x% = i*(w%+e%): ' 2D_PEN_COLOR r,g,b:
                  2D_FILL_COLOR r,g,b
                  2D_RECTANGLE x%,y%,x%+w%,y%+h%
                  b = b+51
                  IF b>255
                      b = 0: g = g+51
                      IF g>255
                          g = 0: r = r+51
                      END_IF
                  END_IF
              NEXT i
          NEXT j
  END_SELECT
  2D_TARGET_IS 951
  WHILE ff = 0: PAUSE 100: END_WHILE: DELETE 949
  CLIPBOARD_STRING_COPY STR$(r)+","+STR$(g)+","+STR$(b)
  EXIT_SUB
' =====
Chcoul:
  x% = MOUSE_X_LEFT_DOWN(950): y% = MOUSE_Y_LEFT_DOWN(950)
  r=COLOR_PIXEL_RED(950,x%,y%): g=COLOR_PIXEL_GREEN(950,x%,y%): b=COLOR_PIXEL_BLUE(950,x%,y%)
  2D_FILL_COLOR r,g,b: 2D_RECTANGLE 0,0,WIDTH(951),HEIGHT(951)
  a$ = "# "+RIGHT$("0"+HEX$(r),2)+" "+RIGHT$("0"+HEX$(g),2)+" "+RIGHT$("0"+HEX$(b),2)+CHR$(10)
  a$ = a$+" "+STR$(r)+", "+STR$(g)+", "+STR$(b): CAPTION 952,a$
RETURN
' =====
Retpal:
  ff = 1
RETURN
END_SUB
' ==============================================================================

' palette de couleur collective

label pick ,laquage
dim d,a$,r,g,b,ct,h$,i,v,rt,vt,bt,rtt,vtt,btt,y
dim cpt% : cpt%=1530
dim rbi,gbi,bbi,rpl,gpl,bpl,rbo,gbo,bbo,rpa,gpa,bpa,rdt,gdt,bdt
init()
timer 99:timer_interval 99,10:on_timer 99,pick
end

laquage:

2d_target_is 114
2d_fill_solid
2d_clear
2d_pen_width 1
2d_pen_color 250,250,250
2d_fill_color rbi,gbi,bbi
2d_rectangle 0,0,190,160
2d_fill_color rbo,gbo,bbo
2d_rectangle 0,160,190,315
2d_fill_color rpa,gpa,bpa
2d_rectangle 190,0,310,315
2d_fill_color rpl,gpl,bpl
2d_rectangle 310,0,368,315
file_save 114,"bi-mat.bmp"
return

' Tracé des cases
pick:
timer_off 99
r = color_pixel_red(1,mouse_x_position(1),mouse_y_position(1))
g = color_pixel_green(1,mouse_x_position(1),mouse_y_position(1))
b = color_pixel_blue(1,mouse_x_position(1),mouse_y_position(1))
h$ = right$("0"+hex$(r),2)+right$("0"+hex$(g),2)+right$("0"+hex$(b),2)
ct=65536*r+256*g+b
a$ = "R= "+right$("  "+str$(r),3)+chr$(10)+"G= "+right$("  "+str$(g),3)+chr$(10)+"B= "+right$("  "+str$(b),3)
a$=a$+chr$(10)+h$+chr$(10)+str$(ct)
caption 4,a$
color 2,r,g,b
if clicked (1)=1
  2d_target_is 8
  r=r:v=g:b=b:rt=r:vt=v:bt=b:rtt=0:vtt=0:btt=0
    for y=0 to 126
      rtt=rtt+(r/127) : vtt=vtt+(v/127): btt=btt+(b/127)
      2d_pen_color int(rtt),int(vtt),int(btt):2d_pen_width 15 :2d_line 10,y,10,y
    next y
  r=r:v=g:b=b:rt=r:vt=v:bt=b:rtt=r:vtt=g:btt=b
    for y=0 to 126
      rtt=rtt+((255-r)/127) : vtt=vtt+((255-v)/127): btt=btt+((255-b)/127)
      2d_pen_color int(rtt),int(vtt),int(btt):2d_pen_width 15 :2d_line 30,y,30,y
    next y
end_if

if clicked(8)=1
  r = color_pixel_red(8,mouse_x_position(8),mouse_y_position(8))
  g = color_pixel_green(8,mouse_x_position(8),mouse_y_position(8))
  b = color_pixel_blue(8,mouse_x_position(8),mouse_y_position(8))
  h$ = right$("0"+hex$(r),2)+right$("0"+hex$(g),2)+right$("0"+hex$(b),2)
  ct=65536*r+256*g+b
  a$ = "R= "+right$("  "+str$(r),3)+chr$(10)+"G= "+right$("  "+str$(g),3)+chr$(10)+"B= "+right$("  "+str$(b),3)
  a$=a$+chr$(10)+h$+chr$(10)+str$(ct)
  caption 4,a$
  2d_target_is 3
  color 3,r,g,b  :rdt=r:gdt=g:bdt=b
  caption 7,caption$(4)
end_if

if checked (9)=1
  rbi=rdt:gbi=gdt:bbi=bdt
  color 109,rbi,gbi,bbi
end_if

if checked (10)=1
  rpl=rdt:gpl=gdt:bpl=bdt
  color 110,rpl,gpl,bpl
end_if
if checked (11)=1
  rbo=rdt:gbo=gdt:bbo=bdt
  color 111,rbo,gbo,bbo
end_if
if checked (12)=1
  rpa=rdt:gpa=gdt:bpa=bdt
  color 112,rpa,gpa,bpa
end_if
timer_on 99
return



sub init()
width 0,550 : height 0,170: border_small 0: caption 0,"    -  PALETTE  -"
picture 1 : width 1,170 : height 1,128
picture 2 : top 2,20: left 2,175 : width 2,60 : height 2,50
picture 8:left 8,left (2)+width (2)+4: width 8,40:height 8,128
picture 3 : top 3,20: left 3,left(8)+width(8)+4 : width 3,width(2) : height 3,height(2)
picture 109 : top 109,10: left 109,450 : width 109,40 : height 109,15
picture 110 : top 110,30: left 110,450 : width 110,40 : height 110,15
picture 111 : top 111,50: left 111,450 : width 111,40 : height 111,15
picture 112 : top 112,70: left 112,450 : width 112,40 : height 112,15
picture 114 : width 114,358 : height 114,309:top 114,150:left 114,10

alpha 4: top 4,top(2)+height(2)+3: left 4,left(2): font_name 4,"Lucida Console"
alpha 5 : left 5,left(2)+10 : top 5,5 : caption 5,"Survol": font_bold 5
alpha 6 : left 6,left(8)+width (8)+15 : top 6,5 : caption 6,"Choix": font_bold 6
alpha 7: top 7,top(4): left 7,left(3): font_name 7,"Lucida Console"
check 9:top 9,10:left 9, 350:width 9,70:caption 9,"bi-mat"
check 10:top 10,30:left 10, 350:width 10,70:caption 10,"parclose"
check 11:top 11,50:left 11, 350:width 11,70:caption 11,"planche"
check 12:top 12,70:left 12, 350:width 12,70:caption 12,"obturateur"
button 113:top 113,100:left 113,430:caption 113,"validation":on_click 113,laquage
2d_target_is 1
' recuperaton de la palette
if file_exists ("C:\temp\palette.bmp")=1
  file_load 1,"C:\temp\palette.bmp"

else
trace(255,0,0,0,0,1,0)
trace(255,255,0,255,(-1),0,0)
trace(0,255,0,510,0,0,1)
trace(0,255,255,765,0,(-1),0)
trace(0,0,255,1020,1,0,0)
trace(255,0,255,1275,0,0,(-1))
end_if
' show 0
end_sub

' Tracé de la palette

sub trace(n_r,n_v,n_b,n_i,cal_r,cal_v,cal_b)
r=n_r:v=n_v:b=n_b
 for i=n_i to (n_i+254)
    r=r+(cal_r):v=v+(cal_v):b=b+(cal_b):y=0 :rt=r:vt=v:bt=b:rtt=rt:vtt=vt:btt=bt
    for y=0 to 127
      2d_pen_color int(rt),int(vt),int(bt):2d_pen_width 5  :2d_line 5+(i/10),y,5+(i/10),y
      rt=rt+((127-rtt)/127) : vt=vt+((127-vtt)/127): bt=bt+((127-btt)/127)
    next y
    display
    cpt%=cpt%-1 : caption 0,str$(cpt%)
 next i
 file_save 1,"C:\temp\palette.bmp"
Caption 0,"PALETTE stocker"

end_sub