{*******************************************************************}
{                                                                   }
{       ExpressWeb Framework by Developer Express                   }
{       Designer Module                                             }
{                                                                   }
{       Copyright (c) 2000-2009 Developer Express Inc.              }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{   The entire contents of this file is protected by U.S. and       }
{   International Copyright Laws. Unauthorized reproduction,        }
{   reverse-engineering, and distribution of all or any portion of  }
{   the code contained in this file is strictly prohibited and may  }
{   result in severe civil and criminal penalties and will be       }
{   prosecuted to the maximum extent possible under the law.        }
{                                                                   }
{   RESTRICTIONS                                                    }
{                                                                   }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES           }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE    }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS   }
{   LICENSED TO DISTRIBUTE THE EXPRESSWEB FRAMEWORK AND ALL         }
{   ACCOMPANYING VCL CLASSES AS PART OF AN EXECUTABLE WEB           }
{   APPLICATION ONLY.                                               }
{                                                                   }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED      }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE        }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE       }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT  }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                      }
{                                                                   }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON       }
{   ADDITIONAL RESTRICTIONS.                                        }
{                                                                   }
{*******************************************************************}
unit cxWebHTMLEdBar;

interface

uses
  Classes, Controls, Windows, SysUtils, Graphics, Menus,
  StdCtrls, ExtCtrls, ComCtrls, ImgList, ActiveX, Dialogs, cxWebHTMLEdIntf;

type
  TcxHTMLEditorActionType = (eatButton, eatCheck, eatColor, eatDropDown, eatCombo, eatDevider, eatSpacer);
  TActionMethod = procedure(ASender: TObject) of object;

  PcxHTMLEditorBarAction = ^TcxHTMLEditorBarAction;
  TcxHTMLEditorBarAction = record
    Name: string;
    ActType: TcxHTMLEditorActionType;
    Hint: string;
    ImgIndex: Integer;
    Command: Integer;
    Method: TActionMethod;
  end;

  PcxHTMLEditorComboItem = ^TcxHTMLEditorComboItem;
  TcxHTMLEditorComboItem = record
    Caption: string;
    Command: string;
  end;
  PcxHTMLEditorComboItems = ^TcxHTMLEditorComboItems;
  TcxHTMLEditorComboItems = array[0..MaxInt div SizeOf(TcxHTMLEditorComboItem) - 1] of TcxHTMLEditorComboItem;

  TcxHTMLEditorBar = class(TCoolBar, IInterface, IcxHTMLEditorBar)
  private
    FColorPopup: TPopupMenu;
    FColorDialog: TColorDialog;
    FFormatToolBar: TToolBar;
    FTableToolBar: TToolBar;
    FFramesToolBar: TToolBar;
    FImageList: TImageList;
    FButtonList: TList;
    FComboList: TList;
    FontNameComboItems: array of TcxHTMLEditorComboItem;
    FCommandTarget: IcxOleCommandTarget;
    FUIDisabled: Boolean;
    FDisableLocked: Boolean;
    procedure InitCombo(ACombo: TCustomCombo; const AItems: array of TcxHTMLEditorComboItem);
    procedure InitFontNameCombo(ASender: TObject);
    procedure InitFontSizeCombo(ASender: TObject);
    procedure InitFormatCombo(ASender: TObject);
    procedure AddStdColor(const S: string);
    procedure AddWebColor(const S: string);
    procedure AddColorItem(AParent: TMenuItem; Color: Integer);
    procedure PopulateColorPopup;
    procedure Lock(ASender: TObject);
    procedure UnLock(ASender: TObject);
    procedure MeasureColorPopupItem(Sender: TObject; ACanvas: TCanvas;
      var Width, Height: Integer);
  protected
    procedure AddButton(AToolBar: TToolBar; AAction: TcxHTMLEditorBarAction);
    procedure AddCombo(AToolBar: TToolBar; AAction: TcxHTMLEditorBarAction);
    procedure AddDevider(AToolBar: TToolBar);
    procedure AddColorDropDown(AToolBar: TToolBar; AAction: TcxHTMLEditorBarAction);
    procedure AddDropDown(AToolBar: TToolBar; AAction: TcxHTMLEditorBarAction);
    procedure AddSpacer(AToolBar: TToolBar);
    function AddToolBar(const AName: string): TToolBar;
    procedure ComboBoxChange(ASender: TObject);
    procedure ToolButtonClick(ASender: TObject);
    procedure DropDownClick(ASender: TObject);
    procedure ColorPopupClick(ASender: TObject);
    procedure CustomColorClick(ASender: TObject);
    { IInterface }
    function QueryInterface(const IID: TGUID; out Obj): HResult; override;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    { IcxHTMLEditor }
    procedure SetCommandTarget(const ACommandTarget: IcxOleCommandTarget);
    procedure DisableUI(const ADisabled: Boolean);
    procedure UpdateActionControls;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CreateActionControls;
    property CommandTarget: IcxOleCommandTarget read FCommandTarget write SetCommandTarget;
    property UIDisabled: Boolean read FUIDisabled write DisableUI;
  end;

implementation

{$R *.res}

uses
  Forms, Messages, Variants, ToolWin, Types,
  cxWebHTMLConsts, cxWebTypes, cxWebGraphics, cxWebDsgnStrs;

