
{*******************************************************}
{                                                       }
{       RichViewActions                                 }
{       TRVColorCombo v1.3                              }
{       Combobox with color picker                      }
{                                                       }
{       Copyright (c) 2002-2003, Sergey Tkachenko       }
{       svt@trichview.com                               }
{       http://www.trichview.com                        }
{                                                       }
{*******************************************************}

{
  ----------------------------------------------------------------------------

  History:

  v1.3:
  impr: text strings ('Auto' and 'Transparent' can be modified as properties
    AutoCaption and TransparentCaption)
  new: DefaultCaption: String property - if assigned, displayed instead of
    Auto/Transparent
  v1.2.1:
  fix: TabOrder was not stored
  v1.2:
  chng: DefaultColor is renamed to AutoColor.
  impr: Choosing font color depending on lightness of background color
  v1.1:
  fix: redrawing on changing value of Enabled

  ----------------------------------------------------------------------------

 A component simulating combo box for color selection.
 This is not a real combo box, but looks like it.
 It supports WinXP themes - if UseXPThemes is True.
 The main property is ChosenColor.
 There is also Indeterminate property (True means no color is chosen).
 User can choose from:
 - default color (AutoColor property)
 - 40 predefined colors
 - any color with ColorDialog
 If ColorDialog property is not assigned, a temporal color dialog is
 created.

}
{==============================================================================}

unit RVColorCombo;

interface

{$I RV_Defs.inc}
{$I RichViewActions.inc}

uses
  Windows, Messages, Math, SysUtils, Classes, Controls, StdCtrls, Graphics,
  Forms, Dialogs, RVXPTheme,
  ColorRVFrm{$IFDEF USERVKSDEVTE}, te_theme, te_utils{$ENDIF};

type
  TRVColorCombo = class(TCustomControl)
  private
    { Private declarations }
    FThemeEdit, FThemeCombo: HTheme;
    frm: TfrmColor;
    FAutoColor: TColor;
    FUseXPThemes: Boolean;
    FHot: Boolean;
    FIndeterminate: Boolean;
    FOnColorChange: TNotifyEvent;
    FChosenColor: TColor;
    FColorDialog: TColorDialog;
    FAutoCaption: String;
    FTransparentCaption: String;
    FDefaultCaption: String;
    procedure ColorPickerDestroy(Sender: TObject);
    function GetMinHeight: Integer;
    procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMThemeChanged(var Msg: TMessage); message WM_THEMECHANGED;
    procedure WMNCPaint(var Msg: TMessage); message WM_NCPAINT;
    procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    procedure CMEnabledChanged (var Msg: TMessage); message CM_ENABLEDCHANGED;
    procedure CreateThemeHandle;
    procedure FreeThemeHandle;
    procedure SetUseXPThemes(const Value: Boolean);
    procedure DrawStandard;
    procedure DrawThemed;
    {$IFDEF USERVKSDEVTE}
    procedure DrawKSThemed;
    procedure SNMThemeMessage(var Msg: TMessage); message SNM_THEMEMESSAGE;
    {$ENDIF}
    procedure SetIndeterminate(const Value: Boolean);
    procedure SetChosenColor(const Value: TColor);
    procedure SetColorDialog(const Value: TColorDialog);
    function StoreAutoCaption: Boolean;
    function StoreTransparentCaption: Boolean;
    function GetCaption: String;
  protected
    { Protected declarations }
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Resize; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property ChosenColor: TColor read FChosenColor write SetChosenColor default clNone;
  published
    { Published declarations }
    property AutoColor: TColor read FAutoColor write FAutoColor default clNone;
    property TabStop default True;
    property UseXPThemes: Boolean read FUseXPThemes write SetUseXPThemes  default True;
    property Indeterminate: Boolean read FIndeterminate write SetIndeterminate;
    property OnColorChange: TNotifyEvent read FOnColorChange write FOnColorChange;
    property ColorDialog: TColorDialog read FColorDialog write SetColorDialog;
    property TransparentCaption: String read FTransparentCaption write FTransparentCaption stored StoreTransparentCaption;
    property AutoCaption: String read FAutoCaption write FAutoCaption stored StoreAutoCaption;
    property DefaultCaption: String read FDefaultCaption write FDefaultCaption;

    property Align;
    property Anchors;
    property BiDiMode;
    property DragKind;
    property Constraints;
    property ParentBiDiMode;
    property TabOrder;
    property OnEndDock;
    property OnStartDock;
    property Caption;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
    {$IFDEF RICHVIEWDEF5}
    property OnContextPopup;
    {$ENDIF}
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnStartDrag;
  end;


implementation

resourcestring
  sTransparentCpt = 'Transparent';
  sAutoCpt        = 'Auto';


function GetLuminance(Color: TColor): Integer;
var
  R, G, B: Word;
  cMax, cMin: Double;
begin
  Color := ColorToRGB(Color);
  R := Color and $0000FF;
  G := (Color and $00FF00) shr 8;
  B := (Color and $FF0000) shr 16;
  cMax := Max(Max(R, G), B);
  cMin := Min(Min(R, G), B);
  Result := Round(( ((cMax + cMin) * 240) + 255 ) / ( 2 * 255));
end;


{ TRVColorCombo }

constructor TRVColorCombo.Create(AOwner: TComponent);
begin
  inherited;
  TabStop := True;
  AutoColor := clNone;
  FChosenColor := clNone;
  UseXPThemes := True;
  FAutoCaption := sAutoCpt;
  FTransparentCaption := sTransparentCpt;
  {$IFDEF USERVKSDEVTE}
  AddThemeNotification(Self);
  {$ENDIF}
end;

destructor TRVColorCombo.Destroy;
begin
  {$IFDEF USERVKSDEVTE}
  RemoveThemeNotification(Self);
  {$ENDIF}
  if frm<>nil then begin
    frm.OnDestroy := nil;
    if frm.HandleAllocated then
      frm.Close;
  end;
  inherited;
end;

procedure TRVColorCombo.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited;
  if Button<>mbLeft then
    exit;
  SetFocus;
  if frm<>nil then begin
    frm.Close;
    end
  else begin
    frm := TfrmColor.Create(Application);
    frm.DefaultCaption := DefaultCaption;
    frm.NoSound := True;
    frm.OnDestroy := ColorPickerDestroy;
    frm.Init(AutoColor, ColorDialog, FChosenColor);
    frm.PopupAtControl(Self);
  end;
  Repaint;
end;

procedure TRVColorCombo.ColorPickerDestroy(Sender: TObject);
begin
  if frm.Chosen then begin
    ChosenColor := frm.ChosenColor;
    if Assigned(FOnColorChange) then
      FOnColorChange(Self);
    Invalidate;
  end;
  frm := nil;
end;

procedure TRVColorCombo.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited;
  Repaint;
end;

procedure TRVColorCombo.Paint;
begin
  {$IFDEF USERVKSDEVTE}
  if IsThemeAvailable(CurrentTheme) and CurrentTheme.IsEditDefined(kescComboBox) then
  begin
    DrawKSThemed;
    Exit;
  end;
  {$ENDIF}
  if FThemeCombo=0 then
    DrawStandard
  else
    DrawThemed;
end;

procedure TRVColorCombo.DoEnter;
begin
  inherited;
  Repaint;
end;

procedure TRVColorCombo.DoExit;
begin
  inherited;
  Repaint;
end;


procedure TRVColorCombo.CreateParams(var Params: TCreateParams);
begin
  inherited   CreateParams(Params);
  with Params do begin
    Style := Style or WS_BORDER;
    ExStyle := ExStyle or WS_EX_CLIENTEDGE    
  end;
end;

procedure TRVColorCombo.Resize;
begin
  inherited;
  Height := GetMinHeight;
end;

function TRVColorCombo.GetMinHeight: Integer;
var
  DC: HDC;
  SaveFont: HFont;
  I: Integer;
  SysMetrics, Metrics: TTextMetric;
begin
  DC := GetDC(0);
  GetTextMetrics(DC, SysMetrics);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
  I := SysMetrics.tmHeight;
  if I > Metrics.tmHeight then
    I := Metrics.tmHeight;
  Result := Metrics.tmHeight + I div 4 + GetSystemMetrics(SM_CYBORDER) * 4 + 6;
end;

procedure TRVColorCombo.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin
  Msg.Result := Msg.Result or DLGC_WANTARROWS;
end;

procedure TRVColorCombo.KeyDown(var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_DOWN, VK_F4:
      MouseDown(mbLeft, [], -1, -1);
  end;
end;

procedure TRVColorCombo.CreateWnd;
begin
  inherited;
  CreateThemeHandle;
end;

procedure TRVColorCombo.DestroyWnd;
begin
  inherited;
  FreeThemeHandle;
end;

procedure TRVColorCombo.CreateThemeHandle;
begin
  if UseXPThemes and Assigned(RV_IsAppThemed) and RV_IsAppThemed and RV_IsThemeActive then begin
    FThemeEdit := RV_OpenThemeData(Handle, PWideChar(WideString('Edit')));
    FThemeCombo := RV_OpenThemeData(Handle, PWideChar(WideString('Combobox')));
    end
  else begin
    FThemeEdit := 0;
    FThemeCombo := 0;
  end;
end;

procedure TRVColorCombo.FreeThemeHandle;
begin
  if FThemeEdit<>0 then
    RV_CloseThemeData(FThemeEdit);
  FThemeEdit := 0;
  if FThemeCombo<>0 then
    RV_CloseThemeData(FThemeCombo);
  FThemeCombo := 0;
end;

procedure TRVColorCombo.WMThemeChanged(var Msg: TMessage);
begin
  inherited;
  FreeThemeHandle;
  CreateThemeHandle;
  SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
  RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_ERASE);
  Msg.Result := 1;
end;


procedure TRVColorCombo.SetUseXPThemes(const Value: Boolean);
begin
  if FUseXPThemes<>Value then begin
    FUseXPThemes := Value;
    if HandleAllocated then begin
      FreeThemeHandle;
      CreateThemeHandle;
      SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
      RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_ERASE);
    end;
  end;
