iwtmsmenus.pas

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

  {$ENDIF}
  {$IFNDEF TMSIW6}
  Parent.Contents.AddTagAsObject(Tag);
  Parent.Contents.AddTagAsObject(Scrpt);
  {$ENDIF}

  Result := Parent;
end;

procedure TTIWMainMenu.BackgroundChanged(Sender: TObject);
begin
  Invalidate;
end;

{$IFDEF TMSIW6}
procedure TTIWMainMenu.IWPaint;
{$ELSE}
procedure TTIWMainMenu.Paint;
{$ENDIF}
var
  i: Integer;
  txt: string;
  r: TRect;
  WidthItem, SubWidth, BeginLeft : integer;
begin
  r := GetClientRect;
  if Assigned(FMenu) then
  begin
    if (FMenu.Items.Count > 0) then
      WidthItem := Self.Width div FMenu.Items.Count
    else
      WidthItem := Self.Width;

    SubWidth := WidthItem;
    BeginLeft := 0;

    Canvas.Font.Name := FRootItemFont.FontName;
    Canvas.Font.Size := FRootItemFont.Size;
    Canvas.Font.Color := FRootItemFont.Color;
    Canvas.Font.Style := FRootItemFont.Style;

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

      with Canvas do
      begin
        r.Left := BeginLeft;
        r.Top := 0;
        r.Right := SubWidth;
        r.Bottom := FItemHeight;
        Pen.Color := RootItemBorderColor;
        Pen.Width := FRootItemBorderWidth;
        if (FRootItemColorTo <> clNone) then
        begin
          if (FRootItemGradientDirection = gdVertical) then
            DrawGradient(Canvas, FRootItemColor, FRootItemColorTo, 80, r, False)
          else
            DrawGradient(Canvas,FRootItemColor, FRootItemColorTo, 80, r, True);
          Brush.Style := bsClear;
          TextOut(r.Left + ((SubWidth - BeginLeft) div 2) - TextWidth(txt) div 2, (FItemHeight) div 2 - TextHeight(txt) div 2,txt);
        end
        else
        begin
          Brush.Color := FRootItemColor;
          TextRect(r,r.Left + ((SubWidth - BeginLeft) div 2) - TextWidth(txt) div 2, (FItemHeight) div 2 - TextHeight(txt) div 2, txt);
        end;
        Brush.Style := bsClear;
      end;
      BeginLeft := BeginLeft + WidthItem;
      SubWidth := SubWidth + WidthItem;
    end;

    if (FMenu.Items.Count = 0) then
    begin
      Canvas.Brush.Color := FRootItemColor;
      Canvas.Pen.Color := FRootItemBorderColor;
      Canvas.Pen.Width := FRootItemBorderWidth;
      Canvas.Rectangle(r.Left, r.Top, r.Left + Self.Width, r.Top + FItemHeight);
    end;
  end
  else
  begin
    Canvas.Brush.Color := FRootItemColor;
    Canvas.Pen.Color := FRootItemBorderColor;
    Canvas.Pen.Width := FRootItemBorderWidth;
    Canvas.Rectangle(r.Left, r.Top, r.Left + Self.Width, r.Top + FItemHeight);
  end;
end;

procedure TTIWMainMenu.DrawGradient(Canvas: TCanvas; FromColor, ToColor: TIWColor; Steps: Integer; r:TRect; Direction: Boolean);
var
  diffr,startr,endr: Integer;
  diffg,startg,endg: Integer;
  diffb,startb,endb: Integer;
  iend: Integer;
  rstepr,rstepg,rstepb,rstepw: Real;
  i,stepw: Word;

begin
  if Steps = 0 then
    Steps := 1;

  FromColor := ColorToRGB(FromColor);
  ToColor := ColorToRGB(ToColor);

  startr := (FromColor and $0000FF);
  startg := (FromColor and $00FF00) shr 8;
  startb := (FromColor and $FF0000) shr 16;
  endr := (ToColor and $0000FF);
  endg := (ToColor and $00FF00) shr 8;
  endb := (ToColor and $FF0000) shr 16;

  diffr := endr - startr;
  diffg := endg - startg;
  diffb := endb - startb;

  rstepr := diffr / steps;
  rstepg := diffg / steps;
  rstepb := diffb / steps;

  if Direction then
    rstepw := (R.Right - R.Left) / Steps
  else
    rstepw := (R.Bottom - R.Top) / Steps;

  with Canvas do
  begin
    for i := 0 to Steps - 1 do
    begin
      endr := startr + Round(rstepr*i);
      endg := startg + Round(rstepg*i);
      endb := startb + Round(rstepb*i);
      stepw := Round(i*rstepw);
      Pen.Color := endr + (endg shl 8) + (endb shl 16);
      Brush.Color := Pen.Color;
      if Direction then
      begin
        iend := R.Left + stepw + Trunc(rstepw) + 1;
        if iend > R.Right then
          iend := R.Right;
        Rectangle(R.Left + stepw,R.Top,iend,R.Bottom)
      end
      else
      begin
        iend := R.Top + stepw + Trunc(rstepw)+1;
        if iend > r.Bottom then
          iend := r.Bottom;
        Rectangle(R.Left, R.Top+stepw,R.Right,iend);
      end;
    end;
  end;
