function TabUnderCursorIndex: Integer;
var p: TPoint; r: TRect;
begin
 GetCursorPos(p);
 GetWindowRect(Tabs.Handle, r);
 Result := Tabs.TC_TabAtPos(p.X - r.Left, p.Y - r.Top);
end;

procedure BitmapCopyRect(OutBmp:HBITMAP; const OutRect: TRect; InBmp: HBITMAP;
 const InRect: TRect);
var InDC, OutDC: HDC;
   OldInDC, OldOutDC: THandle;
begin
 if (OutBmp = 0) or (InBmp = 0) or
    (OutBmp =InBmp) then Exit;
 InDC := CreateCompatibleDC( 0 );
 OldInDC := SelectObject( InDC, InBmp );
 OutDC := CreateCompatibleDC( 0 );
 OldOutDC := SelectObject( OutDC, OutBmp );
 StretchBlt( OutDC, OutRect.Left, OutRect.Top, OutRect.Right - OutRect.Left,
             OutRect.Bottom - OutRect.Top, InDC, InRect.Left, InRect.Top,
             InRect.Right - InRect.Left, InRect.Bottom - InRect.Top,
              SRCCOPY );
 SelectObject( OutDC, OldOutDC );
 DeleteDC( OutDC );
 SelectObject( InDC, OldInDC );
 DeleteDC( InDC );
end;

var  IL: pImageList;
procedure TForm1.KOLFormFormCreate(Sender: PObj);
var
Ob,InB:PBitmap;
begin
inb:=NewBitmap(0,0); //Рисунок из ресурса Высота 22 Ширина 216
Ob:=NewBitmap(144,16);  //Уменьшенный рисунок
InB.LoadFromResourceName(hinstance,'MAIN');
BitmapCopyRect(OB.Handle,MakeRect(0,0,Ob.Width,Ob.Height),
      InB.Handle,MakeRect(0,0,InB.Width,InB.Height));
IL := NewImageList( Form );
IL.Colors := ilcColorDDB;
IL.ImgWidth := 16;
IL.ImgHeight := 16;
IL.AddMasked(Ob.Handle,ClWhite);
InB.Free;
Ob.Free;

const
 mItemHeight=30;
 mItemWidth=100;

procedure DrawBitmap(DC: HDC;R:TRect;Bitmap:HBITMAP);
var
 DCfrom, DC0: HDC;
 oldBmp: HBitmap;
 B: TagBitmap;
begin
if Bitmap <> 0 then
 begin
   if GetObject( Bitmap, sizeof( B ), @B ) <> 0 then
   begin
   DC0 := GetDC( 0 );
   DCfrom := CreateCompatibleDC( DC0 );
   ReleaseDC( 0, DC0 );
   oldBmp := SelectObject( DCfrom, Bitmap );
   BitBlt( DC, R.Left+1,
           R.Top+(((R.Bottom- R.Top)-B.bmHeight) div 2),
           B.bmWidth, B.bmHeight,
           DCfrom, 0, 0, SRCCOPY );
   SelectObject( DCfrom, oldBmp );
   DeleteDC( DCfrom );
  end;
 end;
end;

function TForm1.MainMenu1DrawItem(Sender: PObj; DC: HDC; const Rect: TRect;
 ItemIdx: Integer; DrawAction: TDrawAction;
 ItemState: TDrawState): Boolean;
var
r:TRect;
begin
if (ItemIdx>=0) then begin
  R:=Rect;
  Inc(R.Left,40);
  FillRect(DC,Rect,GetSysColorBrush(COLOR_MENU));
  if PMenu(Sender).ItemEnabled[ItemIdx] then
  begin
  if odsSelected in  ItemState then
     FillRect(DC,Rect,GetSysColorBrush(COLOR_BTNFACE));
     SetTextColor(DC,ClBlack);
  end else begin
    SetTextColor(DC,ClGrey);
  end;
  SetBkMode(DC,TRANSPARENT);
  DrawBitmap(DC,Rect,PMenu(Sender).ItemBitmap[ItemIdx]);
  // или DrawIconEx(DC, Rect.Left,Rect.Top, LoadIcon(0,IDI_HAND),30,30, 0, 0, DI_NORMAL );
  DrawText(DC, Pchar(PMenu(Sender).ItemText[ItemIdx]),Length(PMenu(Sender).ItemText[ItemIdx]),
               R,DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
  end;
end;

function TForm1.KOLForm1Message(var Msg: tagMSG;
 var Rslt: Integer): Boolean;
var MIS: PMeasureItemStruct;
begin
 Result := FALSE;
 case Msg.message of
  WM_MEASUREITEM : begin
   MIS := Pointer(msg.lParam);
   with MIS^ do begin
    begin
       itemHeight := mItemHeight;
       ItemWidth:=mItemWidth;
       Result := True;
       end;
       end;
      end;
  end;
end;