{$WRITEABLECONST ON}
const
  FormatBarActions: array[0..31] of TcxHTMLEditorBarAction = (
    (Name: 'Format'; ActType: eatCombo; Hint: scxBarButtonHintFormat; Command: IDM_BLOCKFMT),
    (ActType: eatSpacer),
    (Name: 'FontName'; ActType: eatCombo; Hint: scxBarButtonHintFontName; Command: IDM_FONTNAME),
    (ActType: eatSpacer),
    (Name: 'FontSize'; ActType: eatCombo; Hint: scxBarButtonHintFontSize; Command: IDM_FONTSIZE),
    (ActType: eatDevider),
    (Name: 'Bold'; ActType: eatCheck; Hint: scxBarButtonHintBold; ImgIndex: 0; Command: IDM_BOLD),
    (Name: 'Italic'; ActType: eatCheck; Hint: scxBarButtonHintItalic; ImgIndex: 1; Command: IDM_ITALIC),
    (Name: 'Underline'; ActType: eatCheck; Hint: scxBarButtonHintUnderline; ImgIndex: 2; Command: IDM_UNDERLINE),
    (Name: 'Subscript'; ActType: eatCheck; Hint: scxBarButtonHintSubscript; ImgIndex: 8; Command: IDM_SUBSCRIPT),
    (Name: 'Superscript'; ActType: eatCheck; Hint: scxBarButtonHintSuperscript; ImgIndex: 9; Command: IDM_SUPERSCRIPT),
    (ActType: eatDevider),
    (Name: 'JustifyLeft'; ActType: eatCheck; Hint: scxBarButtonHintAlignLeft; ImgIndex: 3; Command: IDM_JUSTIFYLEFT),
    (Name: 'JustifyCenter'; ActType: eatCheck; Hint: scxBarButtonHintAlignCenter; ImgIndex: 4; Command: IDM_JUSTIFYCENTER),
    (Name: 'JustifyRight'; ActType: eatCheck; Hint: scxBarButtonHintAlignRight; ImgIndex: 5; Command: IDM_JUSTIFYRIGHT),
    (Name: 'JustifyFull'; ActType: eatCheck; Hint: scxBarButtonHintJustify; ImgIndex: 6; Command: IDM_JUSTIFYFULL),
    (Name: 'JustifyNone'; ActType: eatCheck; Hint: scxBarButtonHintAlignNone; ImgIndex: 7; Command: IDM_JUSTIFYNONE),
    (ActType: eatDevider),
    (Name: 'ForeColor'; ActType: eatColor; Hint: scxBarButtonHintForeColor; ImgIndex: 10; Command: IDM_FORECOLOR),
    (Name: 'BackgroundColor'; ActType: eatColor; Hint: scxBarButtonHintBGColor; ImgIndex: 11; Command: IDM_BACKCOLOR),
    (ActType: eatDevider),
    (Name: 'Numbering'; ActType: eatCheck; Hint: scxBarButtonHintNumbering; ImgIndex: 12; Command: IDM_ORDERLIST),
    (Name: 'Bullets'; ActType: eatCheck; Hint: scxBarButtonHintBullets; ImgIndex: 13; Command: IDM_UNORDERLIST),
    (Name: 'Outdent'; ActType: eatButton; Hint: scxBarButtonHintOutdent; ImgIndex: 14; Command: IDM_OUTDENT),
    (Name: 'Indent'; ActType: eatButton; Hint: scxBarButtonHintIndent; ImgIndex: 15; Command: IDM_INDENT),
    (ActType: eatDevider),
    (Name: 'Link'; ActType: eatButton; Hint: scxBarButtonHintLink; ImgIndex: 16; Command: IDM_HYPERLINK),
    (Name: 'Unlink'; ActType: eatButton; Hint: scxBarButtonHintUnlink; ImgIndex: 17; Command: IDM_UNLINK),
    (ActType: eatDevider),
    (Name: 'Undo'; ActType: eatDropDown; Hint: ''; ImgIndex: 42; Command: IDM_UNDO),
    (Name: 'Dedo'; ActType: eatDropDown; Hint: ''; ImgIndex: 43; Command: IDM_REDO),
    (Name: 'RemoveFmt'; ActType: eatButton; Hint: scxBarButtonHintRemoveFmt; ImgIndex: 41; Command: IDM_REMOVEFORMAT));

  TableBarActions: array[0..14] of TcxHTMLEditorBarAction = (
    (Name: 'InsertTable'; ActType: eatButton; Hint: scxBarButtonHintInsTable; ImgIndex: 29; Command: IDM_TABLEINSERT),
    (Name: 'DeleteTable'; ActType: eatButton; Hint: scxBarButtonHintDelTable; ImgIndex: 30; Command: IDM_TABLEDELETE),
    (ActType: eatDevider),
    (Name: 'InsertRowAbove'; ActType: eatButton; Hint: scxBarButtonHintInsRowA; ImgIndex: 18; Command: IDM_ROWINSERT),
    (Name: 'InsertRowBelow'; ActType: eatButton; Hint: scxBarButtonHintInsRowB; ImgIndex: 25; Command: IDM_ROWINSERTBELOW),
    (Name: 'InsertColLeft'; ActType: eatButton; Hint: scxBarButtonHintInsColL; ImgIndex: 26; Command: IDM_COLUMNINSERT),
    (Name: 'InsertColRight'; ActType: eatButton; Hint: scxBarButtonHintInsColR; ImgIndex: 19; Command: IDM_COLUMNINSERTRIGHT),
    (Name: 'InsertCell'; ActType: eatButton; Hint: scxBarButtonHintInsCell; ImgIndex: 20; Command: IDM_CELLINSERT),
    (ActType: eatDevider),
    (Name: 'DeleteRow'; ActType: eatButton; Hint: scxBarButtonHintDelRow; ImgIndex: 21; Command: IDM_ROWDELETE),
    (Name: 'DeleteCol'; ActType: eatButton; Hint: scxBarButtonHintDelCol; ImgIndex: 22; Command: IDM_COLUMNDELETE),
    (Name: 'DeleteCells'; ActType: eatButton; Hint: scxBarButtonHintDelCells; ImgIndex: 23; Command: IDM_CELLDELETE),
    (ActType: eatDevider),
    (Name: 'SplitCell'; ActType: eatButton; Hint: scxBarButtonHintSplitCell; ImgIndex: 27; Command: IDM_CELLSPLIT),
    (Name: 'MergeCells'; ActType: eatButton; Hint: scxBarButtonHintMergeCells; ImgIndex: 28; Command: IDM_CELLMERGE)
{// TODO: implement
    (ActType: eatDevider),
    (Name: 'SelectTable'; ActType: eatButton; Hint: scxBarButtonHintSelTable; ImgIndex: 31; Command: IDM_TABLESELECT),
    (Name: 'SelectCol'; ActType: eatButton; Hint: scxBarButtonHintSelCol; ImgIndex: 32; Command: IDM_COLUMNSELECT),
    (Name: 'SelectRow'; ActType: eatButton; Hint: scxBarButtonHintSelRow; ImgIndex: 33; Command: IDM_ROWSELECT),
    (Name: 'SelectCell'; ActType: eatButton; Hint: scxBarButtonHintSelCell; ImgIndex: 34; Command: IDM_CELLSELECT)} );

    FramesBarActions: array[0..5] of TcxHTMLEditorBarAction = (
    (Name: 'NewWholeFrame'; ActType: eatButton; Hint: scxBarButtonHintNewWholeFrame; ImgIndex: 40; Command: IDM_FRAMEINSERT),
    (Name: 'NewLeftFrame'; ActType: eatButton; Hint: scxBarButtonHintNewLFrame; ImgIndex: 35; Command: IDM_FRAMEINSLEFT),
    (Name: 'NewRightFrame'; ActType: eatButton; Hint: scxBarButtonHintNewRFrame; ImgIndex: 36; Command: IDM_FRAMEINSRIGHT),
    (Name: 'NewTopFrame'; ActType: eatButton; Hint: scxBarButtonHintNewTFrame; ImgIndex: 37; Command: IDM_FRAMEINSTOP),
    (Name: 'NewBottomFrame'; ActType: eatButton; Hint: scxBarButtonHintNewBFrame; ImgIndex: 38; Command: IDM_FRAMEINSBOTTOM),
    (Name: 'DeleteFrame'; ActType: eatButton; Hint: scxBarButtonHintDelFrame; ImgIndex: 39; Command: IDM_FRAMEDELETE) );
{$WRITEABLECONST OFF}

   FormatComboItems: array[0..16] of TcxHTMLEditorComboItem = (
    (Caption: scxBarFormatComboNone; Command: ''),
    (Caption: scxBarFormatComboNormal; Command: 'normal'),
    (Caption: scxBarFormatComboFormat; Command: 'formatted'),
    (Caption: scxBarFormatComboAdress; Command: 'address'),
    (Caption: scxBarFormatComboH1; Command: 'heading 1'),
    (Caption: scxBarFormatComboH2; Command: 'heading 2'),
    (Caption: scxBarFormatComboH3; Command: 'heading 3'),
    (Caption: scxBarFormatComboH4; Command: 'heading 4'),
    (Caption: scxBarFormatComboH5; Command: 'heading 5'),
    (Caption: scxBarFormatComboH6; Command: 'heading 6'),
    (Caption: scxBarFormatComboNumList; Command: 'numbered list'),
    (Caption: scxBarFormatComboBulList; Command: 'bulleted list'),
    (Caption: scxBarFormatComboDirList; Command: 'directory list'),
    (Caption: scxBarFormatComboMenuList; Command: 'menu list'),
    (Caption: scxBarFormatComboDefTerm; Command: 'definition term'),
    (Caption: scxBarFormatComboDef; Command: 'definition'),
    (Caption: scxBarFormatComboPara; Command: 'paragraph'));

   FontSizeComboItems: array[0..7] of TcxHTMLEditorComboItem = (
    (Caption: scxBarFontSizeComboNormal; Command: ''),
    (Caption: '1 ( 8 pt)'; Command: '1'),
    (Caption: '2 (10 pt)'; Command: '2'),
    (Caption: '3 (12 pt)'; Command: '3'),
    (Caption: '4 (14 pt)'; Command: '4'),
    (Caption: '5 (18 pt)'; Command: '5'),
    (Caption: '6 (24 pt)'; Command: '6'),
    (Caption: '7 (36 pt)'; Command: '7'));

