[分享]菜单自绘去除边框

方法比较麻烦，不是很可取，大家有更好的方法可以一起讨论 ，从系统COPY一个MEMO单元出来，屏蔽了TPOPULIST.WNDPROC里的WM_DRAWITEM, WM_MEASUREITEM消息处理,使用的使TMainMenu，TPopupMenu 的Image属性不为空，随便加个IAMGELIST
var
  CBrgColor: TColor         = $6D8F38;
  CSelectColor: TColor       = $7eb237;
  CTextColor: TColor         = clWhite;
  CSelectTextColor: TColor   = clHighlight;
  MenuOldWndProc: Pointer;function GetMenuItem(ID: Integer): TMenuItem;
var
  I: Integer;
begin
  for I := 0 to PopupList.Count - 1 do
  begin
    Result := TPopupMenu(PopupList.Items[I]).FindItem(ID, fkCommand);
    if Result <> nil then
      Exit;
  end;
end;procedure MenuMeasureItem(P: PMeasureItemStruct);
var
  Item: TMenuItem;
  R: TRect;
  Text: string;
  DC: HDC;
  SaveIndex: Integer;
begin
  Item := GetMenuItem(P^.itemID);
  if Item.Caption = cLineCaption then
  begin
    P^.itemHeight := 5;
    P^.itemWidth := 5;
  end;  Inc(p^.itemHeight, 3);  if Item.ShortCut <> 0 then
    Text := Concat(Item.Caption, ShortCutToText(Item.ShortCut))
  else
    Text := Item.Caption;  DC := GetWindowDC(PopupList.Window);
  try
    SaveIndex := SaveDC(DC);
    try
      SelectObject(DC, Screen.MenuFont.Handle);
      ZeroMemory(@R, SizeOf(TRect));
      DrawText(DC, PChar(Text), -1, R, DT_EXPANDTABS or DT_SINGLELINE or DT_NOCLIP or DT_CALCRECT);
      Inc(P^.itemWidth, R.Right - R.Left + 20);
      if Item.ShortCut <> 0 then
        Inc(P^.itemWidth, 10);
    finally
      RestoreDC(DC, SaveIndex);
    end;
  finally
    ReleaseDC(PopupList.Window, DC);
  end;
end;procedure MenuItemDraw(P: PDrawItemStruct);
  procedure DrawPolyline(const DC: HDC; const Points: array of TPoint);
  type
    PPoints = ^TPoints;
    TPoints = array[0..0] of TPoint;
  begin
    Windows.Polyline(DC, PPoints(@Points)^, High(Points) + 1);
  end;
var
  SaveIndex: Integer;
  Item: TMenuItem;
  R: TRect;
  T: Integer;
begin
  with P^ do
  begin
    SaveIndex := SaveDC(hDC);
    try
      R := rcItem;
      SelectObject(hDC, Screen.MenuFont.Handle);
      if ODS_SELECTED and itemState = ODS_SELECTED then
      begin
        SetDCBrushColor(hDC, CSelectColor);
        SetTextColor(hDC, CSelectTextColor);
      end
      else
      begin
        SetDCBrushColor(hDC, CBrgColor);
        SetTextColor(hDC, ColorToRGB(clMenuText));
      end;
      FillRect(hDC, R, GetStockObject(DC_BRUSH));
      Item := GetMenuItem(P^.itemID);
      if Item.Caption = cLineCaption then
      begin
        SelectObject(hDC, GetStockObject(DC_PEN));
        SetDCPenColor(hDC, $8F8F8F);
        T := R.Top + (R.Bottom - R.Top) shr 1;
        DrawPolyline(hDC, [Point(1, T), Point(R.Right - 1, T)]);
        SetDCPenColor(hDC, $CFCFCF);
        DrawPolyline(hDC, [Point(1, T + 1), Point(R.Right - 1, T + 1)]);
      end
      else
      begin
        SetBkMode(hDC, TRANSPARENT);
        if ODS_CHECKED and itemState = ODS_CHECKED then
          with TBitmap.Create do
          try
            Handle := LoadBitmap(0, PChar(OBM_CHECK));
            TransparentBlt(hDC, R.Left + (16 - Width) shr 1 + 1, R.Top + (R.Bottom - R.Top - Height) shr 1,
              Width, Height, Canvas.Handle, 0, 0, Width, Height, $FFFFFF);
          finally
            Free;
          end;
        R.Left := R.Left + 20;
        Inc(R.Top);
        SetTextColor(HDC, CTextColor);
        DrawText(hDC, PChar(Item.Caption), -1, R, DT_VCENTER or DT_SINGLELINE);
        if Item.ShortCut <> 0 then
        begin
          R.Right := R.Right - 4;
          DrawText(hDC, PChar(ShortCutToText(Item.ShortCut)), -1, R, DT_RIGHT or DT_VCENTER or DT_SINGLELINE);
        end;
      end;
    finally
      RestoreDC(hDC, SaveIndex);
    end;
  end;
