Reading Delphi DFM file - Colors 3

[djjd47130]

I'm manually reading line by line from a delphi DFM (Form) file. When reading the color, it's a straight text line representing colors such as clMaroon, clNavy, clBtnFace... How do I convert one of these colors from a string to a TColor? I tried Google and all I could find is a bunch of crap on converting TColor to HTML Colors.

JD Solutions

 

[towerbase]

I would be tempted to copy the declarations for these colours out of the graphics.pas file. They are like

  clBlack = TColor($000000);
  clMaroon = TColor($000080);
  clGreen = TColor($008000);
  clOlive = TColor($008080);
  clNavy = TColor($800000);
  clPurple = TColor($800080);
  clTeal = TColor($808000);
  clGray = TColor($808080);
....

Then using the macro facility of the Delphi editor convert these into a suitable function which goes along the lines of:

function ColorStringToTColor( const color: string ): TColor;
begin
  if AnsiCompareText( color, 'clMaroon' ) = 0 then
    result := $000080
  else if AnsiCompareText( color, 'clGreen' ) = 0 then
    result := $008000
  else AnsiCompareText( color, 'clOlive' ) = 0 then
    result := $008080
  ...
end;

AnsiCompareText does a case insensitive comparison.

If efficiency was important then I would consider setting up a sorted TStringList and use Find to locate the TColor value which I would store in the TStringLists Objects properties.



Andrew
Hampshire, UK

 

[djjd47130]

Thanks, that halfway helps, except for values such as clBtnFace, which is not a static color, but is extracted from the windows user's preferences. I think I have a solution, like the one you mentioned, I just wish there was an easier way.

JD Solutions

 

[whosrdaddy]

about the system colors:

http://www.swissdelphicenter.ch/torry/showcode.php?id=491

/Daddy

-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!

 

[whosrdaddy]

color name conversion:

http://stackoverflow.com/questions/...olor-constant-from-a-color-stored-as-a-string

/Daddy

-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!

 

[sggaunt]

Its a fair bet that the function uses a lookup table like andrew's, sort of does.

Steve: N.M.N.F.
If something is popular, it must be wrong: Mark Twain

 

[towerbase]

When I looked up the declaration of clBtnFace (in unit graphics.pas) I found it was defined as a constant and not extracted from the users windows preferences.

const
  clSystemColor = $FF000000;
...
  clBtnFace = TColor(clSystemColor or COLOR_BTNFACE);

COLOR_BTNFACE is defined in windows.pas as:

  COLOR_BTNFACE = 15;

So with a little bit of effort it should be fairly straightforward to produce a color name to TColor function.

I'm using Delphi 2009 (in case colors are declared differently in other versions of Delphi).

Andrew
Hampshire, UK

 

[TonHu]

OR-ing clSystemColor onto a code is the Windows way of letting the system color functions know you want a user-settable color like in this case clBtnFace.

 

[towerbase]

Thank you TonHu, I did not know that.

With that knowledge I've come up with the following which I think works.

unit uStringToColor;

interface

uses Graphics;

function StringToColor( const color: string ): TColor;

implementation

uses AnsiStrings
   , Windows
   ;

type
  TColorTableRecord = record
    Text: string;
    Code: integer;
  end;

