colorrvfrm.pas

richviewaction 1.58 需要richview 1.9.46

{*******************************************************}
{                                                       }
{       RichViewActions                                 }
{       Non-modal color picker form                     }
{                                                       }
{       Copyright (c) Sergey Tkachenko                  }
{       [e-mail]                               }
{       http://www.trichview.com                        }
{                                                       }
{*******************************************************}

unit ColorRVFrm;

interface

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

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Buttons, BaseRVFrm, MMSystem, StdCtrls, RVXPTheme;

type

  {$IFDEF RICHVIEWDEF10}
  TRVColorBackPanel = class (TPanel)
    protected
      CustomPaint: Boolean;
      procedure Paint; override;
  end;
  {$ENDIF}


  TfrmColor = class(TfrmRVBase)
    cd: TColorDialog;
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormDeactivate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
    FColorDialog: TColorDialog;
    FColor: TColor;
    FChosen: Boolean;
    Index: Integer;
    ColorButtons: array of TSpeedButton;
    DefColorCount: Integer;
    FDefaultCaption: String;
    {$IFDEF RICHVIEWDEF10}
    FBackPanel: TRVColorBackPanel;
    {$ENDIF}
    procedure CreateButtons(Rows,Columns: Integer; DefaultColor: TColor;
                            AddDefault2Color: Boolean; Default2Color: TColor);
    procedure MoreClick(Sender: TObject);
    procedure ColorClick(Sender: TObject);
    procedure UpdateBtnState;
  protected
    {$IFDEF USERVKSDEVTE}
    function IsTeFormAllowed: Boolean; override;
    {$ENDIF}
  public
    { Public declarations }
    Popup, NoSound: Boolean;
    procedure PopupAtMouse;
    procedure PopupAt(r: TRect);
    procedure PopupAtControl(ctrl: TControl);
    procedure Init(DefaultColor: TColor; ColorDialog: TColorDialog; Color: TColor;
                   AddDefault2Color: Boolean=False; Default2Color: TColor=clNone);
    property ChosenColor: TColor read FColor;
    property Chosen: Boolean read FChosen;
    property DefaultCaption: String read FDefaultCaption write FDefaultCaption;
  end;

implementation

uses RVALocalize, RichViewActions;

{$R *.dfm}

{$IFDEF RICHVIEWDEF10}

{ TRVColorBackPanel }

procedure TRVColorBackPanel.Paint;
var r: TRect;
begin
  if not CustomPaint then
    exit;
  r := ClientRect;
  if not (RVA_UseXPThemes and Assigned(RV_IsAppThemed) and RV_IsAppThemed and
     RV_IsThemeActive)then
    DrawEdge(Canvas.Handle, r,EDGE_RAISED, BF_RECT)
  else begin
    Canvas.Pen.Color := clBtnShadow;
    Canvas.Brush.Style := bsClear;
    Canvas.Rectangle(0,0,ClientWidth,ClientHeight);
  end;
end;

{$ENDIF}

{ TFrmColor }

procedure TfrmColor.FormPaint(Sender: TObject);
{$IFNDEF RICHVIEWDEF10}
var r: TRect;
{$ENDIF}
begin
  {$IFNDEF RICHVIEWDEF10}
  if not Popup then
    exit;
  r := ClientRect;
  if not (RVA_UseXPThemes and Assigned(RV_IsAppThemed) and RV_IsAppThemed and
     RV_IsThemeActive)then
    DrawEdge(Canvas.Handle, r,EDGE_RAISED, BF_RECT)
  else begin
    Canvas.Pen.Color := clBtnShadow;
    Canvas.Brush.Style := bsClear;
    Canvas.Rectangle(0,0,ClientWidth,ClientHeight);
  end;
  {$ENDIF}
end;

procedure TfrmColor.CreateButtons(Rows, Columns: Integer;
                               DefaultColor: TColor;
                               AddDefault2Color: Boolean; Default2Color: TColor);
var r,c,i, X, Y: Integer;
    btn: TSpeedButton;
    bmp: TBitmap;
    btnidx: Integer;
const
    SIZE = 18;
    IMGSIZE = 14;
    MARGIN = 4;

    procedure DrawGlyph(Color: TColor);
    begin
      bmp.Canvas.Brush.Color := Color;
      bmp.Canvas.Brush.Style := bsSolid;
      bmp.Canvas.FillRect(Rect(2,2,IMGSIZE-2,IMGSIZE-2));
      if ColorToRGB(Color)=ColorToRGB(clRed) then
        bmp.Canvas.Pen.Color := clWhite
      else
        bmp.Canvas.Pen.Color := clRed;
      bmp.Canvas.Brush.Style := bsClear;
      bmp.Canvas.Rectangle(0,0,IMGSIZE,IMGSIZE);
    end;

begin
  if AddDefault2Color then begin
    SetLength(ColorButtons, ColorCount+2);
    DefColorCount := 2;
    end
  else begin
    SetLength(ColorButtons, ColorCount+1);
    DefColorCount := 1;
  end;

  X := MARGIN+2;
  Y := MARGIN+2;
  Index := -1;
  bmp := TBitmap.Create;
  bmp.Width := IMGSIZE;
  bmp.Height := IMGSIZE;
  bmp.Canvas.Pen.Color := clBtnShadow;
  bmp.Canvas.Rectangle(1,1,IMGSIZE-1,IMGSIZE-1);

  btnidx := 0;

  if AddDefault2Color then begin
    btn := TSpeedButton.Create(Self);
    btn.SetBounds(X,Y, SIZE*Columns, btn.Height);
    btn.Tag := Default2Color;
    btn.Caption := RVA_GetS(rvam_cpcl_Default);
    if Default2Color<>clNone then begin
      DrawGlyph(Default2Color);
      btn.Glyph := bmp;
    end;
    btn.Flat := Popup;
    btn.GroupIndex := 1;
    {$IFDEF RICHVIEWDEF10}
    btn.Parent := FBackPanel;
    {$ELSE}
    btn.Parent := Self;
    {$ENDIF}
    if btn.Tag=FColor then begin
      Index := btnidx;
      btn.Down := True;
    end;
    btn.OnClick := ColorClick;
    ColorButtons[btnidx] := btn;
    inc(btnidx);
    inc(Y, btn.Height+MARGIN);
  end;

  btn := TSpeedButton.Create(Self);
  btn.SetBounds(X,Y, SIZE*Columns, btn.Height);
  if DefaultColor=clNone then begin
    btn.Caption := RVA_GetS(rvam_cpcl_Transparent);
    btn.Tag := clNone;
    end
  else begin
    btn.Caption := RVA_GetS(rvam_cpcl_Auto);
    DrawGlyph(DefaultColor);
    btn.Glyph := bmp;
    btn.Tag := DefaultColor;
  end;
  if DefaultCaption<>'' then
    btn.Caption := DefaultCaption;
  btn.Flat := Popup;
  btn.GroupIndex := 1;
  {$IFDEF RICHVIEWDEF10}
  btn.Parent := FBackPanel;
  {$ELSE}
  btn.Parent := Self;
  {$ENDIF}
  if btn.Tag=FColor then begin
    Index := btnidx;
    btn.Down := True;
  end;
  btn.OnClick := ColorClick;
  ColorButtons[btnidx] := btn;
  inc(btnidx);

  inc(Y, btn.Height+MARGIN);

  i := 0;
  for r := 0 to Rows-1 do
    for c := 0 to Columns-1 do begin
      btn := TSpeedButton.Create(Self);
      btn.SetBounds(X+(SIZE)*c, Y+(SIZE)*r, SIZE, SIZE);
      btn.GroupIndex := 1;
      btn.Flat := Popup;
      DrawGlyph(Colors[i].Color);
      btn.Glyph := bmp;
      if Colors[i].Color=FColor then begin
        Index := btnidx;
        btn.Down := True;
      end;
      {$IFDEF RICHVIEWDEF10}
      btn.Parent := FBackPanel;
      {$ELSE}
      btn.Parent := Self;
      {$ENDIF}
      btn.ShowHint := True;
      btn.Hint := Colors[i].Name;
      btn.Tag := Colors[i].Color;
      btn.OnClick := ColorClick;
      ColorButtons[btnidx] := btn;
      inc(btnidx);
      inc(i);
    end;

  inc(Y, Rows*SIZE+MARGIN);

  btn := TSpeedButton.Create(Self);
  btn.SetBounds(X,Y, SIZE*Columns, btn.Height);
  btn.Caption := RVA_GetS(rvam_cpcl_More);
  btn.Flat := Popup;
  {$IFDEF RICHVIEWDEF10}
  btn.Parent := FBackPanel;
  {$ELSE}
  btn.Parent := Self;
  {$ENDIF}
  btn.OnClick := MoreClick;

  bmp.Free;

  ClientWidth := MARGIN*2+SIZE*Columns+4;
  ClientHeight := Y+btn.Height+MARGIN+4;
end;

procedure TfrmColor.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    VK_ESCAPE:
      if Popup then
        Close;
    VK_RETURN:
      begin
        FChosen := True;
        if Popup then
          Close;
      end;
    VK_RIGHT:
      begin
        inc(Index);
        if Index>=Length(ColorButtons) then
          Index := 0;
        UpdateBtnState;
      end;
    VK_LEFT:
      begin
        if Index<0 then
          Index := 0
        else
          dec(Index);
        if Index<0 then
          Index := Length(ColorButtons)-1;
        UpdateBtnState;
      end;
    VK_DOWN:
      begin
        if Index<DefColorCount then
          inc(Index)
        else
          inc(Index,8);
        if Index>=Length(ColorButtons)+7 then
          Index := 0
        else if Index>=Length(ColorButtons) then
          dec(Index,Length(ColorButtons)-2);
        UpdateBtnState;
      end;
    VK_UP:
      begin
        if (Index<0) or (Index=1) then
          Index := 0
        else if Index=0 then
          Index := ColorCount
        else if (Index=2) and (DefColorCount=2) then
          Index := 1
        else begin
          dec(Index,8);
          if Index<DefColorCount then
            inc(Index,Length(ColorButtons)-2);
        end;
        UpdateBtnState;
      end;
  end;
end;

procedure TfrmColor.FormDeactivate(Sender: TObject);
begin
  inherited;
  if Popup then
    Close;
end;

procedure TfrmColor.FormShow(Sender: TObject);
begin
  inherited;
  if not NoSound then
    PlaySound('MenuPopup', 0, SND_APPLICATION or SND_ASYNC or SND_NODEFAULT);
end;

procedure TfrmColor.PopupAtMouse;
var p: TPoint;
begin
  GetCursorPos(p);
  if p.X+Width>Screen.Width then
    p.X := Screen.Width-Width;
  if p.Y+Height>Screen.Height then
    p.Y := Screen.Height-Height;
  Left := p.X;
  Top  := p.Y;
  Show;
end;

procedure TfrmColor.PopupAt(r: TRect);
var x,y: Integer;
begin
  y := r.Bottom;
  if y+Height>Screen.Height then
    y := r.Top-Height;
  if y<0 then
    y := 0;
  x := r.Left;
  if x+Width>Screen.Width then
    x := r.Right-Width;
  if x<0 then
    x := 0;
  Left := X;
  Top  := Y;
  Show;
end;

procedure TfrmColor.Init(DefaultColor: TColor; ColorDialog: TColorDialog;
                         Color: TColor;
                         AddDefault2Color: Boolean=False; Default2Color: TColor=clNone);
begin
  FColorDialog := ColorDialog;
  if FColorDialog=nil then
    FColorDialog := cd;
  FColor := Color;
  FChosen := False;
  CreateButtons(5,8, DefaultColor, AddDefault2Color, Default2Color);
end;

procedure TfrmColor.MoreClick(Sender: TObject);
begin
  if FColor<>clNone then
    FColorDialog.Color := FColor
  else
    FColorDialog.Color := clYellow;
  if FColorDialog.Execute then begin
    FColor := FColorDialog.Color;
    FChosen := True;
    if Popup then
      Close;
  end;
end;

procedure TfrmColor.ColorClick(Sender: TObject);
begin
  FColor := TSpeedButton(Sender).Tag;
  FChosen := True;
  if Popup then
    Close;
end;

procedure TfrmColor.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  inherited;
  if Popup then
    Action := caFree;
end;

procedure TfrmColor.FormCreate(Sender: TObject);
begin
  inherited;
  Popup := True;
  {$IFDEF RICHVIEWDEF10}
  FBackPanel := TRVColorBackPanel.Create(Self);
  FBackPanel.Parent := Self;
  FBackPanel.BorderStyle := bsNone;
  FBackPanel.BevelInner := bvNone;
  FBackPanel.BevelOuter := bvNone;
  FBackPanel.Align := alClient;
  FBackPanel.CustomPaint := True;
  {$ENDIF}
  Caption := '';
  if RVA_UseXPThemes then begin
    Color := clMenu;
    {$IFDEF RICHVIEWDEF10}
    FBackPanel.Color := clMenu;
    {$ENDIF}
  end;
end;

procedure TfrmColor.UpdateBtnState;
var i: Integer;
begin
  for i := 0 to ColorCount do begin
    ColorButtons[i].Down := Index=i;
    if Index=i then
      FColor := ColorButtons[i].Tag;
  end;
end;

procedure TfrmColor.PopupAtControl(ctrl: TControl);
var r: TRect;
begin
  r := ctrl.BoundsRect;
  r.TopLeft := ctrl.Parent.ClientToScreen(r.TopLeft);
  r.BottomRight := ctrl.Parent.ClientToScreen(r.BottomRight);
  PopupAt(r);
end;

{$IFDEF USERVKSDEVTE}
function TfrmColor.IsTeFormAllowed: Boolean;
begin
  Result := False;
end;
{$ENDIF}




end.