RnQ/for.RnQ/RQMenuItem.pas

{
  This file is part of R&Q.
  Under same license
}
unit RQMenuItem;
{$I ForRnQConfig.inc}

interface

uses
  Messages, Windows, Graphics, Classes, Types, Menus,
  RDGlobal, RQThemes;

{$I NoRTTI.inc}
{
  const
  CM_MENU_CLOSED = CM_BASE + 1001;
  CM_ENTER_MENU_LOOP = CM_BASE + 1002;
  CM_EXIT_MENU_LOOP = CM_BASE + 1003;
}

type
  TPopupListEx = class(TPopupList)
  protected
    procedure WndProc(var Message: TMessage); override;
  private
    // procedure PerformMessage(cm_msg : integer; msg : TMessage) ;
  end;

  TMenuCloseEvent = procedure(Sender: TObject) of object;

  TRnQPopupMenu = class(TPopupMenu)
  private
    FOnClose: TMenuCloseEvent;
    // procedure WMMENUSELECT(var msg: TWMMENUSELECT); message WM_MENUSELECT;
    procedure ExecuteOnClose;

  protected
    // procedure WndProc(var Message: TMessage) ; override;
    procedure DoPopup(Sender: TObject); override;

  public
    FIsOpenen: boolean;
    constructor Create(AOwner: TComponent); override;
  published
    property Alignment;
    property AutoHotkeys;
    property AutoLineReduction;
    property AutoPopup;
    property BiDiMode;
    property HelpContext;
    property Images;
    property MenuAnimation;
    property OwnerDraw;
    property ParentBiDiMode;
    property TrackButton;
    property OnChange;
    property OnClose: TMenuCloseEvent read FOnClose write FOnClose;
    property OnPopup;
  end;

  TRQMenuItem = class(TMenuItem)
  protected
    fImgElm: TRnQThemedElementDtls;
    FImageName: TPicName;
    // ThemeToken : Integer;
    // ImageLoc   : TPicLocation;
    // ImageIdx   : Integer;
//    procedure AdvancedDrawItem(ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState; TopLevel: boolean); override;
    // function drawMenuItemR(cnv:Tcanvas; Amenu:Tmenu; item:Tmenuitem;
    // r:Trect; onlysize:boolean=FALSE):Tpoint;
//    procedure MeasureItem(ACanvas: TCanvas; var Width, Height: Integer); override;
    procedure SetImageName(const Value: TPicName);
  public
    // FCaptionW: WideString;
    CanTranslate: boolean;
    PluginProc: Pointer;
    // ProtoLink  : Pointer;
    ProtoLink: TObject;
    // ProcIdx : Integer;
    // procedure OnPluginMenuClick(Sender: TObject);
{$IFDEF RNQ_SERVICES}
    ServiceName: String;
    procedure OnMenuClick(Sender: TObject);
{$ENDIF}
    constructor Create(AOwner: TComponent); override;
    procedure onExitMenu(var Msg: TMessage); message WM_EXITMENULOOP;
    property ImageName: TPicName read FImageName write SetImageName;
  end;
  // function drawMenuItemR(ACanvas : TCanvas; Amenu:Tmenu; item:Tmenuitem;
  // r:Trect; onlysize:boolean=FALSE;
  // drawbar : Boolean = True; Selected : Boolean = false):Tpoint;

//  function GPdrawmenuitemR7(ACanvas: TCanvas; item: TMenuItem; r: TRect; onlysize: boolean = False; Selected: boolean = FALSE): TPoint;

  procedure Register;

implementation

uses
  RnQGlobal, RQUtil, RnQStrings, SysUtils, Forms,
{$IFDEF RNQ_SERVICES}
  m_globaldefs,
  m_api,
{$ENDIF}
  RnQGraphics32,
{$IFDEF UNICODE}
  AnsiStrings,
{$ENDIF UNICODE}
  StrUtils, math, ActnList;

{
  procedure TPopupMenuX.PerformMessage(cm_msg: integer; msg : TMessage) ;
  begin
  if Screen.Activeform <> nil then
  Screen.ActiveForm.Perform(cm_msg, msg.WParam, msg.LParam) ;
  end;
}

procedure TRnQPopupMenu.DoPopup(Sender: TObject);
begin
  FIsOpenen := True;
  inherited DoPopup(Sender);
end;

constructor TRnQPopupMenu.Create(AOwner: TComponent);
begin
  FIsOpenen := FALSE;
  inherited Create(AOwner);
end;

