Poznámka: Tento článek je převzat z předchůdce serveru LŽIVĚ.cz - K.P.U.V.N.P.M (Kanceláře Pro Uvádění Věcí Na Pravou Míru), kterážto má svůj prapůvod v Jirotkově Saturninu - odtud tedy onen příměr s koblihou.

Podle teorie doktora Vlacha se lidé dělí do tří skupin podle chování v poloprázdné
kavárně, mají-li před sebou mísu koblih. Lidé patřící do první skupiny
se budou na koblihy jen tupě dívat, a pak se zvednou a odejdou. Lidé z druhé
skupiny se při pohledu na koblihy baví představou, co by se dělo, kdyby jimi
zčistajasna začali ostatní návštěvníky kavárny bez výstrahy bombardovat. A lidi
ze třetí skupiny láká představa koblih svištících vzduchem natolik, že vstanou
a uskuteční ji. Ve snaze alespoň se přiblížit této třetí kategorii jsme po
vzoru Jirotkova Saturnina založili tuto Kancelář pro uvádění věcí na pravou
míru. Nyní pozvedám ruku ve které třímám svou první koblihu. Zakrátko zasviští
vzduchem. Bude hexadecimální a namířím ji na pana Zdeňka Cendru - tedy ne přímo
na něj, ale na jeho ne zcela podařený článek.

Autor ve svém článku prohlašuje za problém převést barevné složky RGB
na Hexadecimální vyjádření "RRGGBB", se kterým si rozumí všechny browsery.
Tento "problém" pak vyřeší napsáním funkce, která je nepřehledná, pomalá a
hlavně ne zcela funkční - najdete určité kombinace složek RGB, pro které funkce
havaruje a generování stránky skončí Runtime errorem - viz diskuse pod článkem.
S určitou dávkou nadsázky lze prohlásit, že jediné co je na funkci správně jsou
klíčová slova function a end function.

Nejprve jsem neměl v plánu zveřejnit zdrojový kód původní funkce AEW() u nás. Jednak nechci aby mě pan Cendra později napadal, že
jsem ukradl jeho ...ehm... know how, a druhak a to hlavně, nechci vás unavovat
"sprostou kritikou", jak tento mladý autor rád říká všem výtkám na svou adresu. Ale server netday.cz je v této chvíli mimo provoz, takže funkci najdete v prvním komentáři pod článkem.

Jen tak na okraj - zadávat barvy "ručně" ve tvaru "RRGGBB" přece není žádný problém!
A pokud ovládáte styly, jste takříkajíc za vodou a máte design svých stránek
(včetně barev) pevně ve svých rukou. Ale o stylech tenhle článek být nemá.
Takže dejme tomu, že z nějakého důvodu opravdu potřebujeme funkci pro převod RGB
složek na hexadecimální tvar "RRGGBB". Může se nám hodit např. pokud chceme
nechat volbu barev na uživateli. Nechceme ale použít funkci RGB() obsaženou ve VBScriptu, protože vrací barevné složky v jiných bytech než potřebujeme - "BBGGRR".

Pak by funkce mohla vypadat takto:
<%
function RGBToHex (intRed,
intGreen, intBlue)
RGBToHex = Right("00000" + Hex(65536*intRed +
256*intGreen + intBlue),6)
end function
%>

Jak funkce funguje?
Vstupní
parametry intRed, intGreen,
intBlue jsou
barevné složky, každá v rozsahu jeden byte. Naše funkce netestuje korektnost
předaných parametrů. Na určitém stupni musíme s kontrolou přestat - jinak by na
světě byli samí bachaři. Ale vážně - místo pro umístění kontroly volíme tak aby
se kontrola vykonávala co nejméněkrát - nejlépe jen jednou pro stejnou hodnotu
proměnné.

RRGGBB je tříbajtové číslo - nejvyšší byte reprezentuje červenou, prostřední
byte zelenou a nejnižší byte modrou barevnou složku. Prvním krokem tedy bude
získání tohoto tříbajtového čísla:

číslo = 65536*intRed + 256*intGreen + intBlue

funkce VBScriptu Hex(číslo) nám vrátí řetězec s hexadecimálním vyjádřením
čísla.

To ale ještě nestačí - pro správné zobrazení celé
barevné škály musíme zajistit aby funkce vracela vždy šest znaků - Přidáním nul
zleva a funkce VBScriptu Right(řetězec,délka)

toho snadno dosáhneme.

Nyní už jen zbývá funkci zavolat:
<%
...
response.write ("<FONT color=""" & RGBToHex(128,128,255) & """>Testujeme</FONT>")
...
%>

Že se vám na tom zápisu něco nezdá? Máte naprostou pravdu - nutíme server aby
při každém zpracování stránky volal funkci se stále stejnými parametry a vracel
stále stejnou hodnotu. Ruku na srdce, pane Cendro - nepoužíváte tu svoji funkce
právě takhle? Pro testování funkce to samozřejmě použít můžeme, ale do "ostré"
aplikace se plýtvání strojovým časem nehodí. Zvedat výkonnost špatně napsané
aplikace je tvrdá práce - byť aplikaci přepisujete sám po sobě. Lepší je snažit
se neplýtvat výkonem hned od začátku a v podobných případech použít
konstantu.

Tolik k převodu RGB na "RRGGBB". Ale na pravou míru
zbývá uvést ještě jedna věc. A tou je funkce Hex()
. Pan Cendra jí nepoužil a převod do šestnáctkové
soustavy si napsal sám. V diskusi pod článkem pak tvrdí, že je "vidět postup".
K.P.U.V.N.P.M. bohužel ani po usilovném pátrání žádný postup nenašla. Proto
uvedeme ještě funkci naší, na které doufáme postup vidět bude.

Abychom nedělali úplně zbytečně funkci, která je již ve
VBScriptu obsažena, trochu si upravíme zadání - představte si že programujeme
web pro matematiky a ti po nás chtějí vypsat číslo v osmičkové a šestnáctkové
soustavě. Víme, že můžeme použít vestavěné funkce Hex(číslo) a
Oct(číslo) ,

ale co když si na nás matematici
za týden vymyslí výpis obecně v jakékoli číselné soustavě? Raději se tedy
na to připravme dopředu a nachystejme vlastní funkci s předstihem.

Nejprve trocha šedivé teorie. Nebojte, nebudeme si malovat číselné osy a
dokazovat, že 1 + 1 = 2, jen si řekneme, že:

základ číselné soustavy je počet číslic (obecně symbolů), kterými vyjadřujeme
hodnotu řádu čísla
řád - je tedy část čísla vyjádřená právě jedním
symbolem.

Podstatné pro nás je, že ve vyjádření řádu bude vždy číslice (symbol)
vyjadřující menší hodnotu než je základ soustavy. Tedy vydělíme-li celočíselně
(se zbytkem) číslo základem soustavy ve zbytku po dělení bude hodnota nejnižšího
řádu a ve výsledku dělení číslo snížené o jeden řád. (z desítek jsou jedničky,
ze stovek desítky...)

Uvedeme si to na příkladu z desítkové soustavy.

zbytek po dělení zjistíme operátorem mod
128 mod 10 = 8
pro
celočíselné dělení použijeme operátor (není totožný s operátorem / !)
128
10 = 12

můžeme říci, že číslo 128 obsahuje osm jedniček a dvanáct desítek,
dvanáct ale je ještě moc (je to více než základ soustavy 10 - nelze tedy vyjádřit jedním
symbolem), proto budeme pokračovat:

12 mod 10 = 2
12 10 = 1

číslo obsahuje dvě desítky a budeme pokračovat dále - posuneme se o další
řád:

1 mod 10 = 1
1 10 = 0

Máte pravdu - jsme hotovi - dále už není co dělit. A poslední zbytek po

dělení 1 nám prozradil počet stovek obsažených v zadaném čísle.

A protože výše uvedené platí obecně, nejenom pro desítkovou soustavu, můžeme
směle tento postup převést do funkce:


<%
Function LngToStr(lngNumber, intBase)
LngToStr = ""
if intBase >=2 and intBase<=16 then
Const strNumbers = "0123456789ABCDEF"
do
LngToStr = Mid(strNumbers, (lngNumber Mod intBase) + 1, 1) & LngToStr
lngNumber = lngNumber intBase
loop While lngNumber > 0
end if
End Function
%&gt;

Jak funkce funguje jsme si vlastně už řekli, takže jen pár
vysvětlení:
Vstupní parametry:
lngNumber - číslo které chceme
převést
intBase - základ soustavy ve které chceme číslo zobrazit. (platný rozsah je 2 -
16)
O kontrolách a
bachařích už jsme mluvili, ale v tomto případě hrozí nekonečná smyčka - pokud
předáme intBase = 1, nebo Runtime Error pro intBase =

0. Takže jsme testování intBase na platný rozsah do funkce zařadili. Zatím na
nás servery při nekonečné smyčce jen tiše a vyčítavě bručí svou sběrnicí, ale V
blízké budoucnosti by nám mohly začít hlasitě a "uměle inteligentně" nadávat. A
to nechceme riskovat.

strNumbers - řetězcová konstanta ,
která bude sloužit jako tabulka symbolů (číslic). Funkce tak jak je zde uvedena
bude fungovat od dvojkové do šestnáctkové soustavy. Pokud jste matematici,
můžete chtít rozšířit základ směrem nahoru. Pak jednoduše doplňte tuto tabulku o
příslušný počet symbolů a upravte test rozsahu paramertu
intBase.

v cyklu vykonáme tyto kroky
-
nejprve zjistíme zbytek po celočíselném dělení čísla základem (lngNumber
Mod intBase).
- Tento zbytek určuje pozici v
tabulce symbolů (chcete-li číslic a symbolů) a pomocí funkce
Mid()
si z
tabulky příslušný symbol vyzvedneme. (musíme přičíst jedničku protože tabulka má
první prvek na pozici 1 nikoliv 0).
- celočíselně vydělíme převáděné číslo
lngNumber základem intBase a výsledek si
uložíme opět do proměnné lngNumber
.

Celý cyklus vykonáváme tak dlouho dokud máme co dělit,
neboli dokud platí lngNumber > 0
.
Aby funkce vrátila "0" i pro lngNumber=0, testujeme tuto
podmínku až na konci cyklu, aby proběhl alespoň jednou.

Když se na tento pricip podíváme obráceně, můžeme celkem snadno napsat i
reverzní funkci, které předáme řetězec symbolů a základ soustavy a ona vám vrátí
číselnou hodnotu. Ale to už není třeba uvádět na pravou míru takže to nechám na
vás.

Tjádydádydá - to je vše přátelé. Hexadecimální kobliha právě dopadla. Co
myslíte? Byla to trefa? Já myslím že ano. Myslíte-li si něco jiného tak
neváhejte a uveďte mě na pravou míru!

A protože kopírujeme z jiného serveru, přidáme sem i zápis původního algoritmu páně Cendry....

Function AEW(intCislo, intCislo1, intCislo2)

intCislo = Cint(intCislo)

intCislo1 = Cint(intCislo1)

intCislo2 = Cint(intCislo2)

For x = 1 to 3

If x = 2 Then

intCislo = intCislo1

End If

If x = 3 Then

intCislo = intCislo2

End If

If intCislo > 0 And intCislo 16 Then

intVysledek = intCislo / 16

intPoziceCarka = InStr(intVysledek, ",")

intPoziceCarka = intPoziceCarka - 1

If intPoziceCarka > 0 Then

intKratkeCislo = Left(intVysledek, intPoziceCarka)

Else

intKratkeCislo = intCislo

End If

intZbytek = (intCislo Mod 16)

strPismenko = Array("A", "B", "C", "D", "E", "F")

If intKratkeCislo > 9 Then

intUpravenePismenko = intKratkeCislo - 10

strVystup = strVystup & strPismenko(intUpravenePismenko)

Else

intUpravenePismenko = intKratkeCislo

strVystup = strVystup & intUpravenePismenko

End If

If intZbytek < 10 Then

strVystup = strVystup & intZbytek

Else

intUpravenePismenko = intZbytek - 10

strVystup = strVystup & strPismenko(intUpravenePismenko)

End IF

ElseIf intCislo = 16 Then

strVystup = strVystup & "10"

Else

strVystup = strVystup & "00"

End If

Next

AEW = strVystup

End Function

Příklad:

Response.Write(AEW("255", "100", "180"))

...a toť vše...