iwtmsmenus.pas

TMS IntraWEb增强控件TMSIntraWeb_v2.3.2.1_D2007.rar

    FOpen: TIWMenuOpen;
    FRootItemBorderColor : TIWColor;
    FRootItemBorderHoverColor : TIWColor;
    FRootItemBorderWidth : integer;
    FRootItemColor : TIWColor;
    FRootItemColorTo : TIWColor;
    FRootItemHeight : Integer;
    FRootItemHoverColor : TIWColor;
    FRootItemHoverColorTo : TIWColor;
    FRootItemDownColor : TIWColor;
    FRootItemDownColorTo : TIWColor;
    FRootItemFont : TIWFont;
    FRootItemGradientDirection : TTIWGradientDirection;
    FRootItemHoverFontColor : TIWColor;
    FSeparatorColor : TIWColor;
    FShowIcons : Boolean;
    FSubMenuGlyph: TIPicture;
    FTextAlignment : TAlignment;
    FUseBorder : Boolean;

    FDesignMode: Boolean;

    arMenuId : TStringList;
    arMenuName : TStringList;
    Tiers : TStringList;
    MenuCode : string;
    Level : integer;
    AutoNumber : integer;
    FCacheDir : string;

    procedure BackgroundChanged(Sender: TObject);
    procedure SetAutoHiding(const Value : boolean);
    procedure SetBackgroundImage(const Value: TIPicture);
    {$IFNDEF TMSIW71}
    procedure SetDesignMode(const Value: Boolean);
    {$ENDIF}
    procedure SetFade(const Value : TTIWFade);
    procedure SetHoverGradientDirection(const Value : TTIWGradientDirection);
    procedure SetIconBackgroundColor(const Value : TIWColor);
    procedure SetIconBackgroundColorTo(const Value : TIWColor);
    procedure SetItemColor(const Value : TIWColor);
    procedure SetItemHeight(const Value : Integer);
    procedure SetMenu(const Value: TMenu);
    procedure SetOpacity(const Value : Integer);
    procedure SetRootItemBorderColor(const Value : TIWColor);
    procedure SetRootItemBorderHoverColor(const Value : TIWColor);
    procedure SetRootItemBorderWidth(const Value : integer);
    procedure SetRootItemColor(const Value: TIWColor);
    procedure SetRootItemColorTo(const Value: TIWColor);
    procedure SetRootItemDownColor(const Value : TIWColor);
    procedure SetRootItemDownColorTo(const Value : TIWColor);
    procedure SetRootItemFont(const Value : TIWFont);
    procedure SetRootItemGradientDirection(const Value : TTIWGradientDirection);
    procedure SetRootItemHeight(const Value : integer);
    procedure SetRootItemHoverColor(const Value : TIWColor);
    procedure SetRootItemHoverColorTo(const Value : TIWColor);
    procedure SetRootItemHoverFontColor(const Value : TIWColor);
    procedure SetTextAlignment(const Value : TAlignment);
    procedure SetSeparatorColor(const Value: TIWColor);
    procedure SetSubMenuGlyph(const Value: TIPicture);
    procedure SetUseBorder(const value : boolean);
    function FontToCSS(AFont : TIWFont; FromRoot : Boolean) : string;
    function TextAlignToStr(Alignment : TAlignment) : string;
    function MakeMenu(AName : string; AItem : TMenuItem) : string;
    procedure CacheDir;
    procedure DrawGradient(Canvas: TCanvas; FromColor, ToColor: TIWColor; Steps: Integer; r:TRect; Direction: Boolean);
  protected
    procedure Submit(const AValue: string); override;
    procedure SetValue(const value:string); override;    
    function HTMLClr(Color: TIWColor): string;
    function HTMLClrEx(Color: TIWColor): string;
    {$IFDEF TMSIW51}
    function CursorToHtml(Cursor : TIWCursor) : string;
    {$ELSE}
    function CursorToHtml(Cursor : TCursor) : string;
    {$ENDIF}
    function GradDirToStr(GradDir : TTIWGradientDirection) : string;
    function FadeToStr(FadeSpeed : TTIWFade) : string;
  public
    {$IFDEF TMSIW6}
    procedure IWPaint; override;
    function RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag; override;
    {$ELSE}
    procedure Paint; override;
    function RenderHTML: TIWHTMLTag; override;
    {$ENDIF}
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property AutoHiding : boolean read FAutoHiding write SetAutoHiding;
    property BackgroundImage: TIPicture read FBackgroundImage write SetBackgroundImage;
    property Border: Boolean read FBorder write FBorder;
    property BorderColor: TIWColor read FBorderColor write FBorderColor;
    property Caption;
    property ClientEvents: TMenuClientEvents read FClientEvents write FClientEvents;
    property Color;
    {$IFNDEF TMSIW71}
    property DesignMode: Boolean read FDesignMode write SetDesignMode;
    {$ENDIF}
    property Fade : TTIWFade read FFade write SetFade;
    property Font;
    property HoverBorderColor: TIWColor read FHoverBorderColor write FHoverBorderColor;
    property HoverColor: TIWColor read FHoverColor write FHoverColor;
    property HoverColorTo : TIWColor read FHoverColorTo write FHoverColorTo;
    property HoverFontColor: TIWColor read FHoverFontColor write FHoverFontColor;
    property HoverGradientDirection : TTIWGradientDirection read FHoverGradientDirection write SetHoverGradientDirection;
    property IconBackgroundColor : TIWColor read FIconBackgroundColor write SetIconBackgroundColor;
    property IconBackgroundColorTo : TIWColor read FIconBackgroundColorTo write SetIconBackgroundColorTo;
    property ItemColor : TIWColor read FItemColor write SetItemColor;
    property ItemHeight : Integer read FItemHeight write SetItemHeight;
    property ItemSpacing: Integer read FItemSpacing write FItemSpacing;
    property Menu: TMenu read FMenu write SetMenu;
    property Opacity : Integer read FOpacity write SetOpacity;
    property Open: TIWMenuOpen read FOpen write FOpen;
    property RootItemBorderColor : TIWColor read FRootItemBorderColor write SetRootItemBorderColor;
    property RootItemBorderHoverColor : TIWColor read FRootItemBorderHoverColor write SetRootItemBorderHoverColor;
    property RootItemBorderWidth : integer read FRootItemBorderWidth write SetRootItemBorderWidth;
    property RootItemColor : TIWColor read FRootItemColor write SetRootItemColor;
    property RootItemColorTo : TIWColor read FRootItemColorTo write SetRootItemColorTo;
    property RootItemHeight : Integer read FRootItemHeight write SetRootItemHeight;
    property RootItemHoverColor : TIWColor read FRootItemHoverColor write SetRootItemHoverColor;
    property RootItemHoverColorTo : TIWColor read FRootItemHoverColorTo write SetRootItemHoverColorTo;
    property RootItemDownColor : TIWColor read FRootItemDownColor write SetRootItemDownColor;
    property RootItemDownColorTo : TIWColor read FRootItemDownColorTo write SetRootItemDownColorTo;
    property RootItemFont : TIWFont read FRootItemFont write SetRootItemFont;
    property RootItemGradientDirection : TTIWGradientDirection read FRootItemGradientDirection write SetRootItemGradientDirection;
    property RootItemHoverFontColor : TIWColor read FRootItemHoverFontColor write SetRootItemHoverFontColor;
    property SeparatorColor : TIWColor read FSeparatorColor write SetSeparatorColor;
    property ShowIcons : Boolean read FShowIcons write FShowIcons;
    property SubMenuGlyph: TIPicture read FSubMenuGlyph write SetSubMenuGlyph;
    property TextAlignment : TAlignment read FTextAlignment write SetTextAlignment;
    property UseBorder : boolean read FUseBorder write SetUseBorder;
  end;

