{*********************************************************

 SlavaNap source code.

 Copyright 2001,2002 by SlavaNap development team
 Released under GNU General Public License

 Latest version is available at
 http://www.slavanap.org

**********************************************************

 Unit: SlavaMenu

 Functions for drawing popup menus

*********************************************************}
unit SlavaMenu;

interface

{$I Defines.pas}

uses
  Windows, SysUtils, Classes, Classes2, Forms, Graphics, Controls, Menus,
    STypes;

procedure SlavaDrawPopupItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
  Selected: Boolean);
procedure SlavaMeasurePopupItem(Sender: TObject; ACanvas: TCanvas; var Width,
  Height: Integer);
procedure SlavaDrawMainMenu(Form: TForm; Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);

implementation

procedure SlavaDrawPopupItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
  Selected: Boolean);
var
  I, J, K: Integer;
  R, R1: TRect;
  Str: string;
  C, C1, C2, C3, Bg, Txt: TColor;
begin
  C := $00FFB080;
  C1 := $00804040; // Selected rect
  C2 := $00FFA060; // Line
  C3 := $0040E0FF; // Line selected
  if (Sender as TMenuItem).Tag > 0 then
  begin
    C := $008098FF;
    C1 := $00404080; // Selected rect
    C2 := $006079FF; // Line
    C3 := $0026FF1C; // Line selected
  end;
  try
    Bg := GetSysColor(COLOR_MENU);
    Txt := GetSysColor(COLOR_MENUTEXT);
    if Selected then
      Txt := clBlack;
    with ACanvas do
    begin
      if (Sender as TMenuItem).default then
        Font.Style := Font.Style + [fsBold]
      else
        Font.Style := Font.Style - [fsBold];
      Brush.Color := Bg;
      if Selected then
        if (Sender as TMenuItem).Caption <> '--' then
          Brush.Color := C;
      Font.Color := Txt;
      if not (Sender as TMenuItem).Enabled then
        Font.Color := GetSysColor(COLOR_GRAYTEXT);
      if Selected then
        if (Sender as TMenuItem).Caption <> '--' then
          Font.Color := CountColor(clBlack, C, 5, 1);
      R := ARect;
      if (not Selected) or ((Sender as TMenuItem).Caption = '--') then
        Inc(R.Left, 18);
      FillRect(R);
      if (not Selected) or ((Sender as TMenuItem).Caption = '--') then
      begin
        Brush.Color := CountColor(Bg, C, 3, 1);
        R := ARect;
        R.Right := R.Left + 17;
        FillRect(R);
        Pen.Color := CountColor(Bg, C, 1, 3);
        MoveTo(R.Right, R.Top);
        LineTo(R.Right, R.Bottom + 1);
      end
      else
      begin
        Brush.Color := CountColor(Bg, C, 1, 3);
        R1 := ARect;
        R1.Right := R1.Left + 17;
        FillRect(R1);
        Pen.Color := CountColor(Bg, C, 1, 5);
        MoveTo(R1.Right, R1.Top);
        LineTo(R1.Right, R1.Bottom + 1);
      end;
      if (Sender as TMenuItem).Caption <> '--' then
      begin
        J := TextHeight('W');
        J := (ARect.Bottom + ARect.Top - J) div 2;
        Str := ShortCutToText((Sender as TMenuItem).ShortCut);
        I := TextWidth(Str);
        Brush.Style := bsClear;
        TextOut(ARect.Right - 18 - I, J, Str);
        Brush.Style := bsSolid;
        if (Sender as TMenuItem).Checked then
        begin
          Pen.Color := Font.Color;
          for K := 0 to 2 do
          begin
            MoveTo(ARect.Left + 5, ARect.Top + 7 + K);
            LineTo(ARect.Left + 7, ARect.Top + 9 + K);
            LineTo(ARect.Left + 12, ARect.Top + 4 + K);
          end;
        end;
        if (Sender as TMenuItem).RadioItem then
        begin
          Pen.Color := Font.Color;
          for K := 0 to 4 do
          begin
            MoveTo(ARect.Left + 7, ARect.Top + 6 + K);
            LineTo(ARect.Left + 10, ARect.Top + 6 + K);
          end;
          MoveTo(ARect.Left + 6, ARect.Top + 7);
          LineTo(ARect.Left + 6, ARect.Top + 10);
          MoveTo(ARect.Left + 10, ARect.Top + 7);
          LineTo(ARect.Left + 10, ARect.Top + 10);
        end;
        if Selected then
          with ACanvas do
          begin
            Pen.Color := C1;
            MoveTo(ARect.Left, ARect.Bottom - 1);
            LineTo(ARect.Left, ARect.Top);
            LineTo(ARect.Right - 1, ARect.Top);
            Pen.Color := C1;
            LineTo(ARect.Right - 1, ARect.Bottom - 1);
            LineTo(ARect.Left, ARect.Bottom - 1);
          end;
      end
      else
      begin
        I := C2;
        if Selected then
          I := C3;
        Pen.Color := CountColor(Bg, I, 5, 1);
        MoveTo(ARect.Left + 21, ARect.Top + 2);
        LineTo(ARect.Left + 23, ARect.Top + 2);
        Pen.Color := CountColor(Bg, I, 4, 2);
        LineTo(ARect.Left + 25, ARect.Top + 2);
        Pen.Color := CountColor(Bg, I, 3, 3);
        LineTo(ARect.Left + 27, ARect.Top + 2);
        Pen.Color := CountColor(Bg, I, 2, 4);
        LineTo(ARect.Left + 29, ARect.Top + 2);
        Pen.Color := CountColor(Bg, I, 1, 5);
        LineTo(ARect.Left + 31, ARect.Top + 2);
        Pen.Color := I;
        LineTo(ARect.Right, ARect.Top + 2);
      end;
    end;
    J := ACanvas.TextHeight('W');
    J := (ARect.Bottom + ARect.Top - J) div 2;
    if (Sender as TMenuItem).Caption <> '--' then
      with ACanvas do
        SlavaDrawText(ACanvas, (Sender as TMenuItem).Caption, Point(Arect.Left +
          22, J), Font.Color, CountColor(Font.Color, $00202020, 1, 1),
          CountColor(Font.Color, $00202020, 3, 2));
  except
  end;
end;

procedure SlavaMeasurePopupItem(Sender: TObject; ACanvas: TCanvas; var Width,
  Height: Integer);
begin
  try
    with ACanvas do
    begin
      if (Sender as TMenuItem).Caption <> '--' then
      begin
        if (Sender as TMenuItem).default then
          Font.Style := Font.Style + [fsBold]
        else
          Font.Style := Font.Style - [fsBold];
        Width := TextWidth(GetRealString((Sender as TMenuItem).Caption
          {+ ' Ctrl+F4'})) + 36;
        Height := 19;
      end
      else
      begin
        Width := 20;
        Height := 5;
      end;
    end;
  except
  end;
end;

procedure SlavaDrawMainMenu(Form: TForm; Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);
var
  I, J: Integer;
  R: TRect;
  P, P1: TPoint;
  C, C1: TColor;
begin
  C := GetSysColor(COLOR_MENU);
  try
    GetDCOrgEx(ACanvas.Handle, P);
    GetDCOrgEx(Form.Canvas.Handle, P1);
    J := Form.ClientWidth;
    I := P1.X - P.X + J;
    with ACanvas do
    begin
      if (Sender as TMenuItem).Tag = 1 then
      begin
        R := ARect;
        Brush.Color := C;
        R.Left := R.Right;
        R.Right := I;
        FillRect(R);
      end;
      if not Selected then
      begin
        Brush.Color := C;
        Font.Color := clWindowText;
      end
      else
      begin
        Brush.Color := $00FFB080;
        Font.Color := clBlack;
      end;
      R := ARect;
      FillRect(R);
      I := TextWidth(GetRealString((Sender as TMenuItem).Caption));
      J := TextHeight('W');
      I := (ARect.Right + ARect.Left - I) div 2;
      J := (ARect.Bottom + ARect.Top - J) div 2;
    end;
    if Selected then
      C1 := clBlack
    else
      C1 := GetSysColor(COLOR_MENUTEXT);
    SlavaDrawText(ACanvas, (Sender as TMenuItem).Caption, Point(I, J), C1, C1,
      C1);
    if Selected then
      with ACanvas do
      begin
        Pen.Color := $00804040;
        MoveTo(ARect.Left, ARect.Bottom - 1);
        LineTo(ARect.Left, ARect.Top);
        LineTo(ARect.Right - 1, ARect.Top);
        Pen.Color := $00804040;
        LineTo(ARect.Right - 1, ARect.Bottom - 1);
        LineTo(ARect.Left, ARect.Bottom - 1);
      end;
    with ACanvas do
    begin
      Pen.Color := C;
      MoveTo(R.Left - 1, R.Top - 1);
      LineTo(R.Right, R.Top - 1);
    end;
  except
  end;
end;

end.