procedure TRnQPopupMenu.ExecuteOnClose;
begin
  FIsOpenen := FALSE;
  if Assigned(FOnClose) then
    FOnClose(Self);
end;

procedure Register;
begin
  RegisterComponents('RnQ', [TRnQPopupMenu]);
end;

procedure TPopupListEx.WndProc(var Message: TMessage);
var
  nTi: Integer;
  // tt : HMENU;
begin
  case message.Msg of
    // WM_ENTERMENULOOP: PerformMessage(CM_ENTER_MENU_LOOP, Message) ;
    // WM_EXITMENULOOP : PerformMessage(CM_EXIT_MENU_LOOP, Message) ;
    WM_MENUSELECT:
      with TWMMenuSelect(Message) do
      begin
        if (Menu = 0) and (Menuflag = $FFFF) then
        begin
          for nTi := 0 to Count - 1 do
          begin
            if TObject(Items[nTi]) is TRnQPopupMenu then
            begin
              if TRnQPopupMenu(Items[nTi]).FIsOpenen then
                TRnQPopupMenu(Items[nTi]).ExecuteOnClose;
            end;
          end;
          // PerformMessage(CM_MENU_CLOSED, Message) ;
        end;
      end;
  end;
  inherited;
end;

constructor TRQMenuItem.Create(AOwner: TComponent);
begin
  inherited;
  fImgElm.Element := RQteMenu;
  fImgElm.picName := '';
  fImgElm.ThemeToken := -1;
  CanTranslate := True;
end;

//procedure TRQMenuItem.AdvancedDrawItem(ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState; TopLevel: boolean);
//begin
//  GPdrawmenuitemR7(ACanvas, Self, ARect, False, odSelected in State);
//end;

//procedure TRQMenuItem.MeasureItem(ACanvas: TCanvas; var Width, Height: Integer);
//var
//  p: TPoint;
//begin
//  p := GPdrawmenuitemR7(ACanvas, TMenuItem(Self), rect(0, 0, Width, Height), True);
//  Width := p.x;
//  Height := p.y;
//end;