type
  TComponentAccess = class(TComponent);

  TcxHTMLEditorCombo = class(TCustomComboBoxEx)
  private
    FCmdId: Integer;
    FItemCount: Integer;
    FItemsInfo: PcxHTMLEditorComboItems;
  public
    function GetItemCommand: string;
    procedure SetValue(const AValue: string);
    property CmdId: Integer read FCmdId write FCmdId;
    property ItemCount: Integer read FItemCount write FItemCount;
    property ItemsInfo: PcxHTMLEditorComboItems read FItemsInfo write FItemsInfo;
  end;

  TcxHTMLEditorColorButton = class(TToolButton)
  private
    FColor: TcxWebColor;
    procedure SetColor(const Value: TcxWebColor);
  protected
    procedure ChangeBitmap(const Value: TColor);
  public
    function CheckMenuDropdown: Boolean; override;
    property Color: TcxWebColor read FColor write SetColor;
  end;

  TcxHTMLEditorUndoRedoButton = class(TToolButton)
  public
    constructor Create(AOwner: TComponent); override;
    function CheckMenuDropdown: Boolean; override;
  end;

  TcxPopupMenuHintFactory = class(TObject)
  private
    FDefaultPopupWndProc: Pointer;
    FPopupHintWindow: THintWindow;
    FRefCount: Integer;
  protected
    procedure PopupWndProc(var Message: TMessage);
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddRef;
    procedure Release;
    property RefCount: Integer read FRefCount;
  end;

  TcxPopupMenu = class(TPopupMenu)
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