end;function MenuWndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  R: TRect;
  Pen: HPEN;
  SaveIndex: Integer;
  DC: HDC;
begin
  case Msg of
    WM_PRINT:
      begin
        Result := CallWindowProc(MenuOldWndProc, hWnd, WM_PRINT, wParam, lParam);
//        if lParam and PRF_NONCLIENT = PRF_NONCLIENT then
//        begin
//          if GetDCBrushColor(wParam) <> CBrgColor then Exit;
          Pen := CreatePen(PS_SOLID, 4, CBrgColor);
          try
            SaveIndex := SaveDC(wParam);
            try
              SelectObject(wParam, GetStockObject(NULL_BRUSH));
              SelectObject(wParam, Pen);
              GetWindowRect(hWnd, R);
              OffsetRect(R, -R.Left, -R.Top);
              Rectangle(wParam, 1, 1, R.Right, R.Bottom);
            finally
              RestoreDC(wParam, SaveIndex);
            end;
          finally
            DeleteObject(Pen);
          end;
//        end;
      end;
    //WM_PAINT: ;
    WM_NCPAINT:
      begin
        CallWindowProc(MenuOldWndProc, hWnd, Msg, wParam, lParam);
//        DC := GetDCEx(hwnd, wParam, DCX_WINDOW or DCX_INTERSECTRGN);
        DC := GetWindowDC(hWnd);
        try
          Pen := CreatePen(PS_SOLID, 4, CBrgColor);
          try
            SelectObject(DC, GetStockObject(NULL_BRUSH));
            SelectObject(DC, Pen);
            GetWindowRect(hWnd, R);
            OffsetRect(R, -R.Left, -R.Top);
            Rectangle(DC, 1, 1, R.Right, R.Bottom);
          finally
            DeleteObject(Pen);
          end;
        finally
          ReleaseDC(hWnd, DC);
        end;      end;
    else
      Result := CallWindowProc(MenuOldWndProc, hWnd, Msg, wParam, lParam);
  end;
end;function WindowsHook(Code: Integer; wParam: Integer; lParam: Integer): LRESULT; stdcall;
var
  pStruct: PCWPStruct;
  ClassName: array[0..63] of Char;
  lastWndProc: Pointer;
begin
  pStruct := PCWPStruct(lParam);
  if (Code = HC_ACTION) and ((pStruct^.message <> WM_CREATE) or (pStruct^.message <> $01E2)) and
     (GetClassName(pStruct^.hwnd, @ClassName[0], SizeOf(ClassName)) = 6) and
     (StrPas(@ClassName[0]) = '#32768') then
  begin
    lastWndProc := Pointer(GetWindowLong(pStruct^.hwnd, GWL_WNDPROC));
    if lastWndProc <> @MenuWndProc then
    begin
      SetWindowLong(pStruct^.hwnd, GWL_WNDPROC, Integer(@MenuWndProc));
      MenuOldWndProc := lastWndProc;
        
    end;
  end;
  Result := CallNextHookEx(WH_CALLWNDPROC, Code, wParam, lParam);
end;initialization
SetWindowsHookEx(WH_CALLWNDPROC, WindowsHook, hInstance, GetCurrentThreadId);