//function GPdrawmenuitemR7(ACanvas: TCanvas; item: TMenuItem; r: TRect; onlysize: boolean = False; Selected: boolean = FALSE): TPoint;
//var
//  vpad, hpad, k: Integer;
//  picSize: TSize;
//  s: string;
//  r2: TRect;
//  dc: HDC;
//
//  procedure embossedCenteredLine(x1, x2: Integer);
//  var
//    y: Integer;
//    oldP, hp: HPEN;
//  begin
//    y := (r.Top + r.Bottom) div 2;
//    hp := CreatePen(PS_SOLID, 1, ColorToRGB(clBtnShadow));
//    oldP := SelectObject(dc, hp);
//    MoveToEx(dc, x1, y, NIL);
//    lineTo(dc, x2, y);
//    inc(y);
//    hp := CreatePen(PS_SOLID, 1, ColorToRGB(clBtnHighlight));
//    hp := SelectObject(dc, hp);
//    DeleteObject(hp);
//    MoveToEx(dc, x1, y, NIL);
//    lineTo(dc, x2, y);
//    hp := SelectObject(dc, oldP);
//    DeleteObject(hp);
//  end; // embossedCenteredLine
//
//var
//  res: TSize;
//  vImgElm: TRnQThemedElementDtls;
//  oldFont: HFONT;
//  ABitmap, HOldBmp: HBITMAP;
//  BI: TBitmapInfo;
//  MenuColor1, MenuColor2: Cardinal;
//  oldColor: Cardinal;
//  brF: HBRUSH;
//  oldMode: Integer;
//begin
//  r2 := r;
//  try
//    dc := CreateCompatibleDC(ACanvas.Handle);
//    HOldBmp := 0;
//    with r do
//      if (Width > 0) and (Height > 0) then
//      begin
//        BI.bmiHeader.biSize := SizeOf(TBitmapInfoHeader);
//        BI.bmiHeader.biWidth := Right - Left;
//        BI.bmiHeader.biHeight := Bottom - Top;
//        BI.bmiHeader.biPlanes := 1;
//        BI.bmiHeader.biBitCount := 32;
//        BI.bmiHeader.biCompression := BI_RGB;
//        ABitmap := CreateDIBitmap(ACanvas.Handle, BI.bmiHeader, 0, NIL, BI, DIB_RGB_COLORS);
//        if (ABitmap = 0) and (Right > Left) and (Bottom > Top) then
//        begin
//          DeleteDC(dc);
//          dc := 0;
//          raise EOutOfResources.Create('Out of Resources');
//        end;
//        HOldBmp := SelectObject(dc, ABitmap);
//        SetWindowOrgEx(dc, Left, Top, Nil);
//      end else
//        ABitmap := 0;
//  except end;
//
//  vImgElm.pEnabled := item.Enabled;
//  vImgElm.Element := RQteMenu;
//  vImgElm.ThemeToken := -1;
//  s := item.Caption;
//
//  if not TryStrToInt(theme.GetString('menu.vpadding'), vpad) then
//    vpad := 5;
//  if not TryStrToInt(theme.GetString('menu.hpadding'), hpad) then
//    hpad := 7;
//
//  try
//    // Clear
//    if (not onlysize) then
//{$IFDEF USE_SMILE_MENU}
//      if ((item.Tag > 4000) and (item.Tag < 4999)) then
//        FillRect(dc, r, GetSysColorBrush(COLOR_MENU))
//      else
//{$ENDIF USE_SMILE_MENU}
//        FillGradient(dc, r, theme.GetAColor('menu.fade1', clMenu), theme.GetAColor('menu.fade2', clMenu), gdHorizontal);
//
//    Result.x := hpad;
//    Result.y := vpad;
//    ACanvas.Font.Assign(Screen.menuFont);
//
//    if Selected then
//    begin
//      ACanvas.Font.Color := clMenuText;
//      theme.ApplyFont('menu.selected', ACanvas.Font);
//    end else
//      theme.ApplyFont('menu', ACanvas.Font);
//
//    if s = '-' then
//    begin
//      res.cy := 3;
//      Inc(Result.y, res.cy);
//      s := item.hint;
//      if s = '' then
//      begin
//        if not onlysize then
//          embossedCenteredLine(r.Left, r.Right);
//      end
//        else
//      begin
//        oldFont := SelectObject(dc, ACanvas.Font.Handle);
//        oldColor := SetTextColor(dc, ColorToRGB(ACanvas.Font.Color));
//        GetTextExtentPoint32(dc, PChar(s), Length(s), res);
//        Result.y := Max(Result.y, res.cy + vpad * 2);
//        if not onlysize then
//        begin
//          embossedCenteredLine(r.Left, (r.Right - res.cx - 10) div 2);
//          embossedCenteredLine((r.Right + res.cx + 10) div 2, r.Right);
//          oldMode := SetBKMode(dc, TRANSPARENT);
//          DrawText(dc, PChar(s), -1, r, DT_SINGLELINE or DT_VCENTER or DT_CENTER);
//          SetBKMode(dc, oldMode);
//        end;
//        SelectObject(dc, oldFont);
//      end;
//      Exit;
//    end;
//
//    if Selected and not onlysize then
//    begin
//      MenuColor1 := theme.GetColor('menu.selected', $CFCFCF);
//      if (MenuColor1 = 16750950) then
//        MenuColor1 := ColorToRGB($CFCFCF);
//
//      brF := CreateSolidBrush(MenuColor1);
//      FillRect(dc, r, brF);
//      DeleteObject(brF);
//    end;
//
//    if (Win32MajorVersion >= 6) and item.Checked and not onlysize and not Selected then
//    begin
//      MenuColor2 := ColorToRGB(theme.GetColor('menu.selected', $CFCFCF));
//      FillRect(dc, r, MenuColor2);
//    end;
//
//    vImgElm.picName := '';
//    picSize.cy := 0;
//    if not item.Bitmap.Empty then
//    begin
//      picSize.cx := item.Bitmap.Width;
//      picSize.cy := item.Bitmap.Height;
//      if not onlysize then
//      begin
//        k := (r.Top + r.Bottom - picSize.cy) div 2;
//        TransparentBlt(dc, Result.x, k, picSize.cx, picSize.cy, item.Bitmap.Canvas.Handle, 0, 0, picSize.cx, picSize.cy,
//          ColorToRGB(item.Bitmap.TransparentColor) and not AlphaMask);
//      end;
//      Inc(Result.x, picSize.cx + hpad + 1);
//      Inc(Result.y, picSize.cy);
//    end
//      else
//    begin
//      if Assigned(item.Action) then
//      begin
//        vImgElm.picName := TAction(item.Action).HelpKeyword;
//        if (item is TRQMenuItem) then
//        begin
//          if TRQMenuItem(item).fImgElm.picName <> vImgElm.picName then
//          begin
//            TRQMenuItem(item).fImgElm.picName := vImgElm.picName;
//            TRQMenuItem(item).fImgElm.ThemeToken := -1;
//          end;
//        end;
//      end else if (item is TRQMenuItem) then
//        vImgElm.picName := TRQMenuItem(item).fImgElm.picName;
//
//      if vImgElm.picName <> '' then
//      begin
//        vImgElm.ThemeToken := -1;
//        vImgElm.pEnabled := item.Enabled;
//        if (item is TRQMenuItem) then
//          TRQMenuItem(item).fImgElm.pEnabled := item.Enabled;
//        if (item is TRQMenuItem) then
//          picSize := theme.GetPicSize(TRQMenuItem(item).fImgElm)
//        else
//          picSize := theme.GetPicSize(vImgElm);
//        if not onlysize then
//        begin
//          k := (r.Top + r.Bottom + - picSize.cy) div 2;
//          if (item is TRQMenuItem) then
//            theme.drawPic(dc, Point(Result.x, k), TRQMenuItem(item).fImgElm)
//          else
//            theme.drawPic(dc, Point(Result.x, k), vImgElm);
//        end;
//        Inc(Result.x, picSize.cx + hpad + 1);
//        Inc(Result.y, picSize.cy);
//      end else
//        Inc(Result.x, 16 + hpad + 1);
//    end;
//
//    res.cx := 0;
//    res.cy := 0;
//
//{$IFDEF USE_SMILE_MENU}
//    if (item.Tag < 4000) or (item.Tag > 4999) or (ShowSmileCaption) then
//{$ENDIF USE_SMILE_MENU}
//    // <20><> <20><> <20><>, <20><> <20><>
//    begin
//      if not item.Enabled then
//        ACanvas.Font.Color := clGrayText;
//
//      oldFont := SelectObject(dc, ACanvas.Font.Handle);
//      oldColor := SetTextColor(dc, ColorToRGB(ACanvas.Font.Color));
//      GetTextExtentPoint32(dc, PChar(s), Length(s), res);
//
//      if not onlysize then
//      begin
//        r.Left := Result.x;
//        oldMode := SetBKMode(dc, TRANSPARENT);
//        DrawText(dc, PChar(s), -1, r, DT_SINGLELINE or DT_VCENTER);
//        SetBKMode(dc, oldMode);
//      end;
//      SelectObject(dc, oldFont);
//      Inc(Result.x, res.cx);
//    end;
//
//    if (Win32MajorVersion < 6) and item.Checked then
//    begin
//      vImgElm.ThemeToken := -1;
//      vImgElm.picName := PIC_CURRENT;
//      vImgElm.pEnabled := item.Enabled;
//      with theme.GetPicSize(vImgElm) do
//      begin
//        if not onlysize then
//          theme.drawPic(dc, Point(r.Right - cx - 5, r.Top + (r.Bottom - r.Top - cy) div 2), vImgElm);
//        Inc(Result.x, cx + 2);
//      end;
//    end;
//
//    Inc(Result.x, hpad);
//    Result.y := Max(Result.y, res.cy + vpad);
//    Inc(Result.Y, vpad);
//
//    if item.Count > 0 then
//      Inc(Result.x, vpad);
//  finally
//    if not onlysize then
//      BitBlt(ACanvas.Handle, r2.Left, r2.Top, r2.Right - r2.Left, r2.Bottom - r2.Top, dc, r2.Left, r2.Top, SrcCopy);
//
//    if not (HOldBmp = 0) then
//      SelectObject(dc, HOldBmp);
//    if not (ABitmap = 0) then
//      DeleteObject(ABitmap);
//    DeleteDC(dc);
//  end;
//end;

{$IFDEF RNQ_SERVICES}
procedure TRQMenuItem.OnMenuClick(Sender: TObject);
begin
  if ServiceName <> '' then
    CallService(PAnsiChar(ServiceName), 0, 0);
end;
{$ENDIF}

procedure TRQMenuItem.onExitMenu(var Msg: TMessage);
begin
end;

procedure TRQMenuItem.SetImageName(const Value: TPicName);
begin
  FImageName := Value;
  fImgElm.picName := LowerCase(Value);
  fImgElm.Element := RQteMenu;
  fImgElm.ThemeToken := -1;
  fImgElm.picIdx := -1;
end;

{
  initialization
  Popuplist.Free; //free the "default", "old" list
  PopupList:= TPopupListEx.Create; //create the new one
  // The new PopupList will be freed by
  // finalization section of Menus unit.
}

end.