var
  cxPopupMenuHintFactory: TcxPopupMenuHintFactory = nil;

{ TcxHTMLEditorCombo }

function TcxHTMLEditorCombo.GetItemCommand: string;
begin
  if ItemsInfo <> nil then
    Result := ItemsInfo^[ItemIndex].Command
  else
    Result := '';
end;

procedure TcxHTMLEditorCombo.SetValue(const AValue: string);
var
  I: Integer;
begin
  for I := 0 to ItemCount - 1 do
    if SameText(AValue, ItemsInfo^[I].Command) then
    begin
      ItemIndex := I;
      break;
    end;
end;

{ TcxHTMLEditorColorButton }

type
  TCustomImageListAccess = class(TCustomImageList);

function cxWebColorToWebStringEx(AColor: TcxWebColor; AsHex: Boolean): string;
begin
  if AsHex or not cxWebColorToIdent(AColor, Result) then
    with TcxWebColorTriple(AColor) do
      Result := Format('#%.2x%.2x%.2x', [Red, Green, Blue]);
  if Pos('clWeb', Result) = 1 then
    Result := Copy(Result, 6, Length(Result) - 5);
end;

procedure TcxHTMLEditorColorButton.ChangeBitmap(const Value: TColor);
var
  Image, Mask: TBitmap;
  R: TRect;
begin
  Image := TBitmap.Create;
  Mask := TBitmap.Create;
  with R do
  begin
    Left := 1;
    Top := 12;
    Right := 15;
    Bottom := 16;
  end;
  try
    Image.Width := FToolBar.Images.Width;
    Image.Height := FToolBar.Images.Height;
    Mask.Width := Image.Width;
    Mask.Height := Image.Height;
    TCustomImageListAccess(FToolBar.Images).GetImages(ImageIndex, Image, Mask);
    Image.Canvas.Brush.Style := bsSolid;
    Image.Canvas.Brush.Color := Value;
    Image.Canvas.FillRect(R);
    FToolBar.Images.Replace(ImageIndex, Image, Mask);
  finally
    Image.Free;
    Mask.Free;
  end;
end;

function TcxHTMLEditorColorButton.CheckMenuDropdown: Boolean;
begin
  if DropdownMenu <> nil then
    DropdownMenu.Tag := Integer(Self);
  Result := inherited CheckMenuDropdown;
end;

procedure TcxHTMLEditorColorButton.SetColor(const Value: TcxWebColor);

  function GetHint: string;
  var
    BPos: Integer;
  begin
    BPos := Pos('(', Hint) - 2;
    Result := Format('%s (%s)', [Copy(Hint, 1, BPos),
      cxWebColorToWebStringEx(Value, False)]);
  end;

begin
  if FColor = Value then Exit;
  FColor := Value;
  ChangeBitmap(Value);
  Hint := GetHint;
end;

{ TcxHTMLEditorUndoRedoButton }

function TcxHTMLEditorUndoRedoButton.CheckMenuDropdown: Boolean;
begin
  Result := inherited CheckMenuDropdown;
end;

constructor TcxHTMLEditorUndoRedoButton.Create(AOwner: TComponent);
begin
  inherited;
end;

{ TcxPopupMenuHintFactory }

constructor TcxPopupMenuHintFactory.Create;
begin
  inherited;
  FRefCount := 0;
  FDefaultPopupWndProc := Pointer(GetWindowLong(PopupList.Window, GWL_WNDPROC));
  SetWindowLong(PopupList.Window, GWL_WNDPROC, LongInt(Classes.MakeObjectInstance(PopupWndProc)));
end;

