XProfan

Italia

p.specht

Metallberufler kennen sie noch aus ihrer Ausbildung: Die Anlass-, Temper- und Glühfarben von Werkzeugstahl - sind sie doch ein einfacher erster Schutz vor Rost oder eine simple Methode zur Temperaturbestimmung in Öfen. Sie dienen auch zum oberflächlichen "Zähermachen" von nieder legierten Stählen sowie zur Verminderung innerer Spannungen in Werkstücken. HIER allerdings dienen sie zur Demonstration per das Verfahren der "Linearen Interpolation", mit dem die Farbzwischenwerte errechnet werden.

P.S.: LCD-Displays sind wegen ihrer starken Höhenwinkelabhängigkeit per die Wiedergabe echter Farben leider nicht sehr geeignet...

Kompilieren Markieren Separieren

WindowTitle "  LINEARE INTERPOLATION:  Anlauffarben unlegierter "+\
"Werkzeugstähle sowie Glühfarben von Stahl"
'(CL) Copyleft 2013-06 by P. Specht, Wien. Keine wie auch immer geartete Gewähr!
'Q: Farbwerte u.a. gemaß Popuptexten der jeweiligen Wikipedia-Artikel = Keine Gewähr!
Windowstyle 1048:Window 0,0-%maxx,%maxy:font 2
print "Farbe, Bezeichnung, Anlaß(<370°C)- bzw. Glüh(>540°C)-Temperatur\n"
var c$="$8F8FBF Stahlblau 20°C#"+"$AFAFAF Oxidgrau 60°C#"+"$DFDFDF Silbergrau 170°C#"+\
"$FFE6AD Weissgelb 200°C#"+"$F0D965 Strohgelb 220°C#"+"$F5C533 Goldgelb 230°C#"+\
"$FFAA01 Gelbbraun 240°C#"+"$C56F00 Braunrot 250°C#"+"$C74805 Rot 260°C#"+\
"$C71B05 Purpurrot 270°C#"+"$5F0284 Violett 280°C#"+"$0D0359 Dunkelblau 290°C#"+\
"$1F0AB1 Kornblumenblau 300°C#"+"$3B72B3 Hellblau 320°C#"+"$7596BF Blaugrau 340°C#"+\
"$A3B2C5 Grau 360°C#"+"$8F8F8F Dunkelgrau 400°C#"+"$404040 Schwarz 480°C#"+\
"$352201 Dunkelbraun 550°C#"+"$542803 Braunrot 630°C#"+"$681002 Dunkelrot 680°C#"+\
"$881500 Dunkelkirschrot 740°C#"+"$A00000 Kirschrot 780°C#"+"$C11B1B Hellkirschrot 810°C#"+\
"$D44115 Hellrot 850°C#"+"$EA572C Gut_Hellrot 900°C#"+"$E97E1C Gelbrot 950°C#"+\
"$FFAA0F Hellgelbrot 1000°C#"+"$FBC034 Gelb 1100°C#"+"$FFCF61 Hellgelb 1200°C#"+\
"$FFE6AD Gelbweiß 1300+°C#"+"$FFE6FF Hellweiß 1300+°C#"+"$FFFFFF Weißglut 1400°C#"+"$FFFFFF Weißglut 1536°C"
Declare a$[]:a$[]=Explode(c$,"#"):Clear c$:Var n&=SizeOf(a$[])-1
Declare b$[],c$[n&,2],r&,g&,b&,rr&,gg&,bb&,rrr&,ggg&,bbb&,i&,c&,cc&,ccc&

whileloop 0,n&:clear b$[]:b$[]=Explode(a$[&loop]," ")

    c$[&loop,0]=b$[0]:c$[&loop,1]=b$[1]:c$[&loop,2]=b$[2]

endwhile

' Lineare Interpolation

whileloop 0,n&-1:i&=&Loop

    r&=val("$"+mid$(c$[i&,0],2,2)):g&=val("$"+mid$(c$[i&,0],4,2)):b&=val("$"+mid$(c$[i&,0],6,2))
    rr&=val("$"+mid$(c$[i&+1,0],2,2)):gg&=val("$"+mid$(c$[i&+1,0],4,2)):bb&=val("$"+mid$(c$[i&+1,0],6,2))
    c&=val(c$[i&,2]):cc&=val(c$[i&+1,2])

    whileloop 0,100,2'Prozent

        rrr&=r&+(rr&-r&)*&Loop/100:ggg&=g&+(gg&-g&)*&Loop/100:bbb&=b&+(bb&-b&)*&Loop/100
        ccc&=c&+(cc&-c&)*&Loop/100 : cls rgb(rrr&,ggg&,bbb&) : print " RGB = ";
        print right$("0"+hex$(rrr&),2);" ";
        print right$("0"+hex$(ggg&),2);" ";
        print right$("0"+hex$(bbb&),2);"                                ";
        locate 1,20:print c$[i&,1];
        locate 1,37:print str$(ccc&);"°C"
        waitinput 120

    endwhile' %

endwhile

waitinput
end