{*******************************************************************}
{                                                                   }
{       Almediadev Visual Component Library                         }
{       BusinessSkinForm                                            }
{       Version 6.15                                                }
{                                                                   }
{       Copyright (c) 2000-2008 Almediadev                          }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{       Home:  http://www.almdev.com                                }
{       Support: support@almdev.com                                 }
{                                                                   }
{*******************************************************************}

unit bsColorCtrls;

interface

uses Windows, SysUtils, Messages, Classes, Graphics, Controls, Forms,
     BusinessSkinForm, bsSkinData, bsSkinCtrls, bsSkinBoxCtrls, Dialogs,
     StdCtrls, ExtCtrls, bsEffects, bsSkinMenus, ImgList;

type

  TbsCustomColorValues = array[1..12] of TColor;

  TbsSkinCustomColorGrid = class(TbsSkinPanel)
  private
    FColorValue: TColor;
    FOnChange: TNotifyEvent;
    FColCount, FRowCount: Integer;
    FColorIndex: Integer;
    procedure SetColCount(Value: Integer);
    procedure SetRowCount(Value: Integer);
  protected
    procedure DrawCursor(Cnvs: TCanvas; R: TRect);
    procedure CreateControlDefaultImage(B: TBitMap); override;
    procedure CreateControlSkinImage(B: TBitMap); override;
    procedure PaintGrid(Cnvs: TCanvas);
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure PaintTransparent(C: TCanvas); override;
  public
    CustomColorValues: TbsCustomColorValues;
    FColorsCount: Integer;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AddColor(AColor: TColor);
  published
    property RowCount: Integer read FRowCount write SetRowCount;
    property ColCount: Integer read FColCount write SetColCount;
    property ColorValue: TColor read FColorValue;
    property OnChange: TNotifyEvent  read FOnChange write FOnChange;
  end;

  TbsEmptyControl = class(TCustomControl)
  protected
    procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
  public
    procedure Paint; override;
  end;

  TbsSkinColorGrid = class(TbsSkinPanel)
  private
    FColorValue: TColor;
    FOnChange: TNotifyEvent;
    FColCount, FRowCount: Integer;
    procedure SetColCount(Value: Integer);
    procedure SetRowCount(Value: Integer);
    procedure SetColorValue(Value: TColor);
  protected
    procedure DrawCursor(Cnvs: TCanvas; R: TRect);
    function CheckColor(Value: TColor): boolean;
    procedure CreateControlDefaultImage(B: TBitMap); override;
    procedure CreateControlSkinImage(B: TBitMap); override;
    procedure PaintGrid(Cnvs: TCanvas);
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure PaintTransparent(C: TCanvas); override;  
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property RowCount: Integer read FRowCount write SetRowCount;
    property ColCount: Integer read FColCount write SetColCount;
    property ColorValue: TColor read FColorValue write SetColorValue;
    property OnChange: TNotifyEvent  read FOnChange write FOnChange;
  end;

  TbsColorViewer = class(TGraphicControl)
  private
    FColorValue: TColor;
    procedure SetColorValue(Value: TColor);
  public
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;
  published
    property ColorValue: TColor read FColorValue write SetColorValue;
  end;

  const
    CalcEpsilon: Double = 1E-8;
    CalcRadian: Double = 3.1415926536 / 180;
    RectPSP: TRect = (Left:44; Top:44; Right:150; Bottom:150);
    RectActCol: TRect = (Left:21; Top:20; Right:69; Bottom:70);
    RectPreCol: TRect = (Left:21; Top:95; Right:69; Bottom:145);
    PalettePSPCoord: TRect = (Left:0; Top:0; Right:195; Bottom:195);
    MaxPixelCount = 32768;

  type

    THSL = record
      H, S, L: Double;
    end;

    TRGB = record
      R, G, B : byte;
    end;

    THSLPSP = record
      H, S, L: Byte;
    end;

    TPSPColor = class
    private
      FRGB : TRGB;
      FHSL : THSL;
      FHSLPSP : THSLPSP;
      function HSLToRGB (Value: THSL): TRGB;
      function RGBToHSL (Value: TRGB): THSL;
      function HSLToHSLPSP:THSLPSP;
      function HSLPSPToHSL:THSL;
      procedure SetRGB(const Value: TRGB);
      procedure SeTHSL(const Value: THSL);
      procedure SeTHSLPSP(const Value: THSLPSP);
    public
      constructor Create;
      destructor Destroy;override;
      procedure Assign(const Value : TPSPColor);
      property RGB : TRGB read FRGB write SetRGB;
      property HSL : THSL read FHSL write SeTHSL;
      property HSLPSP : THSLPSP read FHSLPSP write SeTHSLPSP;
    end;

  TClickZonePSP = (czpspPnone, czpspPCircle, czpspPCar);
  TLineB = array of Byte;
  TLineI = array of Integer;
  PRGBArray = ^TRGBArray;
  TRGBArray = array[0..MaxPixelCount - 1] of TRGBTriple;

  TbsSkinColorDialog = class(TComponent)
  private
    RGBStopCheck: Boolean;
    HSLStopCheck: Boolean;
    FromPSP: Boolean;
  protected
    FGroupBoxTransparentMode: Boolean;
    FColor: TColor;
    FCaption: String;
    FSD: TbsSkinData;
    FCtrlFSD: TbsSkinData;
    FButtonSkinDataName: String;
    FEditSkinDataName: String;
    FLabelSkinDataName: String;
    FDefaultLabelFont: TFont;
    FDefaultEditFont: TFont;
    FDefaultButtonFont: TFont;
    FAlphaBlend: Boolean;
    FAlphaBlendAnimation: Boolean;
    FAlphaBlendValue: Byte;
    FUseSkinFont: Boolean;
    //
    ColorGrid: TbsSkinColorGrid;
    CustomColorGrid: TbsSkinCustomColorGrid;
    OkButton, CancelButton, AddCustomColorButton: TbsSkinButton;
    ColorViewer: TbsColorViewer;
    REdit, GEdit, BEdit: TbsSkinTrackEdit;
    RLabel, GLabel, BLabel, EQLabel: TbsSkinStdLabel;
    HEdit, LEdit, SEdit: TbsSkinTrackEdit;
    HLabel, LLabel, SLabel: TbsSkinStdLabel;
    //
    PalettePSPPanel: TbsEmptyControl;
    PalettePSP: TImage;
    PosCircle, PosCar: Integer;
    ClickImg: TClickZonePSP;
    PSPColor : TPSPColor;
    CustomColorValues: TbsCustomColorValues;
    CustomColorValuesCount: Integer;
    function CalcAngle3Points(X1, Y1, Xc, Yc, X2, Y2: Double): Double;
    function CalcAnglePoints(X1, Y1, X2, Y2: Double): Double;
    procedure CalcAngle360(var Angle: Double);
    function CalcDistancePoints(X1, Y1, X2, Y2: Double): Double;
    function CalcArcCosRadians(CosAngle: Double): Double;
    function CalcArcSinRadians(SinAngle: Double): Double;
    procedure CalcRotationPoint(Xc, Yc: Double; Angle: Double; X1, Y1: Double; var X2, Y2: Double);
    procedure CalcPointSurEllipse(Xc, Yc: Double; RayonX, RayonY: Double; Angle: Double; var X, Y: Double);
    function CalcArcTan(TanAngle: Double): Double;
    procedure InitPSPPalette;
    procedure DrawPSPPalette;
    procedure DrawCursor;
    procedure PalettePSPMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PalettePSPMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PalettePSPMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    //
    procedure SetDefaultLabelFont(Value: TFont);
    procedure SetDefaultButtonFont(Value: TFont);
    procedure SetDefaultEditFont(Value: TFont);
    procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
    procedure ColorGridChange(Sender: TObject);
    procedure CustomColorGridChange(Sender: TObject);
    procedure RGBEditChange(Sender: TObject);
    procedure HSLEditChange(Sender: TObject);
    procedure AddCustomColorButtonClick(Sender: TObject);
    procedure ChangeEdits;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean;
  published
    property GroupBoxTransparentMode: Boolean
      read FGroupBoxTransparentMode write FGroupBoxTransparentMode;
    property Color: TColor read FColor write FColor;
    property Caption: String read FCaption write FCaption;
    property AlphaBlend: Boolean read FAlphaBlend write FAlphaBlend;
    property AlphaBlendValue: Byte read FAlphaBlendValue write FAlphaBlendValue;
    property AlphaBlendAnimation: Boolean
      read FAlphaBlendAnimation write FAlphaBlendAnimation;
    property SkinData: TbsSkinData read FSD write FSD;
    property CtrlSkinData: TbsSkinData read FCtrlFSD write FCtrlFSD;
    property ButtonSkinDataName: String
      read FButtonSkinDataName write FButtonSkinDataName;
    property LabelSkinDataName: String
      read FLabelSkinDataName write FLabelSkinDataName;
    property EditSkinDataName: String
     read FEditSkinDataName write FEditSkinDataName;
    property DefaultLabelFont: TFont read FDefaultLabelFont write SetDefaultLabelFont;
    property DefaultButtonFont: TFont read FDefaultButtonFont write SetDefaultButtonFont;
    property DefaultEditFont: TFont read FDefaultEditFont write SetDefaultEditFont;
    property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
  end;

  TbsSkinColorButton = class(TbsSkinMenuSpeedButton)
  private
    FColorMenu: TbsSkinImagesMenu;
    FColorImages: TCustomImageList;
    FAutoColor: TColor;
    FOnChangeColor: TNotifyEvent;
    FShowAutoColor: Boolean;
    FShowMoreColor: Boolean;
    FColorDialog: TbsSkinColorDialog;

    procedure SetShowAutoColor(Value: Boolean);
    procedure SetShowMoreColor(Value: Boolean);

    procedure SetColorValue(Value: TColor);

    procedure OnImagesMenuClick(Sender: TObject);
    procedure OnImagesMenuPopup(Sender: TObject);

    function GetMenuDefaultFont: TFont;
    procedure SetMenuDefaultFont(Value: TFont);
    function GetMenuUseSkinFont: Boolean;
    procedure SetMenuUseSkinFont(Value: Boolean);
    function GetMenuAlphaBlend: Boolean;
    procedure SetMenuAlphaBlend(Value: Boolean);
    function GetMenuAlphaBlendAnimation: Boolean;
    procedure SetMenuAlphaBlendAnimation(Value: Boolean);
    function GetMenuAlphaBlendValue: Integer;
    procedure SetMenuAlphaBlendValue(Value: Integer);
  protected
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure InitColors;
  published
    property AutoColor: TColor read FAutoColor write FAutoColor;
    property ColorValue: TColor read FColorMarkerValue write SetColorValue;
    property ShowAutoColor: Boolean read FShowAutoColor write SetShowAutoColor;
    property ShowMoreColor: Boolean read FShowMoreColor write SetShowMoreColor;
    property ColorDialog: TbsSkinColorDialog read FColorDialog write FColorDialog;

    property MenuUseSkinFont: Boolean read GetMenuUseSkinFont write SetMenuUseSkinFont;
    property MenuDefaultFont: TFont read GetMenuDefaultFont write SetMenuDefaultFont;
    property MenuAlphaBlend: Boolean read GetMenuAlphaBlend write SetMenuAlphaBlend;
    property MenuAlphaBlendValue: Integer read GetMenuAlphaBlendValue write SetMenuAlphaBlendValue;
    property MenuAlphaBlendAnimation: Boolean read GetMenuAlphaBlendAnimation write SetMenuAlphaBlendAnimation;

    property OnChangeColor: TNotifyEvent read FOnChangeColor write FOnChangeColor;
  end;

  TbsSkinBrushColorButton = class(TbsSkinColorButton);

  TbsSkinTextColorButton = class(TbsSkinMenuSpeedButton)
  private
    FColorMenu: TbsSkinImagesMenu;
    FColorImages: TCustomImageList;
    FAutoColor: TColor;
    FOnChangeColor: TNotifyEvent;
    FShowAutoColor: Boolean;
    FShowMoreColor: Boolean;
    FColorDialog: TbsSkinColorDialog;
    procedure SetColorValue(Value: TColor);

    procedure OnImagesMenuClick(Sender: TObject);
    procedure OnImagesMenuPopup(Sender: TObject);

    function GetMenuDefaultFont: TFont;
    procedure SetMenuDefaultFont(Value: TFont);
    function GetMenuUseSkinFont: Boolean;
    procedure SetMenuUseSkinFont(Value: Boolean);
    function GetMenuAlphaBlend: Boolean;
    procedure SetMenuAlphaBlend(Value: Boolean);
    function GetMenuAlphaBlendAnimation: Boolean;
    procedure SetMenuAlphaBlendAnimation(Value: Boolean);
    function GetMenuAlphaBlendValue: Integer;
    procedure SetMenuAlphaBlendValue(Value: Integer);

  protected
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
  public
    procedure InitColors;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property AutoColor: TColor read FAutoColor write FAutoColor;
    property ColorValue: TColor read FColorMarkerValue write SetColorValue;
    property ShowAutoColor: Boolean read FShowAutoColor write FShowAutoColor;
    property ShowMoreColor: Boolean read FShowMoreColor write FShowMoreColor;
    property ColorDialog: TbsSkinColorDialog read FColorDialog write FColorDialog;

    property MenuUseSkinFont: Boolean read GetMenuUseSkinFont write SetMenuUseSkinFont;
    property MenuDefaultFont: TFont read GetMenuDefaultFont write SetMenuDefaultFont;
    property MenuAlphaBlend: Boolean read GetMenuAlphaBlend write SetMenuAlphaBlend;
    property MenuAlphaBlendValue: Integer read GetMenuAlphaBlendValue write SetMenuAlphaBlendValue;
    property MenuAlphaBlendAnimation: Boolean read GetMenuAlphaBlendAnimation write SetMenuAlphaBlendAnimation;

    property OnChangeColor: TNotifyEvent read FOnChangeColor write FOnChangeColor;
  end;



implementation

Uses bsUtils, Math, bsConst;

const
  ColorValues: array[1..48] of TColor =

  (0, 64, 128, 4210816, 255, 8421631, 32896, 16512, 33023, 4227327, 65535, 8454143,
   4227200, 16384, 32768, 65280, 65408, 8454016, 8421504, 4210688, 4227072, 8421376, 4259584, 8453888,
   8421440, 8388608, 16711680, 8404992, 16776960, 16777088, 12632256, 4194304, 10485760, 16744576, 12615680, 16744448,
   4194368, 5194368, 8388736, 4194432, 12615808, 12615935, 16777215, 8388672, 16711808, 8388863, 16711935, 16744703);


procedure ColorToR_G_B(C: TColor; var R, G, B: Byte);
begin
  R := C and $FF;
  G := (C shr 8) and $FF;
  B := (C shr 16) and $FF;
end;

function R_G_BToColor(R, G, B: Byte): TColor;
begin
  Result := RGB(R, G, B);
end;

procedure RGBToHSL1(AR, AV, AB: Byte; var H, S, L: Double);
var
  R,
  G,
  B,
  D,
  Cmax,
  Cmin: double;
begin
  R := AR / 255;
  G := AV / 255;
  B := AB / 255;
  Cmax := Max (R, Max (G, B));
  Cmin := Min (R, Min (G, B));
  L := (Cmax + Cmin) / 2;
  if Cmax = Cmin
  then
    begin
      H := 0;
      S := 0
    end
  else
    begin
      D := Cmax - Cmin;
      if L < 0.5 then S := D / (Cmax + Cmin) else S := D / (2 - Cmax - Cmin);
      if R = Cmax
      then
        H := (G - B) / D
      else
        if G = Cmax then H  := 2 + (B - R) /D else H := 4 + (R - G) / D;
      H := H / 6;
      if H < 0 then  H := H + 1;
    end;
end;

procedure RGBToHSL2(AR, AG, AB: Byte; var H, S, L: Integer);
var
  RGB: array[0..2] of Double;
  MinIndex, MaxIndex: Integer;
  Range: Double;
  H1 : Double;
begin
  RGB[0]:= AR;
  RGB[1]:= AG;
  RGB[2]:= AB;

  MinIndex:= 0;
  if AG < AR then MinIndex:= 1;
  if AB < RGB[MinIndex] then MinIndex:= 2;

  MaxIndex:= 0;
  if AG > AR then MaxIndex:= 1;
  if AB > RGB[MaxIndex] then MaxIndex:= 2;
  Range:= RGB[MaxIndex] - RGB[MinIndex];

  if Range = 0
  then
    begin
      S := 0;
      L := Round(100 * AR / 255); 
    end
  else
    begin
      H1 := MaxIndex * 2 + (AR - AG) / Range;
      S := Round(Range / RGB[MaxIndex] * 100);
      L :=  Round(100 * (RGB[MaxIndex] / 255));
      H1 := H1 / 6;
      if H1 < 0 then H1 := H1 + 1;
      H := Round(H1 * 359);
    end;
end;

procedure RGBToHSL(AR, AG, AB: Byte; var RH, RS, RL: Integer);
var
  H, S, L: Double;
begin
  RGBToHSL1(AR, AG, AB, H, S, L);
  RGBToHSL2(AR, AG, AB, RH, RS, RL);
  if RS <> 0 then RH := Round(H * 359);
end;

procedure HSLToRGB(var R, G, B: Byte; RH, RS, RL: Integer);
const 
  SectionSize = 60/360;
var 
  Section: Double; 
  SectionIndex: Integer; 
  f, p, q, t, H, S, L: Double;
begin
  H := RH / 360;
  S := RS / 100;
  L := (255 * RL / 100);
  if S = 0
  then
    begin
      R := Round(L);
      G := R;
      B := R;
    end
  else
   begin
     Section := H / SectionSize;
     SectionIndex := Floor(Section);
     f := Section - SectionIndex;
     p := L * ( 1 - S );
     q := L * ( 1 - S * f );
     t := L * ( 1 - S * ( 1 - f ) );