destructor TcxPopupMenuHintFactory.Destroy;
begin
  SetWindowLong(PopupList.Window, GWL_WNDPROC, Longint(FDefaultPopupWndProc));
  FreeAndNil(FPopupHintWindow);
  inherited;
end;

procedure TcxPopupMenuHintFactory.AddRef;
begin
  Inc(FRefCount);
end;

procedure TcxPopupMenuHintFactory.Release;
begin
  Dec(FRefCount);
end;

procedure TcxPopupMenuHintFactory.PopupWndProc(var Message: TMessage);

  procedure ValidateHintWindow(HintClass: THintWindowClass);
  begin
    if (FPopupHintWindow = nil) or (FPopupHintWindow.ClassType <> HintClass) then
    begin
      FPopupHintWindow.Free;
      FPopupHintWindow := HintClass.Create(nil);
    end;
  end;

  procedure DeactivateHint;
  begin
    if FPopupHintWindow <> nil then
      FPopupHintWindow.ReleaseHandle;
  end;

  procedure ActivateHint;
  var
    MousePos: TPoint;
    HintRect: TRect;
  begin
    if Application.Hint <> '' then
    begin
      GetCursorPos(MousePos);
      ValidateHintWindow(HintWindowClass);
      FPopupHintWindow.Color := Application.HintColor;
      HintRect := FPopupHintWindow.CalcHintRect(Screen.Width, Application.Hint, nil);
      OffsetRect(HintRect, MousePos.X, MousePos.Y);
      OffsetRect(HintRect, 0, GetSystemMetrics(SM_CYCURSOR) div 2 + 1);
      FPopupHintWindow.ActivateHint(HintRect, Application.Hint);
    end
    else
      DeactivateHint;
  end;

  function FindPopupByHandle(AHandle: HMENU): TPopupMenu;
  var
    I: Integer;
    FoundMenu: TPopupMenu;
  begin
    Result := nil;
    for I := 0 to PopupList.Count - 1 do
    begin
      FoundMenu := TPopupMenu(PopupList.Items[I]);
      if FoundMenu.Handle = AHandle then
      begin
        Result := FoundMenu;
        break;
      end
      else
        if FoundMenu.FindItem(AHandle, fkHandle) <> nil then
        begin
          Result := FoundMenu;
          break;
        end;
    end;
  end;

begin
  with Message do
    Result := CallWindowProc(FDefaultPopupWndProc, PopupList.Window,
      Msg, WParam, LParam);
  if Application <> nil then
    try
      if (Message.Msg = WM_MENUSELECT) and
      (FindPopupByHandle(Message.LParam) is TcxPopupMenu) then
        ActivateHint;
      if (Message.Msg = WM_UNINITMENUPOPUP) and
      (FindPopupByHandle(Message.WParam) is TcxPopupMenu) then
        DeactivateHint;
    except
      Application.HandleException(Application);
    end;
end;

{ TcxPopupMenu }

constructor TcxPopupMenu.Create(AOwner: TComponent);
begin
  inherited;
  if cxPopupMenuHintFactory = nil then
    cxPopupMenuHintFactory := TcxPopupMenuHintFactory.Create;
  cxPopupMenuHintFactory.AddRef;
end;

destructor TcxPopupMenu.Destroy;
begin
  cxPopupMenuHintFactory.Release;
  if cxPopupMenuHintFactory.RefCount = 0 then
    FreeAndNil(cxPopupMenuHintFactory); 
  inherited;
end;

{ TcxHTMLEditorBar }

constructor TcxHTMLEditorBar.Create(AOwner: TComponent);
begin
  inherited;
  FButtonList := TList.Create;
  FComboList := TList.Create;
  FImageList := TImageList.Create(Self);
  FImageList.ResourceLoad(rtBitmap, 'CXWEBHTMLEDITORBARIMAGES', clFuchsia);
  FColorPopup := TcxPopupMenu.Create(Self);
  FColorPopup.AutoHotkeys := maManual;
  FColorPopup.MenuAnimation := [maLeftToRight, maTopToBottom];
  TComponentAccess(FColorPopup).SetDesigning(False);
  PopulateColorPopup;
  FColorDialog := TColorDialog.Create(Self);
  FColorDialog.Options := [cdFullOpen];
  AutoSize := True;
  BandMaximize := bmDblClick;
  Images := FImageList;
  ShowHint := True;
  FUIDisabled := True;
  FormatBarActions[0].Method := InitFormatCombo;
  FormatBarActions[2].Method := InitFontNameCombo;
  FormatBarActions[4].Method := InitFontSizeCombo;
end;

destructor TcxHTMLEditorBar.Destroy;
begin
  FButtonList.Free;
  FComboList.Free;
  inherited;
end;

procedure TcxHTMLEditorBar.CreateActionControls;

  procedure AddToolBarControls(AToolBar: TToolBar; AActions: array of TcxHTMLEditorBarAction);
  var
    I: Integer;
  begin
    for I := High(AActions) downto Low(AActions) do
      case AActions[I].ActType of
        eatCombo: AddCombo(AToolBar, AActions[I]);
        eatButton, eatCheck: AddButton(AToolBar, AActions[I]);
        eatColor: AddColorDropDown(AToolBar, AActions[I]);
        eatDropDown: AddDropDown(AToolBar, AActions[I]);
        eatDevider: AddDevider(AToolBar);
        eatSpacer: AddSpacer(AToolBar);
      end;
  end;
