Mega Code Archive
InLine Menu Control
<![CDATA[
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.
]]>