XProfan

Deutsch

p.specht

Für die Farbcode-Ermittlung für elektronische Kohleschicht-Widerstände älterer Bauart (3-Ring-System) und Metallfilm-Widerstände (4-Ring-System, also nicht SMD) gedacht.

Es mutet erstaunlich an, daß die beim Print-Befehl verwendeten alten DOS-Farben NICHT die bei Bastlern damals sehr bekannten Farbcodes abdecken! Deshalb mußten einige Farben umgetitelt werden, und das fehlende Orange wurde duch (Lila + Hinweis) ersetzt. Klar, daß mit heutigen Analogfarben unter Verwendung von DrawText statt Print bessere Ergebnisse möglich wären. Feel free!

Kompilieren Markieren Separieren

Windowtitle mkstr$(" ",14)+upper$(sperr$("Farbcode von Widerständen"))+"       Taste ´T´= 3\4 Ringe"
' (CL) CopyLeft 2016-12 by P.Specht, Wien/AT ohne jede Gewähr! Farben sehr systemabhängig !!
Cls $A0A0A0:showmax
AppendMenuBar 100,"Im Farbcode wurde Orange durch Lila ersetzt, um die DOS-Printfarben verwenden zu können!"
:proc sperr$ :parameters u$:whileloop len(u$),2,-1:u$=ins$(" ",u$,&Loop):endwhile:return u$:endproc
declare ko&,Farbbez$,Kurzbez$,BgColor$,TxtColor$,Mul$,Prec$
Farbbez$="Silber ,Gold   ,Schwarz,Braun  ,Rot    ,Lila=Orange,Gelb   ,Grün   ,Blau   ,"+\
"Violett,Grau   ,Weiss  ,Dunkelgrün,Dunkelblau,Cyan     ,Türkis    "
Kurzbez$=" Sb,Gld, Sw, Bn, Rt, Or, Gb, Gn, Bl, Vt, Gr, Ws,dGn,dBl,Cyn, Tk"
BgColor$="  7, 6 ,  0,  4, 12, 11, 14, 10,  9,  3,  8, 15,  2,  1,  5, 13"
Txtcolor$="  0, 15, 15, 15, 15, 15,  0,  0, 15, 15, 15,  0, 15, 15, 15,  0"
Mul$="0.1 ,0.01,1   ,10  ,100 ,1  k,10 k,100k,1  M,10 M,,,,,,,"
Prec$=" 5 %=J,10 %=K,, 1 %=F, 2 %=G,,,0.5 %=D,0.25%=C,0.1 %=B,0.05%  ,,,,,,"
luuup:
Cls $A0A0A0:Font 2-2*ko&

whileloop 16

    color val(substr$(Txtcolor$,&Loop,",")),val(substr$(BgColor$,&Loop,","))
    locate 2*&Loop,5 :print " "+substr$(Farbbez$,&Loop,",")+" ";
    locate 2*&Loop,19:print " "+substr$(Kurzbez$,&Loop,",")+"  ";

    if &Loop=12:line 0,320 - width(%hwnd),320:line 210,0 - 210,width(%hwnd):endif

        if &Loop<13

            if &Loop > 2

                locate 2*&Loop,31:print " "+if(&loop>12,""," ")+str$(int(&Loop-3))+"  ";
                locate 2*&Loop,38:print " "+if(&loop>12,""," ")+str$(int(&Loop-3))+"  ";

                if ko&:locate 2*&Loop,45:print " "+if(&loop>12,""," ")+str$(int(&Loop-3))+"  ";:endif

                endif

                if &Loop<11

                    locate 2*&Loop,45+7*ko&
                    print "x "+if(ko&,format$("%g",10^(&Loop-3)),substr$(Mul$,&Loop,","))+" ";

                endif

                locate 2*&Loop,67:print if(substr$(Prec$,&Loop,",")>""," +/-","")+substr$(Prec$,&Loop,",");

            endif

        endwhile

        Waitinput
        case %key=ord("t"):ko&=not(ko&)
        goto "luuup"