var
  TBWidth: Integer;
begin
  FFormatToolBar := AddToolBar('tbTextFormating');
  AddToolBarControls(FFormatToolBar, FormatBarActions);
  FTableToolBar := AddToolBar('tbTable');
  AddToolBarControls(FTableToolBar, TableBarActions);
  with FTableToolBar.Buttons[FTableToolBar.ButtonCount - 1] do
    TBWidth := Left + Width;
  TBWidth := TBWidth + FTableToolBar.Left * 2;
  FFramesToolBar := AddToolBar('tbFrames');
  Bands.FindBand(FTableToolBar).Width := TBWidth;
  Bands.FindBand(FFramesToolBar).Break := False;
  AddToolBarControls(FFramesToolBar, FramesBarActions);
end;

procedure TcxHTMLEditorBar.AddButton(AToolBar: TToolBar;
  AAction: TcxHTMLEditorBarAction);
var
  Button: TToolButton;
begin
  Button := TToolButton.Create(AToolBar);
  with Button do
  begin
    Name := 'tbb' + AAction.Name;
    Parent := AToolBar;
    if AAction.ActType = eatCheck then
      Style := tbsCheck
    else
      Style := tbsButton;
    Hint := AAction.Hint;
    ImageIndex := AAction.ImgIndex;
    Enabled := False;
    Tag := AAction.Command;
    OnClick := ToolButtonClick;
  end;
  FButtonList.Add(Button);
end;

procedure TcxHTMLEditorBar.AddCombo(AToolBar: TToolBar;
  AAction: TcxHTMLEditorBarAction);
var
  Combo: TcxHTMLEditorCombo;
begin
  Combo := TcxHTMLEditorCombo.Create(AToolBar);
  with Combo do
  begin
    Name := 'tbc' + AAction.Name;
    Parent := AToolBar;
    TabStop := False;
    Enabled := False;
    Hint := AAction.Hint;
    CmdId := AAction.Command;
    OnChange := ComboBoxChange;
    OnEnter := Lock;
    OnExit := UnLock;
    if Assigned(AAction.Method) then
      AAction.Method(Combo);
  end;
  TComponentAccess(Combo).SetDesigning(False);
  FComboList.Add(Combo);
end;

procedure TcxHTMLEditorBar.AddDevider(AToolBar: TToolBar);
begin
  with TToolButton.Create(AToolBar) do
  begin
    Parent := AToolBar;
    Style := tbsSeparator;
    Width := 8;
  end;
end;

procedure TcxHTMLEditorBar.PopulateColorPopup;
var
  Item: TMenuItem;
begin
  Item := TMenuItem.Create(FColorPopup);
  Item.Caption := scxBarStdColors;
  Item.Tag := 2;
  FColorPopup.Items.Add(Item);
  GetColorValues(AddStdColor);

  Item := TMenuItem.Create(FColorPopup);
  Item.Caption := scxBarWebColors;
  Item.Tag := 10;
  FColorPopup.Items.Add(Item) ;

  Item := TMenuItem.Create(FColorPopup);
  Item.Caption := scxBarSystemColors;
  Item.Tag := 4;
  FColorPopup.Items.Add(Item);
  cxGetWebColorPalette(AddWebColor);

  Item := TMenuItem.Create(FColorPopup);
  Item.Caption := scxBarCustomColor + cDialogSuffix;
  Item.OnClick := CustomColorClick;
  FColorPopup.Items.Add(Item);
end;

procedure TcxHTMLEditorBar.AddStdColor(const S: string);
begin
  if FColorPopup.Items[0].Count < StandardColorsCount then
    AddColorItem(FColorPopup.Items[0], StringToColor(S)); // standard palette
end;

procedure TcxHTMLEditorBar.AddWebColor(const S: string);
begin
  if FColorPopup.Items[1].Count < 140 then
    AddColorItem(FColorPopup.Items[1], cxStringToWebColor(S)) // web palette
  else
    AddColorItem(FColorPopup.Items[2], cxStringToWebColor(S)); // system palette
end;

procedure TcxHTMLEditorBar.AddColorItem(AParent: TMenuItem; Color: Integer);
var
  Item: TMenuItem;
  R: TRect;
begin
  Item := TMenuItem.Create(AParent);
  Item.Tag := Color;
  Item.Hint := cxWebColorToWebStringEx(Item.Tag, False);
  with R do
  begin
    Left := 0;
    Top := 0;
    Right := 16;
    Bottom := 16;
  end;
  with Item.Bitmap do
  begin
    Transparent := False;
    TransparentColor := clNone;
    Width := R.Right - R.Left;
    Height := R.Bottom - R.Top;
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := clBtnShadow;
    Canvas.FrameRect(R);
    Canvas.Brush.Color := Color;
    InflateRect(R, -1, -1);
    Canvas.FillRect(R);
  end;
  Item.OnClick := ColorPopupClick;
  Item.OnMeasureItem := MeasureColorPopupItem;
  AParent.Add(Item);
  if Item.MenuIndex mod AParent.Tag = 0 then
    Item.Break := mbBreak;
end;

