⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 iwtmsmenus.pas

📁 TMS IntraWEb增强控件TMSIntraWeb_v2.3.2.1_D2007.rar
💻 PAS
📖 第 1 页 / 共 5 页
字号:
        + '  color:black;'#13;

    if (fsItalic in AFont.Style) then
      Res := Res
        + ' font-style:italic;'#13;

    Res := Res
      + Weight
      + '  font-size:' + IntToStr(AFont.Size) + ';'#13;
  end;
  Result := Res;
end;

function TTIWMainMenu.TextAlignToStr(Alignment : TAlignment) : string;
begin
  case Alignment of
    taLeftJustify:
      Result := 'text-align:left;';
    taCenter:
      Result := 'text-align:center;';
    taRightJustify:
      Result := 'text-align:right;';
    else
      Result := 'text-align:left;';
  end;
end;

function TTIWMainMenu.MakeMenu(AName : string; AItem : TMenuItem) : string;
var
  i, l, x, Idx : integer;
  Name, CleanedID, URLBack, URL, ItemSP, IconColorTo, Cap : string;
  ID : array of integer;
  UseImage : boolean;
  SubItem : TMenuItem;
  BMP : TBitmap;

begin
  //ID = new int[AItem.SubMenu.Count];
  SetLength(ID,AItem.Count);

  CleanedID := HTMLName;

  if (AItem.Count > 0) then
  begin
    if (Tiers.Count = 0) then
    begin
      for l := 0 to StrToInt(AName)- 1 do
        Tiers.Add('null');

      Tiers.Add(IntToStr(Level));
    end
    else
    begin
      if (StrToInt(AName) > Tiers.Count) then
      begin
        for x := Tiers.Count to StrToInt(AName) - 1 do
          Tiers.Add('null');

        Tiers.Add(IntToStr(Level));
      end
      else
      begin
        if (StrToInt(AName) = Tiers.Count) then
          Tiers.Add(IntToStr(Level))
        else
          Tiers[StrToInt(AName)] := IntToStr(Level);
      end;
    end;

    Idx := arMenuId.IndexOf(AName);
    URLBack := '';
    useImage := false;

    if not (FBackgroundImage.Empty) then
    begin
      UseImage := true;

      if FBackgroundImage.IsGIF then
      {$IFDEF TMSIW71}
      URLBack := TIWServerControllerBase.NewCacheFile('gif',true)
      {$ELSE}
      URLBack := TIWServerControllerBase.NewCacheFile('gif')
      {$ENDIF}
      else
      {$IFDEF TMSIW71}
      URLBack := TIWServerControllerBase.NewCacheFile('jpg',true);
      {$ELSE}
      URLBack := TIWServerControllerBase.NewCacheFile('jpg');
      {$ENDIF}

      FBackgroundImage.SaveToFile(URLBack);
      URLBack := FCacheDir + ExtractFileName(URLBack);
    end;

    MenuCode := MenuCode
      + #13
      + 'startMenu(' + AName + ',150,' + IntToStr(Level) + ',''' + HTMLClr(FBorderColor) + ''','''
      + CleanedID + '_' + arMenuName[Idx] + ''',''' + IntToStr(100+ZIndex) + ''','''
      + URLBack + ''',''' + IntToStr(Opacity) + ''');'#13;

    for i := 1 to AItem.Count do
    begin
      SubItem := AItem.Items[i-1];
      URL := '';
      if (SubItem.Visible) then
      begin
        if (SubItem.ImageIndex >= 0) and Assigned(FMenu.Images) and not (SubItem.Checked) then
        begin
          if (FMenu.Images.Count > SubItem.ImageIndex) then
          begin
            BMP := TBitmap.Create;
            FMenu.Images.BkColor := FIconBackgroundColor;
            FMenu.Images.GetBitmap(SubItem.ImageIndex,BMP);
            //URL := HTMLBmp(BMP);
            URL := '';
            {$IFDEF TMSIW71}
            URL := TIWServerControllerBase.NewCacheFile('bmp',true);
            {$ELSE}
            URL := TIWServerControllerBase.NewCacheFile('bmp');
            {$ENDIF}
            BMP.SaveToFile(URL);
            URL := FCacheDir + ExtractFileName(URL);
            BMP.Free;
          end;
        end;

        Name := arMenuName[Idx] + '_' + IntToStr(i);

        ItemSP := IntToStr(FItemSpacing);

      (*
      {$IFDEF TMSIW6}
      if (TIWComponent40Context(AContext).WebApplication.Browser = brMozilla) then
      {$ELSE}
      if (WebApplication.Browser = brMozilla) then
      {$ENDIF}
        ItemSP := '0';
      *)

        IconColorTo := '';

        if (FIconBackgroundColorTo <> clNone) then
          IconColorTo := HTMLClr(FIconBackgroundColorTo);

        if (SubItem.Caption = '-') then
        begin
          MenuCode := MenuCode
            + 'menuSpacer(''' + HTMLClr(FSeparatorColor) + ''',''' + CleanedID + '_' + Name + ''','''
            + IIF(FShowIcons,'True','False') + ''',''' + IntToStr(FOpacity) + ''',''' + ItemSP
            + ''',''' + HTMLClr(FItemColor) + ''',''' + HTMLClr(FIconBackgroundColor)
            + ''',''' + IconColorTo + ''');'#13;
        end
        else
        begin
          if (FClientEvents.IndexOf(SubItem.Name) >= 0) then
          begin
            MenuCode := MenuCode
              + 'function ' + CleanedID + '_' + Name + '(el)  {'#13
              + '  hideAllMenus();'#13
              + '  ' + FClientEvents.Items[FClientEvents.IndexOf(SubItem.Name)].FItemScript + #13
              + '  ' + CleanedID + 'SubmitValue(''' + CleanedID + '_' + Name + ''')'#13
              + '}'#13;
          end;

          Cap := SubItem.Caption;
          Cap := StringReplace(Cap, '''', '&#39;', [rfReplaceAll, rfIgnoreCase]);
          Cap := StringReplace(Cap, '<', '&lt;', [rfReplaceAll, rfIgnoreCase]);
          Cap := StringReplace(Cap, '>', '&gt;', [rfReplaceAll, rfIgnoreCase]);

          if (SubItem.Count = 0) then
            MenuCode := MenuCode
              + 'menuItem(''' + Cap + ''',''' + Name + ''','
              + IntToStr(Level) + ',''' + CleanedID + '_' + Name + ''',''' + URL + ''', '''
              + IIF(FShowIcons,'True','False') + ''',''' + HTMLClr(FIconBackgroundColor) + ''',''' + IntToStr(FItemHeight)
              + ''',''' + IntToStr(FOpacity) + ''',''' + IIF(UseImage,'True','False') + ''',''' + ItemSP
              + ''',''' + IIF((FClientEvents.IndexOf(SubItem.Name) >= 0),'True','False') + ''',''' + IIF(SubItem.Enabled,'True','False')
              + ''',''' + IIF(SubItem.Checked, 'True', 'False') + ''',''' + IconColorTo + ''');'#13
          else
          begin
            AutoNumber := AutoNumber + 1;
            MenuCode := MenuCode
              + 'subMenuLabel(''' + Cap + ''', ' + IntToStr(AutoNumber) + ',''' + Name + ''','
              + IntToStr(Level) + ', ''' + TextAlignToStr(TextAlignment) + ''','''
              + CleanedID + '_' + Name + ''',''' + URL + ''',''' + IIF(FShowIcons, 'True', 'False') + ''','''
              + HTMLClr(FIconBackgroundColor) + ''',''' + IntToStr(FItemHeight) + ''','''
              + IntToStr(Opacity) + ''',''' + IIF(UseImage, 'True', 'False') + ''',''' + ItemSP
              + ''',''' + IIF(SubItem.Enabled, 'True', 'False') + ''',''' + IconColorTo + ''');'#13;

            ID[i-1] := AutoNumber;
            arMenuId.Add(IntToStr(AutoNumber));
            arMenuName.Add(Name);
          end;
        end;
      end;
    end;

    MenuCode := MenuCode
      + 'endMenu();'#13
      + 'changeObjectVisibility(''' + CleanedID + '_' + arMenuName[idx] + ''',''hidden'');'#13;

    for i := 1 to AItem.Count do
    begin
      SubItem := AItem.Items[i-1];

      if (SubItem.Visible) then
      begin
        if (SubItem.Count > 0) then
        begin
          Level := Level + 1;
          MakeMenu(IntToStr(ID[i-1]),SubItem);
        end;
      end;
    end;
    Level := Level - 1;
  end;
  Result := MenuCode;
end;

procedure TTIWMainMenu.CacheDir;
begin
  FCacheDir := GetCacheDir(Self);
end;

{$IFDEF TMSIW6}
function TTIWMainMenu.RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag;
{$ELSE}
function TTIWMainMenu.RenderHTML: TIWHTMLTag;
{$ENDIF}
var
  FImgName, GradientDir, StyleMenu, StyleChecked, BdrWidth : string;
  r, r2, g, g2, b, b2 : integer;
  NewRed, NewRed2, NewGreen, NewGreen2, NewBlue, NewBlue2 : integer;
  Hovercolor3, HoverColor4 : TIWColor;
  weight, CleanedID, Css, JavaScript, OpenMenu : string;
  ColorValue, ColorValue2, NewColor, NewColor2 : integer;
  IconColorTo, URL, Cap, JSSubMenu, TiersArray, checkNumberOfMenus : string;
  AItem : TMenuItem;
  i, k : integer;
  BMP : TBitmap;
  Parent, Scrpt, Tag : TIWHTMLTag;
  isPartial: Boolean;

begin
  CacheDir;

  {$IFDEF TMSIW6}
  with AContext.PageContext as TIWPageContext40 do
    isPartial := WebApplication.IsPartialUpdate;
  {$ELSE}
  isPartial := false;  
  {$ENDIF}

  {$IFDEF TMSIW6}
  if not isPartial then
  begin
    TIWComponent40Context(AContext).AddScriptFile('/js/TMSMENU.js');
    TIWComponent40Context(AContext).AddScriptFile('/js/TMSMENUSETTINGS.js');
    TIWComponent40Context(AContext).AddScriptFile('/js/TMSMENUUTIL.js');
  end;
  {$ELSE}
  AddScriptFile('/js/TMSMENU.js');
  AddScriptFile('/js/TMSMENUSETTINGS.js');
  AddScriptFile('/js/TMSMENUUTIL.js');
  {$ENDIF}

  {$IFDEF TMSIW6}
  if not isPartial then
  begin
    if not (AContext.WebApplication.Browser = brIE) then
      TIWComponent40Context(AContext).AddToInitProc('document.captureEvents(Event.MOUSEOVER | Event.MOUSEOUT | Event.CLICK);');
  end;
  {$ELSE}
  if not (WebApplication.Browser = brIE) then
    AddToInitProc('document.captureEvents(Event.MOUSEOVER | Event.MOUSEOUT | Event.CLICK);');
  {$ENDIF}

  CleanedID := HTMLName;
  BdrWidth := '-1';

  if not FSubMenuGlyph.Empty then
  begin
    if FSubMenuGlyph.IsGIF then
    {$IFDEF TMSIW71}
      FImgName := TIWServerControllerBase.NewCacheFile('gif',true)
    {$ELSE}
      FImgName := TIWServerControllerBase.NewCacheFile('gif')
    {$ENDIF}
    else
    {$IFDEF TMSIW71}
      FImgName := TIWServerControllerBase.NewCacheFile('jpg',true);
    {$ELSE}
      FImgName := TIWServerControllerBase.NewCacheFile('jpg');
    {$ENDIF}

    FSubMenuGlyph.SaveToFile(FImgName);
    FImgName := FCacheDir + ExtractFileName(FImgName);
  end
  else
    FImgName := '';

	Css := '';

	Css := Css
    + '<style type=text/css>'#13;

  {$IFDEF TMSIW6}
  if ((FRootItemColor <> clNone) and (RootItemColorTo <> clNone) and (TIWComponent40Context(AContext).WebApplication.Browser = brIE)) then
  {$ELSE}
  if ((FRootItemColor <> clNone) and (RootItemColorTo <> clNone) and (WebApplication.Browser = brIE)) then
  {$ENDIF}
  begin
    if (FRootItemGradientDirection = gdHorizontal) then
      GradientDir := '1'
    else
      GradientDir := '0';

    StyleMenu := 'filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=' + GradientDir + ', StartColorStr=' + HTMLClr(FRootItemColor) + ',EndColorStr=' + HTMLClr(FRootItemColorTo) + ');';
  end
  else
  begin
    if (FRootItemColor <> clNone) then
      StyleMenu := '  background:' + HTMLClr(FRootItemColor)
    else
      StyleMenu := '  background:' + HTMLClr(clBtnFace);
  end;

  Css := Css
 	  + '.' + CleanedID + 'root'#13
    + '{'#13
    + '  background: ' + HTMLClr(Color) + ';'#13
    + FontToCSS(FRootItemFont,true) + #13;

  {$IFDEF TMSIW6}
  if (TIWComponent40Context(AContext).WebApplication.Browser = brIE) then
  {$ELSE}
  if (WebApplication.Browser = brIE) then
  {$ENDIF}
    Css := Css
      + '  border: ' + IntToStr(FRootItemBorderWidth) + ' solid ' + HTMLClr(FRootItemBorderColor) + ';'#13
  else
    Css := Css
      + '  border: 1 solid ' + HTMLClr(FRootItemBorderColor) + ';'#13;

  Css := Css
    + '  padding: 1;'#13
    + '  padding-left: 7;'#13
    + '  padding-right: 7;'#13
    + '  margin:6;'#13
    + StyleMenu + ';' + #13;

  //Modified - no width
  (*
  if assigned(FMenu) then
  begin
    if (FMenu.Items.Count > 0) then
      Css := Css
        + '  width:' + IntToStr(Self.Width div FMenu.Items.Count) + ';';
  end;
  *)
  //end Modified

  Css := Css
		+ '}'#13;

  Css := Css
    + '.' + CleanedID + 'textItem'#13
    + '{'#13
    + '  ' + TextAlignToStr(FTextAlignment) + ';'#13
    + '  height: ' + IntToStr(FItemHeight) + ';'#13
    + '  ' + FontToCSS(Font,false) + ';'#13;

  Css := Css
    + '}'#13;

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

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -