InLine-Menu-Control


            Title: InLine Menu Control
Question: connect Panel with Popup menu,mix them up,and u got a the brands!
Answer:
Download complete project code:
http://web.vip.hr/inga.vip/tmb.zip
unit menubar_s;
interface
 uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs,subclass_x, ExtCtrls, Menus, StdCtrls;
 function HandleMessage(Sender: TCustomControl;var Msg: TExtMessage): cardinal;
 procedure DrawCustomBar(Sender: TCustomControl;const CP:TPaintStruct;PItem:TMenuItem);stdcall;
 procedure DrawBarItem (Sender:TCustomControl;vArea: TRect;hDc:cardinal;pText:pansichar;PM: TMenuItem;tX,tY,cState,SubItems:cardinal);
 procedure DrawCustomSubBar (Sender:TCustomControl;var vArea:TRect;hDc:cardinal;PM:TMenuItem;state:cardinal;const cText:string);
 procedure DrawCustomBarEx (Sender:TCustomControl;var vArea:TRect;hDc:cardinal;PM:TMenuItem); stdcall;
 function ItemFromPoint (Sender:TCustomControl;TM:TMenuItem;X,Y:cardinal):TMenuItem;
 function IsCoordInRect (X,Y:Cardinal;TR:TRect):longbool;
 function FindClickedItem (TM:TMenuItem):TMenuItem;stdcall;
 procedure FreeClickedItems (TM:TMenuItem);stdcall;
 
 procedure GetItemXY (TM:TMenuItem;Var X,Y:cardinal);
 procedure SetItemXY (TM:TMenuItem;X,Y:Cardinal);
 function GetItemState (TM:TMenuItem):longbool;
 procedure SetItemState(TM: TMenuItem;ClickState:longbool);
 procedure XorItemState (TM:TMenuItem);
 procedure InitStorage (TM:TMenuItem);
 procedure FreeStorage (TM:TMenuItem);
 procedure InitializeStorage(TM:TMenuItem);
 procedure FinalizeStorage (TM:TMenuItem);
 procedure SetIcon(AttachedControl: TCustomControl; TI: TIcon);
 procedure SetFont(AttachedControl:TCustomControl;TF:TFont);
implementation
function HandleMessage(Sender: TCustomControl;var Msg: TExtMessage): cardinal;
var
CP: TPaintStruct;
CPCOPY:TPaintStruct;
x,y:cardinal;
cx,cy:cardinal;
TM:TMenuItem; //,NM:
dc:Cardinal;
bmp:cardinal;
cst:longbool;
 TR:TRect;
TrackM: tagTRACKMOUSEEVENT;
begin
 if Msg.umsg =WM_PAINT then
 begin
 BeginPaint(Msg.hwnd,CP);
 dc:=CreateCompatibleDc(CP.hdc);
 bmp:=CreateCompatibleBitmap(cp.hdc,Sender.Width,Sender.Height);
 selectobject(dc,bmp);
 CPCOPY:=CP;
 CPCOPY.hdc:=dc;
 DrawCustomBar(Sender,CPCOPY,tPanel(Sender).PopupMenu.Items);
 BitBlt(CP.hdc,0,0,Sender.Width,Sender.Height,CPCOPY.hdc ,0,0,SRCCOPY);
 DeleteObject(bmp);
 DeleteDc(dc);
 EndPaint(Msg.hwnd,CP);
 exit;
 end
 else if (msg.umsg =WM_ERASEBKGND) or (msg.umsg=WM_CONTEXTMENU) then
 exit
 else if msg.umsg=WM_DESTROY then begin
 removeprop (msg.umsg,pansichar('Xpos'));
 removeprop (msg.umsg,pansichar('Ypos'));
 removeprop (msg.umsg,pansichar('ClickedIndex'));
 removeprop (msg.umsg,pansichar('Icon'));
 removeprop (msg.umsg,pansichar('Font'));
 removeprop (msg.umsg,pansichar('PanelX'));
 removeprop (msg.umsg,pansichar('PanelY'));
 end
 else if msg.umsg=WM_MOUSEMOVE then
 begin
 trackm.cbSize :=sizeof(trackm);
 trackm.dwFlags:=TME_LEAVE; //mouse leave
 trackm.hwndTrack:=msg.hwnd ;
 trackm.dwHoverTime:=1;
 TrackMouseEvent(TrackM);
 x:=msg.lparam; x:=x and $ffff;
 y:=msg.lparam; y:=y shr 16;
 SetProp(msg.hwnd,pansichar('Xpos'),x);
 SetProp(msg.hwnd,pansichar('Ypos'),y);
 result:=0;
 exit;
 end
 else if (msg.umsg=WM_LBUTTONDOWN) or (msg.umsg=WM_LBUTTONDBLCLK) then begin
 cx:=GetProp(msg.hwnd,pansichar('Xpos'));
 cy:= GetProp(msg.hwnd,pansichar('Ypos'));
 TM:= ItemFromPoint(Sender,TPanel(Sender).PopupMenu.Items,cx,cy);
 if (TMnil) and (TM.Enabled) then begin
 SetProp(Sender.Handle,pansichar('ClickedIndex'),cardinal(pointer(TM)));
 Sender.Invalidate;
 end;
 result:=0;exit; //VIDJETI
 end
 else if msg.umsg=WM_MOUSELEAVE then begin
 SetProp(Sender.Handle,pansichar('ClickedIndex'),0);
 Sender.Invalidate;
 result:=0;
 exit;
 end
 else if msg.umsg=WM_LBUTTONUP then begin
 cx:=GetProp(msg.hwnd,pansichar('PanelX'));
 cy:= GetProp(msg.hwnd,pansichar('PanelY'));
 TR.right:=cx shr 16;
 TR.Left:=cx and $ffff;
 TR.Top:=cy and $ffff;
 TR.Bottom:=cy shr 16;
 //Dali je caption click!
 if IsCoordInRect(GetProp(msg.hwnd,pansichar('Xpos')),GetProp(msg.hwnd,pansichar('Ypos')),TR) then
 if (assigned(TPanel(Sender).OnClick )) then TPanel(Sender).OnClick (Sender);
 TM:=pointer(GetProp(Sender.Handle,pansichar('ClickedIndex')));
 // NM:= ItemFromPoint(Sender,TPanel(Sender).PopupMenu.Items,GetProp(msg.hwnd,pansichar('Xpos')),GetProp(msg.hwnd,pansichar('Ypos')));
 //ako su isti tada je ok!
 if (TMnil) and (TM.Count0) then begin
 cst:=GetItemState(TM);
 //provjeri stanje!
 if cst then FreeClickedItems(TM);
 XorItemState(TM);
 end;
 SetProp(Sender.Handle,pansichar('ClickedIndex'),0);
 Sender.Invalidate;
 if assigned(TM) then
 if (assigned(TM.onClick)) then TM.OnClick(TM);
 result:=0;exit; //VIDJETI
 end;
 result:=subclass_x.CallOldProc(Sender,Msg);
end;
 procedure DrawCustomBar(Sender: TCustomControl;const CP:TPaintStruct;PItem:TMenuItem);
var
DRI:TRect;
IconH:cardinal;
fLeft:cardinal;
sz:Tsize;
txtS:cardinal;
begin
asm and dword ptr [fLeft],0 end;
windows.GetClientRect(Sender.Handle,DRI);
//Pozadina
FillRect(CP.hdc,DRI,TWinControl(Sender.Parent).Brush.Handle);
//Ikona
IconH:=GetProp(Sender.Handle,pansichar('Icon'));
SelectObject(cp.hdc,GetProp(Sender.Handle,pansichar('Font')));
SetBkMode(cp.hdc,TRANSPARENT);
asm
 and dword ptr [DRI.Left],0
 and dword ptr [DRI.Right],0
 and dword ptr [txts],0
end;
if IconH0 then begin
DrawIconEx(cp.hdc,4,(DRI.Bottom-16) div 2,IconH,16,16,0,0,DI_NORMAL);
inc (txts,23);
inc (DRI.Right,22);
end;
GetTextExtentPoint32(cp.hdc,pointer(tPanel(Sender).Caption),length(tPanel(Sender).Caption),sz);
DRI.right:=DRI.Right+sz.cx+8;
DrawEdge(cp.hdc,DRI,EDGE_ETCHED,BF_RECT);
TextOut(cp.hdc,txts,((DRI.Bottom-DRI.top)-sz.cy) div 2,pointer(tPanel(Sender).Caption),length(tPanel(Sender).Caption));
//Zabiljezi!
SetProp(Sender.Handle,pansichar('PanelX'),(DRI.Right shl 16) or (DRI.Left and $ffff));
SetProp(Sender.Handle,pansichar('PanelY'),(DRI.bottom shl 16) or (DRI.top and $ffff));
inc (DRI.Right,2);
DRI.Left:=DRI.Right ;
DrawCustomBarEx(Sender,DRI,cp.hdc,TPanel(Sender).PopupMenu.Items);
end;
procedure DrawCustomBarEx(Sender: TCustomControl;var vArea: TRect;
 hDc: cardinal;PM:TMenuItem);
var
cState:cardinal;
x:cardinal;
ccItm,cSr:TMenuItem; //koji je subitem kliknut!
cText:string;
begin
ccItm:=FindClickedItem(PM);
if ccItm=nil then begin
//nema poditema---
 cSR:=pointer(GetProp(Sender.Handle,pansichar('ClickedIndex')));
 for x:=0 to PM.Count-1 do begin
 if PM.Items[x].Count0 then
 cText:=''
 else
 cText:='';
 if PM.Items[x]=cSR then
 cState:=EDGE_SUNKEN
 else
 cState:=EDGE_RAISED;
 cText:=PM.Items[x].Caption + cText;
 DrawCustomSubBar (Sender,vArea,hdc,PM.Items[x],cState,cText);
 end;
end
else
 begin
 cSR:=pointer(GetProp(Sender.Handle,pansichar('ClickedIndex')));
 if ccItm=cSR then
 cState:=EDGE_SUNKEN
 else
 cState:=EDGE_RAISED;
 cText:='
 DrawCustomSubBar (Sender,vArea,hdc,ccItm,cState,cText);
 DrawCustomBarEx(Sender,vArea,hdc,ccItm);
 end;
end;
procedure DrawCustomSubBar(Sender: TCustomControl; var vArea: TRect;
 hDc: cardinal; PM: TMenuItem;state:cardinal;const cText:string);
 var
 sz:TSize;
begin
 GetTextExtentPoint32(hdc,pointer(cText),length(cText),sz);
 vArea.right:=vArea.right+sz.cx+8;
 SetItemXY (PM,(vArea.Right shl 16) or (vArea.Left and $ffff),(vArea.bottom shl 16) or (vArea.top and $ffff));
 DrawBarItem(Sender,vArea,hdc,pointer(cText),PM,sz.cx,sz.cy,state,0 );
 inc(vArea.Right);
 vArea.left:=vArea.right;
end;
procedure DrawBarItem(Sender: TCustomControl;vArea: TRect;
 hdc: cardinal; pText: pansichar;PM: TMenuItem;tX,tY,cState,SubItems:cardinal);
var
aEx:cardinal;
cT:cardinal;
begin
asm
and dword ptr [aEx],0
end;
DrawEdge(hdc,vArea,cState,BF_RECT);
if cState=EDGE_SUNKEN then aEx:=1;
ct:=(((vArea.Bottom-vArea.Top)-ty)div 2)+aEx;
if PM.Enabled then
 TextOut(hdc,vArea.Left+4,ct,pText,length(pText))
else
 drawstate(hdc,0,0,integer(pText),length(pText),vArea.Left+4,ct,0,0,DST_PREFIXTEXT Or DSS_DISABLED);
end;
function ItemFromPoint(Sender: TCustomControl;TM:TMenuItem; X,
 Y: cardinal): TMenuItem;
 var
 TR:TRect;
 c:cardinal;
 cX,cY:cardinal;
 cFnd:TMenuItem;
 