procedure TcxHTMLEditorBar.Lock(ASender: TObject);
begin
  FDisableLocked := True;
end;

procedure TcxHTMLEditorBar.UnLock(ASender: TObject);
begin
  FDisableLocked := False;
end;

procedure TcxHTMLEditorBar.AddColorDropDown(AToolBar: TToolBar;
  AAction: TcxHTMLEditorBarAction);
var
  Button: TToolButton;
begin
  Button := TcxHTMLEditorColorButton.Create(AToolBar);
  with Button do
  begin
    Name := 'tbb' + AAction.Name;
    Parent := AToolBar;
    Style := tbsDropDown;
    Hint := AAction.Hint + ' ('+ scxBarColorHintDef +')';
    ImageIndex := AAction.ImgIndex;
    DropdownMenu := FColorPopup;
    Enabled := False;
    Tag := AAction.Command;
    OnClick := DropDownClick;
  end;
  FButtonList.Add(Button);
end;

procedure TcxHTMLEditorBar.AddDropDown(AToolBar: TToolBar;
  AAction: TcxHTMLEditorBarAction);
var
  Button: TToolButton;
begin
  Button := TcxHTMLEditorUndoRedoButton.Create(AToolBar);
  with Button do
  begin
    Name := 'tbb' + AAction.Name;
    Parent := AToolBar;
    Style := tbsDropDown;
    Hint := AAction.Hint;
    ImageIndex := AAction.ImgIndex;
    Enabled := False;
    Tag := AAction.Command;
    OnClick := ToolButtonClick;
  end;
  FButtonList.Add(Button);
end;

procedure TcxHTMLEditorBar.AddSpacer(AToolBar: TToolBar);
begin
  with TLabel.Create(AToolBar) do
  begin
    Parent := AToolBar;
    AutoSize := False;
    Caption := '';
    Width := 4;
  end;
end;

function TcxHTMLEditorBar.AddToolBar(const AName: string): TToolBar;
begin
  Result := TToolBar.Create(Self);
  with Result do
  begin
    Parent := Self;
    Name := AName;
    Images := FImageList;
    AutoSize := True;
    BorderWidth := 1;
    EdgeInner := esNone;
    EdgeOuter := esNone;
    Flat := True;
    Height := 26;
  end;
  TComponentAccess(Result).SetDesigning(False);
end;

procedure TcxHTMLEditorBar.ComboBoxChange(ASender: TObject);
var
  VIn: OleVariant;
  Combo: TcxHTMLEditorCombo;
begin
  if FUIDisabled or (CommandTarget = nil) or
    not (ASender is TcxHTMLEditorCombo) then Exit;
  Combo := TcxHTMLEditorCombo(ASender);
  VIn := Combo.GetItemCommand;
  CommandTarget.Exec(@CGID_MSHTML, Combo.CmdId, OLECMDEXECOPT_DONTPROMPTUSER, @VIn, nil);
end;

procedure TcxHTMLEditorBar.ToolButtonClick(ASender: TObject);
begin
  if FUIDisabled or (CommandTarget = nil) then Exit;
  CommandTarget.Exec(@CGID_MSHTML, TComponent(ASender).Tag, OLECMDEXECOPT_DODEFAULT, nil, nil)
end;

procedure TcxHTMLEditorBar.DropDownClick(ASender: TObject);
var
  VIn: OleVariant;
  Color: TcxWebColor;
begin
  if FUIDisabled or (CommandTarget = nil) then Exit;
  if not (ASender is TcxHTMLEditorColorButton) then Exit;
  Color := TcxHTMLEditorColorButton(ASender).Color;
  VIn := cxWebColorToWebStringEx(Color, False);
  CommandTarget.Exec(@CGID_MSHTML, TComponent(ASender).Tag, OLECMDEXECOPT_DODEFAULT, @VIn, nil)
end;

procedure TcxHTMLEditorBar.ColorPopupClick(ASender: TObject);
var
  Item: TMenuItem;
  Menu: TComponent;
begin
  Item := TMenuItem(ASender);
  Menu := Item.Owner;
  while not (Menu is TcxPopupMenu) do
    Menu := Menu.Owner;
  if TObject(Menu.Tag) is TcxHTMLEditorColorButton then
  begin
    TcxHTMLEditorColorButton(Menu.Tag).Color := Item.Tag;
    TToolButton(Menu.Tag).Click;
  end;
  Menu.Tag := 0;
end;

procedure TcxHTMLEditorBar.CustomColorClick(ASender: TObject);
var
  Button: TcxHTMLEditorColorButton;
begin
  Button := TcxHTMLEditorColorButton(TComponent(ASender).Owner.Tag);
  if Button = nil then Exit;
  FColorDialog.Color := Button.Color;
  if FColorDialog.Execute then
  begin
    Button.Color := FColorDialog.Color;
    Button.Click;
    TComponent(ASender).Owner.Tag := 0;
  end;
end;

function TcxHTMLEditorBar._AddRef: Integer;
begin
  Result := -1;
end;

function TcxHTMLEditorBar._Release: Integer;
begin
  Result := -1;
end;

