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

📄 iwtmsmenus.pas

📁 TMS IntraWEb增强控件TMSIntraWeb_v2.3.2.1_D2007.rar
💻 PAS
📖 第 1 页 / 共 5 页
字号:

  Css := Css
    + '.' + CleanedID + 'disabled'#13
    + '{'#13
    + '  color:buttonshadow;'#13
    + '  ' + TextAlignToStr(FTextAlignment) + ';'#13
    + '  font-family: ' + Font.FontName + ';'#13
    + '  font-size:' + IntToStr(Font.Size) + ';'#13
    + '  ' + Weight
    + '  valign: center;'#13
    + '}'#13;

  {$IFDEF TMSIW6}
  if ((TIWComponent40Context(AContext).WebApplication.Browser = brIE) and (FHoverColorTo <> clNone)) then
  {$ELSE}
  if ((WebApplication.Browser = brIE) and (FHoverColorTo <> clNone)) then
  {$ENDIF}
    StyleChecked := 'filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=1, StartColorStr=' + HTMLClr(FHoverColor) + ',EndColorStr=' + HTMLClr(FHoverColorTo) + ')'
  else
    StyleChecked := 'background:' + HTMLClr(FHoverColor);

  Css := Css
    + '.' + CleanedID + 'checked'#13
    + '{'#13
    + '  ' + StyleChecked + ';'#13
    + '  border:1 solid darkblue;'#13
    + '  font-family: webdings;'#13
    + '  width: 20;'#13
    + '  text-align: center;'#13
    + '  valign: center;'#13
    + '}'#13;

  Css := Css
    + '.' + CleanedID + 'more'#13
    + '{'#13
    + '  color:' + HTMLClr(Font.Color) + ';'#13
    + '}'#13;

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

	JavaScript := '';

  if Assigned (FMenu) then
  begin

  if (FMenu.Items.Count > 0) then
  begin
    JavaScript := '<SCRIPT>'#13;

    JavaScript := JavaScript
      + 'var ' + CleanedID + 'array = new Array();'#13
			+ CleanedID + 'array[0] = "' + HTMLClr(FHoverColor) + '";'#13;

