DBR Delphi-Ecke

// Mit "IdentToColor" bzw. "StringToColor" kann man Strings, welche
// Farbidentifizierungen enthalten (wie beispielsweise 'clRed'), in den
// entsprechenden Farbwert umwandeln. Allerdings hört das schon auf, wenn man
// nur 'Red' oder gar 'Rot' schreibt. Die Funktion "TextToColor" erweitert
// deshalb die Funktion "StringToColor". Man kann dabei entweder den Namen der
// Farbe, den Wert der Farbe, die Hex-Darstellung oder die RGB-Funktion in einem
// String übergeben. Zusätzlich wird eine Standard-Farbe angegeben, die man
// zurückerhält, falls die Funktion den String nicht deuten kann.
// Das könnte dann z.B. so aussehen:
// 1. Color := TextToColor('gelb', Color);
// 2. Color := TextToColor('clYellow', Color);
// 3. Color := TextToColor('65535', Color);
// 4. Color := TextToColor('$00FFFF', Color);
// 5. Color := TextToColor('RGB(255, 255, 0)', Color);
// 6. Color := TextToColor('Gzc56i$vt', Color);
// Bei den ersten 5 Beispielen würde "Color" gelb werden, beim 6. Beispiel
// wird "Color" zu "Color", bleibt also gleich.
// Außerdem sind noch ein paar andere Farbnamen verankert, wie z.B. "Hellgrün",
// "Orange", "Taubenblau", "Kreide-Gelb" oder "30% Schwarz" usw. um die
// Funktion auch in selbstgestrickten Grafikprogrammen einsetzen zu können.

// Getestet mit D4 unter WinME