end;

procedure TRVColorCombo.WMNCPaint(var Msg: TMessage);
var
  DC: HDC;
  RC, RW: TRect;
  {$IFDEF USERVKSDEVTE}
  Canvas: TCanvas;
  {$ENDIF}
begin
  {$IFDEF USERVKSDEVTE}
  if IsThemeAvailable(CurrentTheme) and CurrentTheme.IsEditDefined(kescComboBox) then
  begin
    DC := GetWindowDC(Handle);
    try
      Windows.GetClientRect(Handle, RC);
      if GetWindowLong(Handle, GWL_STYLE) and WS_VSCROLL <> 0 then
        if (GetWindowLong(Handle, GWL_EXSTYLE) and WS_EX_LEFTSCROLLBAR)<>0 then
          dec(RC.Left, GetSystemMetrics(SM_CXVSCROLL))
        else
          inc(RC.Right, GetSystemMetrics(SM_CXVSCROLL));
      if GetWindowLong(Handle, GWL_STYLE) and WS_HSCROLL <> 0 then
        inc(RC.Bottom, GetSystemMetrics(SM_CYHSCROLL));
      GetWindowRect(Handle, RW);
      MapWindowPoints(0, Handle, RW, 2);
      OffsetRect(RC, -RW.Left, -RW.Top);
      ExcludeClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom);
      OffsetRect(RW, -RW.Left, -RW.Top);

      Canvas := TCanvas.Create;
      try
        Canvas.Handle := DC;
        CurrentTheme.EditDraw(kescComboBox, Canvas, EditInfo(RW, kedsNormal));
      finally
        Canvas.Handle := 0;
        Canvas.Free;
      end;

      Msg.Result := 0;
    finally
      ReleaseDC(Handle, DC);
    end;
    Exit;
  end;
  {$ENDIF}
  if FThemeEdit=0 then
  begin
    inherited;
    exit;
  end;
  DC := GetWindowDC(Handle);
  try
    Windows.GetClientRect(Handle, RC);
    if GetWindowLong(Handle, GWL_STYLE) and WS_VSCROLL <> 0 then
      if (GetWindowLong(Handle, GWL_EXSTYLE) and WS_EX_LEFTSCROLLBAR)<>0 then
        dec(RC.Left, GetSystemMetrics(SM_CXVSCROLL))
      else
        inc(RC.Right, GetSystemMetrics(SM_CXVSCROLL));
    if GetWindowLong(Handle, GWL_STYLE) and WS_HSCROLL <> 0 then
      inc(RC.Bottom, GetSystemMetrics(SM_CYHSCROLL));
    GetWindowRect(Handle, RW);
    MapWindowPoints(0, Handle, RW, 2);
    OffsetRect(RC, -RW.Left, -RW.Top);
    ExcludeClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom);
    OffsetRect(RW, -RW.Left, -RW.Top);
    RV_DrawThemeBackground(FThemeEdit, DC, 0, 0, RW, nil);
    Msg.Result := 0;
  finally
    ReleaseDC(Handle, DC);
  end;