implementation

uses
  {$IFDEF LINUX}
  QImgList,
  {$ELSE}
  ImgList, ShellAPI, CommCtrl,
  {$ENDIF}
  IWApplication, IWServerControllerBase,
  SWStrings, SWSystem, IWAppForm, IWServer;

{$DEFINE REMOVESTRIP}
{$DEFINE REMOVEDRAW}

{$IFDEF LINUX}
 {$I QHTMLENG.PAS}
{$ELSE}
{$I iwhtmleng.pas}
{$ENDIF}

{$IFNDEF DELPHI7_LVL}
function BoolToStr(B: Boolean; UseBoolStrs: Boolean = False): string;
const
  cSimpleBoolStrs: array [boolean] of String = ('0', '-1');
begin
  Result := cSimpleBoolStrs[B];
end;
{$ENDIF}


{ TTIWMainMenu }

constructor TTIWMainMenu.Create(AOwner: TComponent);
begin
  inherited;
  {$IFDEF TMSIW6}
  {TODO}
  {$ELSE}
  FSupportsInput := True;
  FSupportsSubmit := True;
  {$ENDIF}
  FRootItemFont := TIWFont.Create;
  FRootItemFont.Size := 12;
  FRootItemFont.FontName := 'Verdana';
  FRootItemFont.Color := clBlack;
  Font.Color := clWindowText;
  Font.FontName := 'Verdana';
  Font.Size := 11;
  FAutoHiding := true;
  FBackgroundImage := TIPicture.Create;
  FBackgroundImage.OnChange := BackgroundChanged;
  FBorder := true;
  FClientEvents := TMenuClientEvents.Create;
  FDesignMode := True;
  FFade := fdNone;
  FHoverBorderColor := clHighlight;
  FHoverColor := $F0CAA6;
  FHoverColorTo := clNone;
  FHoverFontColor := clBlack;
  FHoverGradientDirection := gdHorizontal;
  FIconBackgroundColor := clBtnFace;
  FIconBackgroundColorTo := clNone;
  FItemColor := clWhite;
  FItemHeight := 20;
  FItemSpacing := 3;
  FOpacity := 100;
  FOpen := moClick;
  FRootItemColor := clBtnFace;
  FRootItemColorTo := clNone;
  FRootItemBorderColor := clBtnFace;
  FRootItemBorderWidth := 1;
  FRootItemGradientDirection := gdHorizontal;
  FRootItemHoverFontColor := clBlack;
  FRootItemHoverColor := clNone;
  FRootItemHoverColorTo := clNone;
  FRootItemDownColor := clNone;
  FRootItemDownColorTo := clNone;
  FRootItemBorderHoverColor := clNone;
  FSeparatorColor := clBtnFace;
  FSubMenuGlyph := TIPicture.Create;
  FUseBorder := true;
  FShowIcons := true;
  FTextAlignment := taLeftJustify;
  Self.Height := 20;
  Self.Width := 200;
  Self.BorderColor := clBtnFace;
  Self.Color := clBtnFace;
  Zindex := 10;

  arMenuId := TStringList.Create;
  arMenuName := TStringList.Create;
  Tiers := TStringList.Create;
  MenuCode := '';
  Level := 0;
  AutoNumber := 0;
  FCacheDir := '';

  if not (csDesigning in Componentstate) then
  begin
    {$IFDEF TMSIW51}
    TIWServer.AddInternalFile('IW_JS_TMSMENU','/js/TMSMENU.js');
    TIWServer.AddInternalFile('IW_JS_TMSMENUSETTINGS','/js/TMSMENUSETTINGS.js');
    TIWServer.AddInternalFile('IW_JS_TMSMENUUTIL','/js/TMSMENUUTIL.js');
    {$ELSE}
    GIWServer.AddInternalFile('IW_JS_TMSMENU');
    GIWServer.AddInternalFile('IW_JS_TMSMENUSETTINGS');
    GIWServer.AddInternalFile('IW_JS_TMSMENUUTIL');
    {$ENDIF}
  end;
  {$IFDEF TMSIW7}
  SupportsPartial := true;
  {$ENDIF}