end;

procedure TTIWMainMenu.SetValue(const value:string);
begin
  // do nothing
end;

procedure TTIWMainMenu.Submit(const AValue: string);
var
  Decode, Sub: string;
  i,err: Integer;
  Menu: TMenuItem;
begin
  Decode := AValue;
  Delete(decode,1,length(HTMLName));

  if Assigned(FMenu) then
  begin
    Menu := nil;
    while length(decode) > 0 do
    begin
      sub := decode;
      if pos('_',sub) > 0 then
        Sub := copy(sub,1,pos('_',sub) - 1);
      val(sub,i,err);

      if (i > 0) then
      begin
        if Assigned(Menu) then
          Menu := Menu.Items[i - 1]
        else
          Menu := FMenu.Items[i - 1];
      end;

      delete(decode,1,length(sub) + 1);
    end;
    if Assigned(Menu) then
      if Assigned(Menu.OnClick) then
         Menu.OnClick(Menu);
  end;
end;

procedure TTIWMainMenu.SetAutoHiding(const Value : Boolean);
begin
  FAutoHiding := Value;
end;

procedure TTIWMainMenu.SetBackgroundImage(const Value: TIPicture);
begin
  FBackgroundImage.Assign(Value);
  Invalidate;
end;

{$IFNDEF TMSIW71}
procedure TTIWMainMenu.SetDesignMode(const Value: Boolean);
begin
  FDesignMode := Value;
  Invalidate;
end;
{$ENDIF}

procedure TTIWMainMenu.SetFade(const Value : TTIWFade);
begin
  FFade := Value;
end;

procedure TTIWMainMenu.SetHoverGradientDirection(const Value : TTIWGradientDirection);
begin
  FHoverGradientDirection := Value;
end;

procedure TTIWMainMenu.SetIconBackgroundColor(const Value : TIWColor);
begin
  FIconBackgroundColor := Value;
end;

procedure TTIWMainMenu.SetIconBackgroundColorTo(const Value : TIWColor);
begin
  FIconBackgroundColorTo := Value;
end;

procedure TTIWMainMenu.SetItemColor(const Value: TIWColor);
begin
  FItemColor := Value;
end;

procedure TTIWMainMenu.SetItemHeight(const Value : Integer);
begin
  FItemHeight := Value;
end;

procedure TTIWMainMenu.SetMenu(const Value: TMenu);
begin
  FMenu := Value;
  Invalidate;
end;

procedure TTIWMainMenu.SetOpacity(const Value : Integer);
begin
  if (Value < 0) or (Value > 100) then
    raise Exception.Create('Value required between 0 and 100')
  else
  FOpacity := Value;
end;

procedure TTIWMainMenu.SetRootItemBorderColor(const Value : TIWColor);
begin
  FRootItemBorderColor := Value;
end;

procedure TTIWMainMenu.SetRootItemBorderHoverColor(const Value : TIWColor);
begin
  FRootItemBorderHoverColor := Value;
end;

procedure TTIWMainMenu.SetRootItemBorderWidth(const Value : integer);
begin
  FRootItemBorderWidth := Value;
end;

procedure TTIWMainMenu.SetRootItemColor(const Value: TIWColor);
begin
  FRootItemColor := Value;
end;

procedure TTIWMainMenu.SetRootItemColorTo(const Value: TIWColor);
begin
  FRootItemColorTo := Value;
end;

procedure TTIWMainMenu.SetRootItemHoverColor(const Value : TIWColor);
begin
  FRootItemHoverColor := Value;
end;

procedure TTIWMainMenu.SetRootItemHoverColorTo(const Value : TIWColor);
begin
  FRootItemHoverColorTo := value;
end;

procedure TTIWMainMenu.SetRootItemDownColor(const Value : TIWColor);
begin
  FRootItemDownColor := Value;
end;

procedure TTIWMainMenu.SetRootItemHoverFontColor(const Value : TIWColor);
begin
  FRootItemHoverFontColor := Value;
end;

procedure TTIWMainMenu.SetRootItemDownColorTo(const Value : TIWColor);
begin
  FRootItemDownColorTo := Value;
end;

procedure TTIWMainMenu.SetRootItemFont(const Value: TIWFont);
begin
  FRootItemFont.Assign(Value);
end;

procedure TTIWMainMenu.SetRootItemGradientDirection(const Value : TTIWGradientDirection);
begin
  FRootItemGradientDirection := Value;
end;

procedure TTIWMainMenu.SetSeparatorColor(const Value : TIWColor);
begin
  FSeparatorColor := Value;
end;

procedure TTIWMainMenu.SetSubMenuGlyph(const value: TIPicture);
begin
  FSubMenuGlyph.Assign(Value);
end;

procedure TTIWMainMenu.SetTextAlignment(const Value : TAlignment);
begin
  FTextAlignment := Value;
end;

procedure TTIWMainMenu.SetUseBorder(const Value : Boolean);
begin
  FUseBorder := Value;
end;

{ TTIWSideMenu }
constructor TTIWSideMenu.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.Size := 11;
  Font.FontName := 'Verdana';
  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;
  FRootItemColor