end;

procedure TRVColorCombo.CMMouseEnter(var Msg: TMessage);
begin
  FHot := True;
  if FThemeCombo<>0 then
    Repaint;
end;

procedure TRVColorCombo.CMMouseLeave(var Msg: TMessage);
begin
  FHot := False;
  if FThemeCombo<>0 then
    Repaint;
end;

function TRVColorCombo.GetCaption: String;
begin
  if FDefaultCaption<>'' then
    Result := FDefaultCaption
  else
    if AutoColor=clNone then
      Result := FTransparentCaption
    else
      Result := FAutoCaption;
end;

procedure TRVColorCombo.DrawStandard;
var w,L: Integer;
    r: TRect;
    State: Integer;
    s: String;
begin
  r := ClientRect;
  Canvas.Brush.Color := clWindow;
  Canvas.FillRect(r);
  w := GetSystemMetrics(SM_CXVSCROLL);
  r.Left := r.Right-w;
  if not Enabled then
    State := DFCS_INACTIVE
  else if csLButtonDown in ControlState then
    State := DFCS_PUSHED
  else
    State := 0;
  DrawFrameControl(Canvas.Handle, r, DFC_SCROLL, DFCS_SCROLLCOMBOBOX or State);
  r.Right := r.Left;
  r.Left := 0;
  InflateRect(r,-2,-2);
  if not Indeterminate and (ChosenColor<>clNone) then begin
    Canvas.Brush.Color := ChosenColor;
    Canvas.FillRect(r);
  end;
  if Focused then begin
    InflateRect(r,1,1);
    Canvas.Font.Color := clBlack;
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := clWindow;
    Canvas.DrawFocusRect(r);
  end;
  if not Indeterminate and (ChosenColor=AutoColor) then begin
    Canvas.Font := Font;
    if AutoColor=clWindowText then
      Canvas.Font.Color := clWindow
    else if AutoColor=clNone then
      Canvas.Font.Color := clWindowText
    else begin
      L := GetLuminance(ChosenColor);
      if L>150 then
        Canvas.Font.Color := clWindowText
      else
        Canvas.Font.Color := clWindow;
    end;
    s := GetCaption;
    Canvas.Brush.Style := bsClear;
    Windows.DrawText(Canvas.Handle, PChar(s), Length(s), r, DT_SINGLELINE or DT_CENTER or DT_VCENTER)
  end;