end;

procedure TTIWMainMenu.Invalidate;
begin
  inherited;
end;

destructor TTIWMainMenu.Destroy;
begin
  FClientEvents.Free;
  FSubMenuGlyph.Free;
  FBackgroundImage.Free;
  FRootItemFont.Free;
  arMenuId.Free;
  arMenuName.Free;
  Tiers.Free;
  inherited;
end;

function TTIWMainMenu.HTMLClr(color: TIWColor):string;
begin
  Result := ColorToRGBString(ColorToRGB(color));
end;

function TTIWMainMenu.HTMLClrEx(color: TIWColor):string;
begin
  if (color = clNone) then
    Result := ''
  else
    Result := ColorToRGBString(ColorToRGB(color));
end;

{$IFDEF TMSIW51}
function TTIWMainMenu.CursorToHtml(Cursor : TIWCursor):string;
{$ELSE}
function TTIWMainMenu.CursorToHtml(Cursor : TCursor):string;
{$ENDIF}
begin
  case Cursor of
    {$IFDEF TMSIW51}
    crCrossHair: Result := 'crosshair';
    crDefault: Result := 'default';
    crWait: Result := 'wait';
    crAuto: Result := 'auto';
    crPointer: Result := 'pointer';
    crMove: Result := 'move';
    crEResize: Result := 'e-resize';
    crNEResize: Result := 'ne-resize';
    crNWResize: Result := 'nw-resize';
    crNResize: Result := 'n-resize';
    crSEResize: Result := 'se-resize';
    crSWResize: Result := 'sw-resize';                   
    crSResize: Result := 's-resize';
    crWResize: Result := 'w-resize';
    crText: Result := 'text';
    crHelp: Result := 'help';
    {$ELSE}
    crAppStart : Result := 'wait';
    crCross : Result := 'crosshair';
    crDefault : Result := 'default';
    crHandPoint : Result := 'pointer';
    crHelp : Result := 'help';
    crHourGlass : Result := 'wait';
    criBeam : Result := 'auto';
    crSizeAll : Result := 'move';
    crSizeNESW : Result := 'ne-resize';
    crSizeNS : Result := 'n-resize';
    crSizeNWSE : Result := 'nw-resize';
    crSizeWE : Result := 'e-resize';
    {$ENDIF}
  else
    Result := 'default';
  end;