function TextToColor(f: string; ifunknow: integer): integer;   
var sl: TStringlist;   
begin   
  result := ifunknow;  
  f := stringreplace(stringreplace(ansilowercase(trim(f)), #32, '',   
    [rfReplaceAll]), '-', '', [rfReplaceAll]);   
  f := stringreplace(stringreplace(f, 'ü', 'ue',[]), 'ä', 'ae', []);  
  f := stringreplace(stringreplace(f, 'ß', 'ss', [rfReplaceAll]), 'tend', 't', []);  
  if copy(f, 1, 4) = 'rgb(' then begin   
    sl := TStringlist.create;   
    sl.commatext := copy(f, 5, length(f) - 5);   
    try   
      result := rgb(strtoint(sl[0]), strtoint(sl[1]), strtoint(sl[2]));   
    except   
      sl.free;    
      exit; 
    end;   
      sl.free;    
  end else   
    try 
      result := StringToColor(f);  
    except  
      if (f='weiss') or (f='white') then result:=$FFFFFF else 
      if (f='antikweiss') or (f='antiquewhite') then result:=$D7EBFA else 
      if (f='silber') or (f='silver') then result:=$C0C0C0 else 
      if (f='schneeweiss') or (f='schnee') or (f='snow') 
         then result:=$FAFAFF else 
      if (f='grau') or (f='gray') then result := $808080 else 
      if (f='10%schwarz') then result:=$E5E5E5 else  
      if (f='20%schwarz') then result:=$CCCCCC else  
      if (f='30%schwarz') then result:=$B2B2B2 else  
      if (f='40%schwarz') then result:=$999999 else  
      if (f='50%schwarz') then result:=$7F7F7F else  
      if (f='60%schwarz') then result:=$666666 else  
      if (f='70%schwarz') then result:=$4C4C4C else  
      if (f='80%schwarz') then result:=$333333 else  
      if (f='90%schwarz') then result:=$191919 else  
      if (f='gainsboro') then result:=$DCDCDC else  
      if (f='schwarz') or (f='black') then result:=0 else  
  
      if (f='nussbraun') or (f='nuss') or (f='maroon') or (f='kastanie')  
         then result:=$80 else  
      if (f='walnussbraun') or (f='walnuss') then result:=$3366 else  
      if (f='braun') then result:=$336699 else  
      if (f='leuchtbraun') then result:=$66CC else  
      if (f='hellbraun') then result:=$3399CC else  
      if (f='dunkelbraun') then result:=$333366 else  
      if (f='rotbraun') then result:=$3333CC else  
      if (f='schokolade') or (f='chocolate') then result:=$1E69D2 else  
  
      if (f='gruen') or (f='green') then result:=$8000 else   
      if (f='limone') or (f='lime') then result:=$FF00 else   
      if (f='hellgruen') then result:=$66CC33 else   
      if (f='dunkelgruen') then result:=$333300 else   
      if (f='leuchtgruen') then result:=$FF99 else  
      if (f='ozeangruen') or (f='ozean') or (f='ocean')  
         then result:=$999966 else  
      if (f='fruehlingsgruen') or (f='fruehling') or (f='springgreen') 
         then result:=$7FFF00 else 
      if (f='moosgruen') or (f='moos') then result:=$666633 else 
      if (f='waldgruen')or (f='wald') then result:=$336600 else  
      if (f='grasgruen') or (f='gras') then result:=$339900 else  
      if (f='kentuckygruen') or (f='kentucky') then result:=$669933 else  
      if (f='meergruen') or (f='meer') then result:=$99CC33 else  
      if (f='blassgruen') then result:=$99CC99 else   
      if (f='mattgruen') then result:=$CCFFCC else   
      if (f='minzgruen') or (f='minze') or (f='minz') then result:=$99FF99 else  
      if (f='armeegruen') or (f='armee') then result:=$669966 else  
      if (f='pastellgruen') then result:=$99E099 else   
      if (f='avocadogruen') or (f='avocado') then result:=$339966 else  
      if (f='olivgruen') or (f='olive') then result:=$8080 else 
      if (f='gelbgruen') or (f='yellowgreen') then result:=$32CD9A else 
      if (f='khaki') then result:=$669999 else    
    
      if (f='lila') then result:=$CC0099 else   
      if (f='helllila') or (f='hellila') then result:=$FF66CC else   
      if (f='dunkellila') then result:=$660033 else    
      if (f='blasslila') then result:=$CC99CC else    
      if (f='koenigslila') then result:=$CC3399 else   
      if (f='leuchtlila') then result:=$FF33CC else  
      if (f='osterlila') then result:=$FF99CC else   
      if (f='blaulila') then result:=$FF0099 else    
      if (f='traube') then result:=$993366 else  
      if (f='indigo') then result:=$82004B else  
      if (f='pflaume') or (f='pflaumenblau') then result:=$660066 else   
    
      if (f='dunkelviolett') or (f='purple') then result:=$800080 else   
      if (f='magenta') or (f='fuchsia') then result:=$FF00FF else   
      if (f='violett') then result:=$CC66CC else   
      if (f='leuchtviolett') then result:=$FF66FF else  
      if (f='hellviolett') then result:=$FF99FF else   
      if (f='blauviolett') then result:=$FF6699 else  
      if (f='orchidee') then result:=$D355BA else  
      if (f='diestel') then result:=$D8BFD8 else  
      if (f='lavendel') then result:=$FAE6E6 else  
  
      if (f='blau') or (f='blue') then result:=$FF0000 else    
      if (f='marineblau') or (f='navy') or (f='marine')  
         then result:=$800000 else  
      if (f='dunkelmarineblau') or (f='dunkelmarine')   
         then result:=$660000 else    
      if (f='leuchtblau') then result:=$FF3333 else  
      if (f='hellblau') then result:=$FFCC99 else   
      if (f='dunkelblau') then result:=$CC0033 else   
      if (f='taubenblau') or (f='taube') then result:=$FFCCCC else    
      if (f='pastellblau') then result:=$FF9999 else   
      if (f='stahlblau') or (f='stahl') then result:=$FF6666 else   
      if (f='himmelblau') or (f='himmel') then result:=$FFCC33 else    
      if (f='eisblau') or (f='eis') then result:=$FFFF99 else   
      if (f='flussblau') or (f='fluss') then result:=$CC0066 else   
      if (f='azurblau') or (f='azur') then result:=$FF3366 else   
      if (f='sturmblau') or (f='sturm') then result:=$990033 else  
    
      if (f='rot') or (f='red') then result:=$FF else   
      if (f='dunkelrot') then result:=$6666CC else   
      if (f='hellrot') or (f='tropischrosa')then result:=$6666FF else    
      if (f='leuchtrot') then result:=$6600FF else  
      if (f='rubinrot') or (f='rubin') then result:=$99 else   
      if (f='karmesin') or (f='karmesinrot') then result:=$663399 else  
      if (f='weinrot') or (f='wein') then result:=$8000CC else  
      if (f='pastellrot') then result:=$BBBBFF else   
      if (f='koenigsrot') then result:=$6633CC else   
      if (f='ziegelrot') or (f='ziegel') then result:=$33CC else  
      if (f='indischrot') or (f='indisch') then result:=$5C5CCD else  
      if (f='tomatenrot') or (f='tomate') then result:=$4763FF else  
  
      if (f='rosa') or (f='pink') then result:=$CC99FF else    
      if (f='dunkelrosa') then result:=$9966FF else   
      if (f='hellrosa') or (f='blassrosa') then result:=$CCCCFF else 
      if (f='mattrosa') then result:=$9966CC else   
      if (f='leuchtrosa') or (f='sanftrosa') then result:=$9999FF else  
   
      if (f='orange') then result:=$66FF else  
      if (f='hellorange') then result:=$3399FF else  
      if (f='dunkelorange') then result:=$3399 else  
      if (f='leuchtorange') or (f='herbstorange') then result:=$3366FF else  
      if (f='pfirsich') or (f='pfirsichrot') then result:=$B9DAFF else  
      if  (f='koralle') then result:=$6699FF else  
      if (f='lachs') then result:=$7A96E9 else  
  
      if (f='gelb') or (f='yellow') then result:=$FFFF else   
      if (f='leuchtgelb') then result:=$33FFFF else  
      if (f='hellgelb') then result:=$66FFFF else    
      if (f='dunkelgelb') then result:=$CCFF else   
      if (f='pastellgelb') then result:=$66EEEE else   
      if (f='bananengelb') or (f='banane') then result:=$33CCCC else   
      if (f='kreidegelb') or (f='kreide') then result:=$99FFFF else   
      if (f='sandgelb') or (f='sandfarben') or (f='sand')   
         then result:=$99CCFF else   
      if (f='gold') then result:=$3399CC else   
      if (f='mandel') then result:= $CDEBFF else  
      if (f='chiffon') then result:= $CDFAFF else  
      if (f='weizen') then result:= $B3DEF5 else  
  
      if (f='cyan') or (f='aqua') or (f='zyan') then result:=$FFFF00 else   
      if (f='teal') or (f='seegruen') or (f='see')   
         then result:=$808000 else   
      if (f='blaugruen') then result:=$CCCC00 else   
      if (f='dunkelblaugruen') then result:=$999900 else   
      if (f='hellblaugruen') then result:=$CCCC99 else   
      if (f='leuchtblaugruen')  then result:=$FFFF66 else  
      if (f='tuerkis') then result:=$CCFF66;  
    end;   
end;

// Beispielaufruf: 
// Wenn man in einer Combobox einen Farbnamen anwählt, 
// färbt sich Panel1 entsprechend. 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  with combobox1 do begin 
    with items do begin 
      clear; 
      add('Magenta'); 
      add('Lila'); 
      add('Karmesinrot'); 
      add('Azurblau'); 
      add('Pastellblau'); 
      add('Zyan'); 
      add('Khaki'); 
      add('WaldGrün'); 
      add('Armeegrün'); 
      add('Sandgelb'); 
      add('Leuchtendorange'); 
      add('Pfirsich'); 
      add('clBtnFace');
      DropDownCount := count; 
      itemindex := 0; 
      Panel1.color := TextToColor(items[0], 0); 
    end; 
  end; 
end; 
 
procedure TForm1.ComboBox1Change(Sender: TObject); 
begin 
  with combobox1 do
    Panel1.color := TextToColor(items[itemindex], 0); 
end;