end;

{$IFDEF USERVKSDEVTE}

procedure TRVColorCombo.SNMThemeMessage(var Msg: TMessage);
var
  R: TRect;
begin
  if not HandleAllocated then Exit;
  case Msg.wParam of
    SMP_REPAINT, SMP_APPLYTHEME, SMP_CHANGETHEME, SMP_REMOVETHEME:
      begin
        SendMessage(Handle, WM_NCPAINT, 0, 0);
        R := GetClientRect;
        InvalidateRect(Handle, @R, true);
      end;
  end;
end;

procedure TRVColorCombo.DrawKSThemed;
var w: Integer;
    r: TRect;
    L: Integer;
    s: String;
    DS: TteEditButtonDrawState;
begin
  r := ClientRect;
  Canvas.Brush.Color := CurrentTheme.Colors[ktcEditNormal];
  Canvas.FillRect(R);

  w := GetSystemMetrics(SM_CXVSCROLL);
  r.Left := r.Right-w;
  if not Enabled then
    DS := kebdsDisabled
  else
    if csLButtonDown in ControlState then
      DS := kebdsPressed
    else
      if FHot and (frm=nil) then
        DS := kebdsHot
      else
        DS := kebdsNormal;

  CurrentTheme.EditDrawButton(kescComboBox, Canvas, 
    EditButtonInfo(R, DS, kebcDropDown));

  r.Right := r.Left;
  r.Left := 0;
  InflateRect(r,-2,-2);
  if not Indeterminate and (ChosenColor<>clNone) then begin
    Canvas.Brush.Color := ChosenColor;
    Canvas.FillRect(r);
  end;
  if Focused then begin
    InflateRect(r,1,1);
    Canvas.Font.Color := clBlack;
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := clWindow;
    Canvas.DrawFocusRect(r);
  end;
  if not Indeterminate and (ChosenColor=AutoColor) then
  begin
    Canvas.Font := Font;
    if AutoColor=clWindowText then
      Canvas.Font.Color := clWindow
    else if AutoColor=clNone then
      Canvas.Font.Color := clWindowText
    else begin
      L := GetLuminance(ChosenColor);
      if L>150 then
        Canvas.Font.Color := clWindowText
      else
        Canvas.Font.Color := clWindow;
    end;
    s := GetCaption;
    Canvas.Brush.Style := bsClear;
    Windows.DrawText(Canvas.Handle, PChar(s), Length(s), r, DT_SINGLELINE or DT_CENTER or DT_VCENTER)
  end;
