rvcolorcombo.pas

richviewaction 1.58 需要richview 1.9.46

{*******************************************************}
{                                                       }
{       RichViewActions                                 }
{       TRVColorCombo v1.3                              }
{       Combobox with color picker                      }
{                                                       }
{       Copyright (c) 2002-2003, Sergey Tkachenko       }
{       [e-mail]                               }
{       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;