function TcxHTMLEditorBar.QueryInterface(const IID: TGUID;
  out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;


procedure TcxHTMLEditorBar.SetCommandTarget(const ACommandTarget: IcxOleCommandTarget);
begin
  FCommandTarget := ACommandTarget;
end;

procedure TcxHTMLEditorBar.DisableUI(const ADisabled: Boolean);
begin
  FUIDisabled := ADisabled and not FDisableLocked;
end;

procedure TcxHTMLEditorBar.UpdateActionControls;
const
  BuffLen = 255;
var
  I: Integer;
  Button: TToolButton;
  Combo: TcxHTMLEditorCombo;
  Cmd: TOleCmd;
  VOut: OleVariant;
  Text: POleCmdText;
begin
  if FUIDisabled or (CommandTarget = nil) then
    for I := 0 to FButtonList.Count - 1 do
      TToolButton(FButtonList[I]).Enabled := False
  else
  begin
    // Update Buttons
    for I := 0 to FButtonList.Count - 1 do
    begin
      Button := TToolButton(FButtonList[I]);
      Cmd.cmdID := Button.Tag;
      Cmd.cmdf := 0;
      GetMem(Text, SizeOf(TOleCmdText) + BuffLen * SizeOf(WideChar));
      try
        Text^.cmdtextf := OLECMDTEXTF_STATUS;
        Text^.cwBuf := BuffLen;
        Text^.cwActual := 0;
        if CommandTarget.QueryStatus(@CGID_MSHTML, 1, @Cmd, Text) = S_OK then
        begin
          Button.Enabled := (Cmd.cmdf and OLECMDF_ENABLED) = OLECMDF_ENABLED;
          Button.Down := (Cmd.cmdf and OLECMDF_LATCHED) = OLECMDF_LATCHED;
          if Text^.cwActual > 0 then
            Button.Hint := WideCharToString(Text^.rgwz);
        end;
      finally
        FreeMem(Text);
      end;
    end;
    // Update Combos
    for I := 0 to FComboList.Count - 1 do
    begin
      Combo := TcxHTMLEditorCombo(FComboList[I]);
      Cmd.cmdID := Combo.CmdId;
      Cmd.cmdf := 0;
      if CommandTarget.QueryStatus(@CGID_MSHTML, 1, @Cmd, @Text) = S_OK then
        Combo.Enabled := (Cmd.cmdf and OLECMDF_ENABLED) = OLECMDF_ENABLED;
      VarClear(VOut);
      if (CommandTarget.Exec(@CGID_MSHTML, Cmd.cmdID, OLECMDEXECOPT_DONTPROMPTUSER, nil, @VOut) = S_OK) then
        try
          Combo.SetValue(VarToStr(VOut));
        except
        end;
    end;
  end;
end;

procedure TcxHTMLEditorBar.InitCombo(ACombo: TCustomCombo;
    const AItems: array of TcxHTMLEditorComboItem);
var
  I: Integer;
begin
  for I := Low(AItems) to High(AItems) do
    ACombo.Items.Add(AItems[I].Caption);
  TcxHTMLEditorCombo(ACombo).ItemsInfo := @AItems;
  TcxHTMLEditorCombo(ACombo).ItemCount := High(AItems) - Low(AItems) + 1;
end;

procedure TcxHTMLEditorBar.InitFontNameCombo(ASender: TObject);
var
  I: Integer;
begin
  if not (ASender is TcxHTMLEditorCombo) then Exit;
  SetLength(FontNameComboItems, Screen.Fonts.Count + 1);
  FontNameComboItems[0].Caption := '(' + scxBarFontComboDef + ')';
  FontNameComboItems[0].Command := '';
  for I := 0 to Screen.Fonts.Count - 1do
  begin
    FontNameComboItems[I + 1].Caption := Screen.Fonts.Strings[I];
    FontNameComboItems[I + 1].Command := Screen.Fonts.Strings[I];
  end;
  InitCombo(TcxHTMLEditorCombo(ASender), FontNameComboItems);
  with TcxHTMLEditorCombo(ASender) do
  begin
    ItemIndex := 0;
    Width := 140;
    Style := csExDropDownList;
  end;
end;

procedure TcxHTMLEditorBar.InitFontSizeCombo(ASender: TObject);
begin
  if not (ASender is TcxHTMLEditorCombo) then Exit;
  InitCombo(TcxHTMLEditorCombo(ASender), FontSizeComboItems);
  with TcxHTMLEditorCombo(ASender) do
  begin
    Style := csExDropDownList;
    ItemIndex := 0;
    Width := 65;
  end;
end;

procedure TcxHTMLEditorBar.InitFormatCombo(ASender: TObject);
begin
  if not (ASender is TCustomCombo) then Exit;
  InitCombo(TcxHTMLEditorCombo(ASender), FormatComboItems);
  with TComboBoxEx(ASender) do
  begin
    Style := csExDropDownList;
    ItemIndex := 0;
    Width := 100;
  end;
end;

procedure TcxHTMLEditorBar.MeasureColorPopupItem(Sender: TObject;
  ACanvas: TCanvas; var Width, Height: Integer);
var
  NonClientMetrics: TNonClientMetrics;
begin
  NonClientMetrics.cbSize := sizeof(NonClientMetrics);
  if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
  begin
    Width := Height + NonClientMetrics.lfMenuFont.lfHeight;
    Height := NonClientMetrics.iMenuHeight + 2;
  end;
end;

end.