end;

{$ENDIF}

procedure TRVColorCombo.DrawThemed;
var w: Integer;
    r: TRect;
    L: Integer;
    State: Integer;
    s: String;
begin
  r := ClientRect;
  Canvas.Brush.Color := clWindow;
  Canvas.FillRect(r);
  w := GetSystemMetrics(SM_CXVSCROLL);
  r.Left := r.Right-w;
  if not Enabled then
    State := CBXS_DISABLED
  else if csLButtonDown in ControlState then
    State := CBXS_PRESSED
  else if FHot and (frm=nil) then
    State := CBXS_HOT
  else
    State := CBXS_NORMAL;
  RV_DrawThemeBackground(FThemeCombo, Canvas.Handle, CP_DROPDOWNBUTTON, State, R, nil);
  r.Right := r.Left;
  r.Left := 0;
  InflateRect(r,-2,-2);
  if not Indeterminate and (ChosenColor<>clNone) then begin
    Canvas.Brush.Color := ChosenColor;
    Canvas.FillRect(r);
  end;
  if Focused then begin
    InflateRect(r,1,1);
    Canvas.Font.Color := clBlack;
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := clWindow;
    Canvas.DrawFocusRect(r);
  end;
  if not Indeterminate and (ChosenColor=AutoColor) then begin
    Canvas.Font := Font;
    if AutoColor=clWindowText then
      Canvas.Font.Color := clWindow
    else if AutoColor=clNone then
      Canvas.Font.Color := clWindowText
    else begin
      L := GetLuminance(ChosenColor);
      if L>150 then
        Canvas.Font.Color := clWindowText
      else
        Canvas.Font.Color := clWindow;
    end;
    s := GetCaption;
    Canvas.Brush.Style := bsClear;
    Windows.DrawText(Canvas.Handle, PChar(s), Length(s), r, DT_SINGLELINE or DT_CENTER or DT_VCENTER)
  end;
end;

procedure TRVColorCombo.SetIndeterminate(const Value: Boolean);
begin
  FIndeterminate := Value;
  Invalidate;
end;

procedure TRVColorCombo.SetChosenColor(const Value: TColor);
begin
  FChosenColor  := Value;
  Indeterminate := False;
end;

procedure TRVColorCombo.SetColorDialog(const Value: TColorDialog);
begin
  if Value <> FColorDialog then
  begin
    {$IFDEF RICHVIEWDEF5}
    if FColorDialog <> nil then
      FColorDialog.RemoveFreeNotification(Self);
    {$ENDIF}
    FColorDialog := Value;
    if FColorDialog<> nil then
      FColorDialog.FreeNotification(Self);
  end;
end;


procedure TRVColorCombo.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation=opRemove) and (AComponent=FColorDialog) then
    FColorDialog := nil;
end;

procedure TRVColorCombo.CMEnabledChanged(var Msg: TMessage);
begin
  inherited;
  Invalidate;
end;

function TRVColorCombo.StoreAutoCaption: Boolean;
begin
  Result := FAutoCaption<>sAutoCpt;
end;

function TRVColorCombo.StoreTransparentCaption: Boolean;
begin
  Result := FTransparentCaption<>sTransparentCpt;
end;

end.