begin
result:=nil;
windows.GetClientRect(Sender.Handle,TR);
cFnd:=FindClickedItem(TM);
 if cFnd=nil then
 for c:=0 to TM.Count-1 do begin
 GetItemXY(TM.Items[c],cx,cy);
 TR.right:=cx shr 16;
 TR.Left:=cx and $ffff;
 TR.Top:=cy and $ffff;
 TR.Bottom:=cy shr 16;
 //TEST POS
 if IsCoordInRect(X,Y,TR) then begin result:=TM.Items[c];exit;end;
end
else
begin
 GetItemXY(cFnd,cx,cy);
 TR.right:=cx shr 16;
 TR.Left:=cx and $ffff;
 TR.Top:=cy and $ffff;
 TR.Bottom:=cy shr 16;
 if IsCoordInRect(X,Y,TR) then begin result:=cFnd;exit;end;
 result:=ItemFromPoint(Sender,cFnd,X,Y);
end;
end;
function IsCoordInRect(X, Y: Cardinal; TR: TRect): longbool;
begin
 result:=false;
 if ((x=TR.Left) and (X=TR.Top) and (yend;
procedure SetIcon(AttachedControl: TCustomControl; TI: TIcon);
begin
if assigned(TI) and (TI.Handle0) then
 SetProp(AttachedControl.Handle,pansichar('Icon'),TI.Handle);
end;
procedure SetFont(AttachedControl:TCustomControl;TF:TFont);
begin
SetProp(AttachedControl.Handle,pansichar('Font'),TF.Handle);
end;
procedure GetItemXY(TM: TMenuItem; var X, Y: cardinal);
var
p:pointer;
begin
p:=pointer(TM.tag);
X:=cardinal(P^);
Y:=cardinal(pointer(cardinal(p)+4)^);
end;
procedure SetItemXY(TM: TMenuItem; X, Y: Cardinal);
var
p:pointer;
begin
p:=pointer(TM.tag);
cardinal(P^):=X;
cardinal(pointer(cardinal(p)+4)^):=y;
end;
procedure FreeStorage(TM: TMenuItem);
begin
GlobalFree(TM.Tag);
end;
procedure InitStorage(TM: TMenuItem);
begin
tm.Tag:=GlobalAlloc(GMEM_FIXED or GMEM_ZEROINIT,$40);
end;
procedure FinalizeStorage(TM: TMenuItem);
var
x:cardinal;
begin
for x:=0 to TM.Count-1 do begin
 FreeStorage(TM.Items[x]);
 if tm.Items[x].Count0 then FinalizeStorage (tm.Items[x]);
end;
end;
procedure InitializeStorage(TM: TMenuItem);
var
x:cardinal;
begin
for x:=0 to TM.Count-1 do begin
 InitStorage(TM.Items[x]);
 if tm.Items[x].Count0 then InitializeStorage (tm.Items[x]);
end;
end;
function GetItemState(TM: TMenuItem): longbool;
var
p:pointer;
begin
p:=pointer(TM.tag);
result:=longbool(pointer(cardinal(p)+8)^)
end;
procedure SetItemState(TM: TMenuItem;ClickState:longbool);
var
p:pointer;
begin
p:=pointer(TM.tag);
longbool(pointer(cardinal(p)+8)^):=ClickState;
end;
procedure XorItemState(TM: TMenuItem);
var
p:pointer;
begin
p:=pointer(TM.tag);
asm
mov ecx,dword ptr [p]
xor dword ptr [ecx+8],$FFFFFFFF
end;
end;
function FindClickedItem(TM: TMenuItem):TMenuItem;
var
x:cardinal;
begin
result:=nil;
for x:=0 to tm.Count-1 do begin
if getitemstate(TM.Items[x]) then begin result:=TM.Items[x];exit ;end;
end;
end;
procedure FreeClickedItems(TM: TMenuItem);
var
xM:TMenuITem;
begin
xM:=FindClickedItem(TM);
if xMnil then begin XorItemState(xM);FreeClickedItems(xM); end;
end;
end.
Examples Delphi
