home *** CD-ROM | disk | FTP | other *** search
/ Chip 2004 October / CMCD1004.ISO / Software / Freeware / Programare / alite / D6 / sColors.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2003-04-16  |  3.5 KB  |  117 lines
  1. unit sColors;
  2. {$I sDefs.inc}
  3.  
  4. interface
  5.  
  6. uses
  7.   Classes, Controls, Graphics, Forms, sConst;
  8.  
  9.  
  10. function RxIdentToColor(const Ident: string; var Color: Longint): Boolean;
  11. function RxColorToString(Color: TColor): string;
  12. function RxStringToColor(S: string): TColor;
  13. procedure RxGetColorValues(Proc: TGetStrProc);
  14.  
  15.  
  16. implementation
  17.  
  18. uses
  19.   Windows, SysUtils, Dialogs;
  20.  
  21.  
  22. type
  23.   TColorEntry = record
  24.     Value: TColor;
  25.     Name: PChar;
  26.   end;
  27.  
  28. const
  29.   ColorCount = 27;
  30.   Colors: array[0..ColorCount - 1] of TColorEntry = (
  31.     (Value: scDarkRed       ; Name: 'scDarkRed'              ),
  32.     (Value: scDarkOrange    ; Name: 'scDarkOrange'           ),
  33.     (Value: scDarkYellow    ; Name: 'scDarkYellow'           ),
  34.     (Value: scDarkGreen     ; Name: 'scDarkGreen'            ),
  35.     (Value: scDarkSky       ; Name: 'scDarkSky'              ),
  36.     (Value: scDarkBlue      ; Name: 'scDarkBlue'             ),
  37.     (Value: scDarkViolet    ; Name: 'scDarkViolet'           ),
  38.     (Value: scDarkBrown     ; Name: 'scDarkBrown'            ),
  39.     (Value: scDarkKaki      ; Name: 'scDarkKaki'             ),
  40.  
  41.     (Value: scRed           ; Name: 'scRed'                  ),
  42.     (Value: scOrange        ; Name: 'scOrange'               ),
  43.     (Value: scYellow        ; Name: 'scYellow'               ),
  44.     (Value: scGreen         ; Name: 'scGreen'                ),
  45.     (Value: scSky           ; Name: 'scSky'                  ),
  46.     (Value: scBlue          ; Name: 'scBlue'                 ),
  47.     (Value: scViolet        ; Name: 'scViolet'               ),
  48.     (Value: scBrown         ; Name: 'scBrown'                ),
  49.     (Value: scKaki          ; Name: 'scKaki'                 ),
  50.  
  51.     (Value: scLightRed      ; Name: 'scLightRed'             ),
  52.     (Value: scLightOrange   ; Name: 'scLightOrange'          ),
  53.     (Value: scLightYellow   ; Name: 'scLightYellow'          ),
  54.     (Value: scLightGreen    ; Name: 'scLightGreen'           ),
  55.     (Value: scLightSky      ; Name: 'scLightSky'             ),
  56.     (Value: scLightBlue     ; Name: 'scLightBlue'            ),
  57.     (Value: scLightViolet   ; Name: 'scLightViolet'          ),
  58.     (Value: scLightBrown    ; Name: 'scLightBrown'           ),
  59.     (Value: scLightKaki     ; Name: 'scLightKaki'            )
  60.  
  61.   );
  62.  
  63. function RxColorToString(Color: TColor): string;
  64. var
  65.   I: Integer;
  66. begin
  67.   if not ColorToIdent(Color, Result) then begin
  68.     for I := Low(Colors) to High(Colors) do
  69.       if Colors[I].Value = Color then
  70.       begin
  71.         Result := StrPas(Colors[I].Name);
  72.         Exit;
  73.       end;
  74.     FmtStr(Result, '$%.8x', [Color]);
  75.   end;
  76. end;
  77.  
  78. function RxIdentToColor(const Ident: string; var Color: Longint): Boolean;
  79. var
  80.   I: Integer;
  81.   Text: array[0..63] of Char;
  82. begin
  83.   StrPLCopy(Text, Ident, SizeOf(Text) - 1);
  84.   for I := Low(Colors) to High(Colors) do
  85.     if StrIComp(Colors[I].Name, Text) = 0 then begin
  86.       Color := Colors[I].Value;
  87.       Result := True;
  88.       Exit;
  89.     end;
  90.   Result := IdentToColor(Ident, Color);
  91. end;
  92.  
  93. function RxStringToColor(S: string): TColor;
  94. var
  95.   I: Integer;
  96.   Text: array[0..63] of Char;
  97. begin
  98.   StrPLCopy(Text, S, SizeOf(Text) - 1);
  99.   for I := Low(Colors) to High(Colors) do
  100.     if StrIComp(Colors[I].Name, Text) = 0 then
  101.     begin
  102.       Result := Colors[I].Value;
  103.       Exit;
  104.     end;
  105.   Result := StringToColor(S);
  106. end;
  107.  
  108. procedure RxGetColorValues(Proc: TGetStrProc);
  109. var
  110.   I: Integer;
  111. begin
  112.   GetColorValues(Proc);
  113.   for I := Low(Colors) to High(Colors) do Proc(StrPas(Colors[I].Name));
  114. end;
  115.  
  116. end.
  117.