utils.pas

FlexGraphics是一套创建矢量图形的VCL组件

unit Utils;

interface

uses
  Windows, Classes, SysUtils, Graphics, FlexBase, FlexProps;

type
  TColorStyles = (
    csNone, csBuildings, csButtons, csSchemeBtn, csZone, csCopyright );

procedure PaintControl(AsActive: boolean; AControl: TFlexControl;
  ColorStyle: TColorStyles);
function CreateSelectionBrush(Color: TColor): TBrush;

implementation

procedure PaintControl(AsActive: boolean; AControl: TFlexControl;
  ColorStyle: TColorStyles);
var Control: TFlexControl;
    PassRec: TPassControlRec;
    Brush: TBrushProp;
    Pen: TPenProp;
    Font: TFontProp;

 function ReplaceColor(Color: TColor): TColor;
 type
   PColorsArray = ^TColorsArray;
   TColorsArray = array[0..2, Boolean] of TColor;
 const
   // color styles
   MainColors: TColorsArray = (
    ( clGray, clGreen  ),
    ( clSilver, clLime ),
    ( clBlack, clBlack {clYellow} )
   );
   BtnColors: TColorsArray = (
    ( clNavy, clBlue  ),
    ( clWhite, $00F0FFC0{clYellow }),
    ( clBlack, clNavy )
   );
   SchemeBtnColors: TColorsArray = (
    ( clNavy, clYellow ),
    ( clWhite, $00C0FFFF{clGreen{clBlue} ),
    ( clBlack, clOlive )
   );
   CopyrightColors: TColorsArray = (
    ( clBlack, clRed),
    ( clWhite, clWhite ),
    ( clWhite, clWhite )
   );
 var
   i: integer;
   IsActive: boolean;
   Colors: PColorsArray;
   R,G,B: byte;
 begin
  Color := ColorToRGB(Color);
  Result := Color;
  if ColorStyle = csNone then exit;
  if ColorStyle = csZone then begin
   // extracting color components
   R := GetRValue(Color);
   G := GetGValue(Color);
   B := GetBValue(Color);
   // check color components
   if G <> $FF then exit;
   if R = $FF then IsActive := true else
   if R = B   then IsActive := false else exit;
   if IsActive = AsActive then exit;
   // Changing color
   if AsActive then begin
    // to yellow shade
    B := R;
    R := G;
   end else begin
    // to green shade
    R := B;
   end;
   // Result color
   Result := RGB(R, G, B);
  end else begin
   case ColorStyle of
    csBuildings : Colors := @MainColors;
    csButtons   : Colors := @BtnColors;
    csSchemeBtn : Colors := @SchemeBtnColors;
    csCopyright : Colors := @CopyrightColors;
    else exit;
   end;
   for i:=0 to High(Colors^) do
    if Color = Colors[i, not AsActive] then begin
     Result := Colors[i, AsActive];
     break;
    end;
  end;
 end;

begin
 if not Assigned(AControl) then exit;
 Control := AControl;
 FirstControl(Control, PassRec);
 while Assigned(Control) do begin
  Brush := TBrushProp(Control.Props['Brush']);
  Pen := TPenProp(Control.Props['Pen']);
  Font := TFontProp(Control.Props['Font']);
  if Assigned(Brush) then
   case Brush.Method of
    bmHatch :
      Brush.Color := ReplaceColor(Brush.Color);
    bmGradient :
      begin
       Brush.GradBeginColor := ReplaceColor(Brush.GradBeginColor);
       Brush.GradEndColor := ReplaceColor(Brush.GradEndColor);
      end;
   end;
  if Assigned(Pen) then
   Pen.Color := ReplaceColor(Pen.Color);
  if Assigned(Font) then begin
   Font.Color := ReplaceColor(Font.Color);
   if (ColorStyle = csCopyright) then
    if AsActive
     then Font.Style := Font.Style + [fsUnderline]
     else Font.Style := Font.Style - [fsUnderline];
  end;
  Control := NextControl(PassRec);
 end;
end;

function CreateSelectionBrush(Color: TColor): TBrush;
var B: TBitmap;
    x,y,n: integer;
begin
 // Create brush texture
 B := TBitmap.Create;
 B.Width := 8;
 B.Height := 8;
 for y:=0 to B.Height-1 do begin
  n := (8-y) mod 8;
  for x:=n to n+3 do
   B.Canvas.Pixels[x mod 8, y] := Color;
  //for x:=n+4 to n+5 do
  // B.Canvas.Pixels[x mod 8, y] := Color;
 end;
 // Set brush texture
 Result := TBrush.Create;
 Result.Bitmap := B;
end;

end.