//		if (FHoverColorTo = clNone) then
    {$IFDEF TMSIW6}
    if ((TIWComponent40Context(AContext).WebApplication.Browser <> brIE) or (FHoverColorTo = clNone)) then
    {$ELSE}
    if ((WebApplication.Browser <> brIE) or (FHoverColorTo = clNone)) then
    {$ENDIF}
		  JavaScript := JavaScript
        + CleanedID + 'array[1] = "null";'#13
  	else
			JavaScript := JavaScript
			  + CleanedID + 'array[1] = "' + HTMLClr(FHoverColorTo) + '"'#13;

		JavaScript := JavaScript
		  + CleanedID + 'array[2] = "' + HTMLClr(FItemColor) + '";'#13
      + CleanedID + 'array[3] = "' + HTMLClr(FRootItemColor) + '";'#13
  		+ CleanedID + 'array[4] = "' + HTMLClrEx(FRootItemColorTo) + '";'#13
			+ CleanedID + 'array[5] = "' + HTMLClr(FRootItemBorderColor) + '";'#13;

		OpenMenu := '1';

		if (FOpen = moClick) then
			OpenMenu := '0';

		JavaScript := JavaScript
		  + CleanedID + 'array[6] = "' + OpenMenu + '";'#13
      + CleanedID + 'array[7] = "' + HTMLClr(FIconBackgroundColor) + '";'#13;

  	if (FHoverColorTo <> clNone) then
    begin
			if (FHoverGradientDirection = gdVertical) then
      begin
			  JavaScript := JavaScript
				  + CleanedID + 'array[8] = "none";'#13
					+ CleanedID + 'array[9] = "none";'#13
					+ CleanedID + 'array[10] = "' + GradDirToStr(FHoverGradientDirection) + '";'#13;
      end
			else
      begin
        ColorValue := ColorToRGB(FHoverColor);
        r := (ColorValue AND $FF);
        g := (ColorValue AND $FF00) shr 8;
        b := (ColorValue AND $FF0000) shr 16;
        ColorValue2 := ColorToRGB(HoverColorTo);
        r2 := (ColorValue2 AND $FF);
        g2 := (ColorValue2 AND $FF00) shr 8;
        b2 := (ColorValue2 AND $FF0000) shr 16;

        NewRed := Round(r * 0.9 + r2 * 0.1);
        NewGreen := Round(g * 0.9 + g2 * 0.1);
        NewBlue := Round(b * 0.9 + b2 * 0.1);
        NewColor := NewRed + (NewGreen shl 8) + (NewBlue shl 16);

        NewRed2 := Round(r * 0.1 + r2 * 0.9);
        NewGreen2 := Round(g * 0.1 + g2 * 0.9);
        NewBlue2 := Round(b * 0.1 + b2 * 0.9);
        NewColor2 := NewRed2 + (NewGreen2 shl 8) + (NewBlue2 shl 16);

        HoverColor3 := StringToColor(IntToStr(NewColor));
        HoverColor4 := StringToColor(IntToStr(NewColor2));

				JavaScript := JavaScript
				  + CleanedID + 'array[8] = "' + HTMLClr(HoverColor3) + '";'#13
					+ CleanedID + 'array[9] = "' + HTMLClr(HoverColor4) + '";'#13
					+ CleanedID + 'array[10] = "' + GradDirToStr(FHoverGradientDirection) + '";'#13;
      end;
    end
		else
    begin
		  JavaScript := JavaScript
			  + CleanedID + 'array[8] = "none";'#13
				+ CleanedID + 'array[9] = "none";'#13
				+ CleanedID + 'array[10] = "none";'#13;
    end;

    if (FAutoHiding) then
      JavaScript := JavaScript
        + CleanedID + 'array[11] = "true";'#13
    else
      JavaScript := JavaScript
        + CleanedID + 'array[11] = "false";'#13;

    {$IFDEF TMSIW6}
    if ((TIWComponent40Context(AContext).WebApplication.Browser <> brIE) or not(FBackgroundImage.Empty) or not (FUseBorder) or (FHoverColorTo <> clNone)) then
    {$ELSE}
    if ((WebApplication.Browser <> brIE) or (FHoverColorTo <> clNone) or not(FBackgroundImage.Empty) or not (FUseBorder)) then
    {$ENDIF}
      BdrWidth := '0';

    JavaScript := JavaScript
      + CleanedID + 'array[12] = "' + HTMLClr(FHoverFontColor) + '";'#13
      + CleanedID + 'array[13] = "' + HTMLClr(Font.Color) + '";'#13
      + CleanedID + 'array[14] = "' + BdrWidth + '";'#13
      + CleanedID + 'array[15] = "' + HTMLClr(FHoverBorderColor) + '";'#13;

    {$IFDEF TMSIW6}
    if (TIWComponent40Context(AContext).WebApplication.Browser = brIE) then
    {$ELSE}
    if (WebApplication.Browser = brIE) then
    {$ENDIF}
      JavaScript := JavaScript
        + CleanedID + 'array[16] = "' + IntToStr(FRootItemBorderWidth) + '";'#13
    else
      JavaScript := JavaScript
        + CleanedID + 'array[16] = "1";'#13;

    JavaScript := JavaScript
      + CleanedID + 'array[17] = "' + HTMLClr(FRootItemHoverFontColor) + '";'#13
      + CleanedID + 'array[18] = "' + HTMLClr(FRootItemFont.Color) + '";'#13
      + CleanedID + 'array[19] = "' + IntToStr(FOpacity) + '";'#13;

    {$IFDEF TMSIW6}
    if (TIWComponent40Context(AContext).WebApplication.Browser = brIE) then
    {$ELSE}
    if (WebApplication.Browser = brIE) then
    {$ENDIF}
      JavaScript := JavaScript
        + CleanedID + 'array[20] = "' + FadeToStr(Fade) + '";'#13
    else
      JavaScript := JavaScript
        + CleanedID + 'array[20] = "0";'#13;

    JavaScript := JavaScript
      + CleanedID + 'array[21] = "' + IIF(FShowIcons,'True','False') + '";'#13
      + CleanedID + 'array[22] = "' + IntToStr(ItemSpacing) + '";'#13;

    if not (FBackgroundImage.Empty) then
      JavaScript := JavaScript
        + CleanedID + 'array[23] = "True";'#13
    else
      JavaScript := JavaScript
        + CleanedID + 'array[23] = "False";'#13;

    IconColorTo := '';

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

    JavaScript := JavaScript
      + CleanedID + 'array[24] = "' + IconColorTo + '";'#13;

    JavaScript := JavaScript
      + CleanedID + 'array[25] = "' + HTMLClrEx(FRootItemHoverColor) + '";'#13
      + CleanedID + 'array[26] = "' + HTMLClrEx(FRootItemHoverColorTo) + '";'#13
      + CleanedID + 'array[27] = "' + HTMLClrEx(FRootItemBorderHoverColor) + '";'#13;

    if (FRootItemDownColor = clNone) then
    begin
      JavaScript := JavaScript
        + CleanedID + 'array[28] = "' + HTMLClrEx(FRootItemHoverColor) + '";'#13
        + CleanedID + 'array[29] = "' + HTMLClrEx(FRootItemHoverColorTo) + '";'#13;
    end
    else
    begin
      JavaScript := JavaScript
        + CleanedID + 'array[28] = "' + HTMLClrEx(FRootItemDownColor) + '";'#13
        + CleanedID + 'array[29] = "' + HTMLClrEx(FRootItemDownColorTo) + '";'#13;
    end;

    JavaScript := JavaScript
      + CleanedID + 'array[30] = "' + IIF((FRootItemGradientDirection = gdHorizontal),'1','0') + '";'#13
      + CleanedID + 'array[31] = "True";'#13
	    + 'getBrowser();'#13
		  + 'setProperties(' + CleanedID + 'array,''' + CleanedID + ''');'#13
//      + 'startMenuBar(' + IntToStr(Width) + ',''' + CleanedID + 'arProp'',''' + CleanedID + 'array'',''' + FImgName + ''');'#13;
      + 'startMenuBar(''' + CleanedID + 'arProp'',''' + CleanedID + 'array'',''' + FImgName + ''');'#13;

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

      if (AItem.Visible) then
      begin
        arMenuId.Add(IntToStr(i));
        arMenuName.Add(IntToStr(i));
        URL := '';

        if (AItem.ImageIndex >= 0) and Assigned(FMenu.Images) and not (AItem.Checked) then
        begin
          if (FMenu.Images.Count > AItem.ImageIndex) then
          begin
            BMP := TBitmap.Create;
            FMenu.Images.BkColor := FIconBackgroundColor;
            FMenu.Images.GetBitmap(AItem.ImageIndex,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;

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

        if (AItem.Count = 0) then
        begin
          if (FClientEvents.IndexOf(AItem.Name) >= 0) then
          begin
            JavaScript := javascript
              + 'function ' + CleanedID + '_' + IntToStr(i) + '(el) {'#13
              + '  hideAllMenus();'#13
              + '  ' + FClientEvents.Items[FClientEvents.IndexOf(AItem.Name)].FItemScript + #13
              + '  ' + CleanedID + 'SubmitValue(''' + CleanedID + '_'  + IntToStr(i) + ''')'#13
              + '}'#13;
          end;

          JavaScript := JavaScript
            + 'menuLabelBlank(''' + Cap + ''',' + IntToStr(i) + ',' + IntToStr(Width div FMenu.Items.Count)
            + ',''' + TextAlignToStr(TextAlignment) + ''',''' + CleanedID + '_' + IntToStr(i) + ''',''' + IntToStr(Height)
            + ''',''' + CleanedID + 'array'',''' + IIF((FClientEvents.IndexOf(AItem.Name) >= 0),'True','False') + ''',''' + URL + ''');'#13;
        end
        else
        begin
          if (FClientEvents.IndexOf(AItem.Name) >= 0) then
          begin
            JavaScript := javascript
              + 'function ' + CleanedID + '_' + IntToStr(i) + '(el) {'#13
              + '  ' + FClientEvents.Items[FClientEvents.IndexOf(AItem.Name)].FItemScript + #13
              + '  showMenu(''' + IntToStr(i) + ''',event,''' + TextAlignToStr(TextAlignment) + ''',''' + CleanedID + '_' + IntToStr(i) + ''');'#13
              + '}'#13;
          end;

          JavaScript := JavaScript
            + 'menuLabel(''' + Cap + ''',' + IntToStr(i) + ',' + IntToStr(Width div FMenu.Items.Count)
            + ',''' + TextAlignToStr(TextAlignment) + ''',''' + CleanedID + '_' + IntToStr(i) + ''',''' + IntToStr(Height)
            + ''',''' + CleanedID + 'array'',''' + IIF((FClientEvents.IndexOf(AItem.Name) >= 0),'True','False') + ''',''' + URL + ''');'#13;
        end;
      end;
		end;

    JavaScript := JavaScript
      + 'endMenuBar();'#13
      + '</SCRIPT>'#13;

	  AutoNumber := FMenu.Items.Count;

	  JSSubMenu := '';

	  for i := 1 to FMenu.Items.Count do
    begin
		  Level := 0;
      MenuCode := '';
			AItem := FMenu.Items[i-1];
      if (AItem.Visible) then
      begin
  			JSSubMenu := JSSubMenu
			    + MakeMenu(IntToStr(i), AItem);
      end;
    end;

		JSSubMenu := JSSubMenu
		  + 'function ' + CleanedID + 'SubmitValue(name)'#13
			+ '{'#13
      + ' return SubmitClick('#39+HTMLName+#39+',name,' + #39 + 'false' + #39 + ');'#13
			+ '}'#13;

    TiersArray := '';

    TiersArray := TiersArray
		  + '<SCRIPT>'#13
      + '  var ' + CleanedID + 'arProp = new Array();'#13;

    for k := 0 to Tiers.Count - 1 do
    begin
      if (Tiers[k] = 'null') then
			  TiersArray := TiersArray
				  + CleanedID + 'arProp[' + IntToStr(k) + '] = null;'#13
			else
				TiersArray := TiersArray
					+ CleanedID + 'arProp[' + IntToStr(k) + '] = ' + Tiers[k] + ';'#13;
    end;

		TiersArray := TiersArray
		  + '</SCRIPT>'#13;
  end;
  end;

  Tag := TIWHTMLTag.CreateTag('DIV');
  Tag.AddStringParam('class',HTMLName + 'CSS');
  Tag.AddStringParam('NAME',HTMLName);
  Tag.AddStringParam('ID',HTMLName);
  Tag.AddStringParam('STYLE', 'background-color:' + HTMLClr(Color));
  Parent := TIWHTMLTag.CreateTag('');
  Tag.Contents.AddText(Css);

  if not isPartial then
  begin
    Tag.Contents.AddText(TiersArray);

    checkNumberOfMenus := '<SCRIPT>'#13
      + '  if (parseInt(' + IntToStr(Tiers.Count) + ') > parseInt(numMenus)) '#13
      + '    numMenus = ' + IntToStr(Tiers.Count) + ';'#13
      + '</SCRIPT>'#13;

    Tag.Contents.AddText(checkNumberOfMenus);
    Tag.Contents.AddText(JavaScript);
  end;


  if not (assigned(FMenu)) or (FMenu.Items.Count = 0) then
  begin
      Tag.AddStringParam('STYLE', 'width:' + IntToStr(Self.Width) + ';background:' + HtmlClr(RootItemColor));
      Tag.Contents.AddText('&nbsp;');
  end;

  Scrpt := nil;
  if not isPartial then
  begin
    Scrpt := TIWHTMLTag.CreateTag('SCRIPT');
    Scrpt.Contents.AddText(JSSubMenu);
  end;  

  {$IFDEF TMSIW6}
  Parent.Contents.Add(Tag);
  if not isPartial then
    Parent.Contents.Add(Scrpt);

⌨️ 快捷键说明

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