end;

function TTIWMainMenu.GradDirToStr(GradDir : TTIWGradientDirection) : string;
begin
  if GradDir = gdHorizontal then
    Result := '1'
  else
    Result := '0';
end;

function TTIWMainMenu.FadeToStr(FadeSpeed : TTIWFade) : string;
begin
  case FadeSpeed of
    fdNone : Result := '0';
    fdSlow : Result := '10';
    fdMedium : Result := '7';
    fdFast : Result := '4';
  else
    Result := '0';
  end;
end;

function TTIWMainMenu.FontToCSS(AFont : TIWFont; FromRoot : Boolean) : string;
var
  Weight, Res : string;
begin
  Weight := '';
  Res := '';

  if fsBold in AFont.Style then
    Weight := #13'font-weight: bold;'#13;

  if (FromRoot) then
  begin
    if (AFont.FontName <> '') then
      Res := Res
        + '  font-family:' + AFont.FontName + ';'#13;

    if (fsItalic in AFont.Style) then
      Res := Res
        + ' font-style:italic;'#13;
        
    Res := Res
      + '  color:' + HTMLClr(FRootItemFont.Color) + ';'#13
      + Weight
      + '  font-size:' + IntToStr(AFont.Size) + ';'#13;
  end
  else
  begin
    if (AFont.FontName <> '') then
      Res := '  font-family:' + AFont.FontName + ';'#13;

    if (AFont.Color <> clNone) then
      Res := Res
        + '  color:' + HTMLClr(AFont.Color) + ';'#13
    else
      Res := Res