const
  ColorTable: array [ 0..53 ] of TColorTableRecord =
  ( ( Text:'clScrollBar'; Code:TColor(clSystemColor or COLOR_SCROLLBAR) )
  , ( Text:'clBackground'; Code:TColor(clSystemColor or COLOR_BACKGROUND) )
  , ( Text:'clActiveCaption'; Code:TColor(clSystemColor or COLOR_ACTIVECAPTION) )
  , ( Text:'clInactiveCaption'; Code:TColor(clSystemColor or COLOR_INACTIVECAPTION) )
  , ( Text:'clMenu'; Code:TColor(clSystemColor or COLOR_MENU) )
  , ( Text:'clWindow'; Code:TColor(clSystemColor or COLOR_WINDOW) )
  , ( Text:'clWindowFrame'; Code:TColor(clSystemColor or COLOR_WINDOWFRAME) )
  , ( Text:'clMenuText'; Code:TColor(clSystemColor or COLOR_MENUTEXT) )
  , ( Text:'clWindowText'; Code:TColor(clSystemColor or COLOR_WINDOWTEXT) )
  , ( Text:'clCaptionText'; Code:TColor(clSystemColor or COLOR_CAPTIONTEXT) )
  , ( Text:'clActiveBorder'; Code:TColor(clSystemColor or COLOR_ACTIVEBORDER) )
  , ( Text:'clInactiveBorder'; Code:TColor(clSystemColor or COLOR_INACTIVEBORDER) )
  , ( Text:'clAppWorkSpace'; Code:TColor(clSystemColor or COLOR_APPWORKSPACE) )
  , ( Text:'clHighlight'; Code:TColor(clSystemColor or COLOR_HIGHLIGHT) )
  , ( Text:'clHighlightText'; Code:TColor(clSystemColor or COLOR_HIGHLIGHTTEXT) )
  , ( Text:'clBtnFace'; Code:TColor(clSystemColor or COLOR_BTNFACE) )
  , ( Text:'clBtnShadow'; Code:TColor(clSystemColor or COLOR_BTNSHADOW) )
  , ( Text:'clGrayText'; Code:TColor(clSystemColor or COLOR_GRAYTEXT) )
  , ( Text:'clBtnText'; Code:TColor(clSystemColor or COLOR_BTNTEXT) )
  , ( Text:'clInactiveCaptionText'; Code:TColor(clSystemColor or COLOR_INACTIVECAPTIONTEXT) )
  , ( Text:'clBtnHighlight'; Code:TColor(clSystemColor or COLOR_BTNHIGHLIGHT) )
  , ( Text:'cl3DDkShadow'; Code:TColor(clSystemColor or COLOR_3DDKSHADOW) )
  , ( Text:'cl3DLight'; Code:TColor(clSystemColor or COLOR_3DLIGHT) )
  , ( Text:'clInfoText'; Code:TColor(clSystemColor or COLOR_INFOTEXT) )
  , ( Text:'clInfoBk'; Code:TColor(clSystemColor or COLOR_INFOBK) )
  , ( Text:'clHotLight'; Code:TColor(clSystemColor or COLOR_HOTLIGHT) )
  , ( Text:'clGradientActiveCaption'; Code:TColor(clSystemColor or COLOR_GRADIENTACTIVECAPTION) )
  , ( Text:'clGradientInactiveCaption'; Code:TColor(clSystemColor or COLOR_GRADIENTINACTIVECAPTION) )
  , ( Text:'clMenuHighlight'; Code:TColor(clSystemColor or COLOR_MENUHILIGHT) )
  , ( Text:'clMenuBar'; Code:TColor(clSystemColor or COLOR_MENUBAR) )
  , ( Text:'clBlack'; Code:TColor($000000) )
  , ( Text:'clMaroon'; Code:TColor($000080) )
  , ( Text:'clGreen'; Code:TColor($008000) )
  , ( Text:'clOlive'; Code:TColor($008080) )
  , ( Text:'clNavy'; Code:TColor($800000) )
  , ( Text:'clPurple'; Code:TColor($800080) )
  , ( Text:'clTeal'; Code:TColor($808000) )
  , ( Text:'clGray'; Code:TColor($808080) )
  , ( Text:'clSilver'; Code:TColor($C0C0C0) )
  , ( Text:'clRed'; Code:TColor($0000FF) )
  , ( Text:'clLime'; Code:TColor($00FF00) )
  , ( Text:'clYellow'; Code:TColor($00FFFF) )
  , ( Text:'clBlue'; Code:TColor($FF0000) )
  , ( Text:'clFuchsia'; Code:TColor($FF00FF) )
  , ( Text:'clAqua'; Code:TColor($FFFF00) )
  , ( Text:'clLtGray'; Code:TColor($C0C0C0) )
  , ( Text:'clDkGray'; Code:TColor($808080) )
  , ( Text:'clWhite'; Code:TColor($FFFFFF) )
  , ( Text:'clMoneyGreen'; Code:TColor($C0DCC0) )
  , ( Text:'clSkyBlue'; Code:TColor($F0CAA6) )
  , ( Text:'clCream'; Code:TColor($F0FBFF) )
  , ( Text:'clMedGray'; Code:TColor($A4A0A0) )
  , ( Text:'clNone'; Code:TColor($1FFFFFFF) )
  , ( Text:'clDefault'; Code:TColor($20000000) )
  );


function StringToColor( const color: string ): TColor;
var
  x: integer;
  res: Dword;
begin
  for x := Low(ColorTable) to High(ColorTable) do
    if CompareText( ColorTable[x].Text, color ) = 0 then begin
      res := ColorTable[x].Code;
      if clSystemColor and res = clSystemColor then
        result := Windows.GetSysColor( res and $FFFFFF )
      else
        result := TColor(res);
      Exit;
    end;
//  if we do not exit the function within the for loop then raise an exception
//  or do a MessageDlg, ShowMessage or something to indicate invalid color.
end;

end.

Andrew
Hampshire, UK