Add(MainForm,2953706,42,182)
{
 Width=815
 Height=655
 Caption="test 1"
 WindowsState=2
 Point(Close)
}
Add(MTStrTbl,5800875,112,182)
{
 Left=60
 Top=120
 Width=365
 Height=240
 Font=[MS Sans Serif,12,0,0,1]
 Name="Table1"
 Layout="ver_Table"
 HeightScale=100
 Columns=#7:1=54==2|7:2=50==2|5:3=400|5:4=100|5:5=120|5:6=120|7:7=90==2|3:8=0|
 Grid=0
 MultiSelect=0
 Point(onMouseDown)
 Point(doVisible)
 link(onMouseDown,10963487:doEvent,[])
}
Add(IndexToChanel,10963487,154,210)
{
 link(onEvent2,3533485:doEvent1,[])
}
Add(ArrayRW,6195194,280,210)
{
 link(Array,7054046:Array,[])
}
Add(DoData,10226319,238,224)
{
 Data=String(Добавить)
 link(onEventData,6195194:doAdd,[])
 AddHint(-25,51,75,13,Data)
}
Add(Hub,3533485,196,217)
{
 OutCount=3
 link(onEvent1,7054046:doClear,[(225,223)(225,174)])
 link(onEvent2,10226319:doData,[])
 link(onEvent3,7054046:doPopupHere,[(218,237)(218,167)])
}
Add(PopupMenuEx,7054046,273,161)
{
 Font=[MS Sans Serif,12,0,0,1]
 Bitmaps=[]
 Point(Array)
 link(MenuItemIdx,2300527:doShow,[])
}
Add(ChildFormEx,2300527,392,161)
{
}
BEGIN_SDK
  Add(EditMultiEx,6167279,21,21)
  {
   WorkCount=#6:doShow|
   Width=503
   Height=557
   link(doShow,3451375:doShowModal,[(119,27)(119,90)])
  }
  Add(MainForm,3451375,217,56)
  {
   Left=35
   Top=105
   Width=981
   Height=727
   Visible=1
   Caption="test 2"
   Position=1
   Point(doShowModal)
  }
  Add(Button,14999685,266,504)
  {
   Left=250
   Top=540
   Width=110
   Height=35
   Font=[MS Sans Serif,12,0,0,1]
   TabOrder=9
   Layout="gor_buttons"
   Caption="Отмена"
   link(onClick,6311228:In,[(298,510)])
  }
  Add(HBoxLayout,16029822,308,427)
  {
   Name="gor_buttons"
   Space=30
   Padding=10
   Layout="ver"
  }
  Add(LayoutSpacer,11853030,350,427)
  {
   Left=530
   Top=540
   Layout="gor_buttons"
   WidthScale=50
  }
  Add(LayoutSpacer,8885556,266,427)
  {
   Left=130
   Top=540
   Layout="gor_buttons"
   WidthScale=50
  }
  Add(VBoxLayout,13052431,308,378)
  {
   Name="ver"
  }
  Add(MTStrTbl,4197214,217,182)
  {
   Left=190
   Top=65
   Width=455
   Height=140
   Font=[MS Sans Serif,12,0,0,1]
   Name="Table2"
   Layout="ver"
   Columns=#7:1=54==2|7:2=50==2|5:3=400|5:4=100|5:5=120|5:6=120|7:7=90==2|3:8=0|
   Grid=0
   Point(onMouseDown)
  }
  Add(LineBreak,11625429,168,77)
  {
   Caption="close"
   link(Out,3451375:doClose,[])
   Primary=[6311228,196,427]
  }
END_SDK

Add(MainForm,13529263,238,287)
{
 Width=815
 Height=655
 Caption="test 1"
 WindowsState=2
}
Add(ChildFormEx,2300527,329,287)
{
}
BEGIN_SDK
  Add(EditMultiEx,6167279,21,21)
  {
   WorkCount=#6:doShow|
   Width=503
   Height=557
   link(doShow,3451375:doShowModal,[(158,27)(158,97)(207,97)(207,90)])
  }
  Add(MainForm,3451375,217,56)
  {
   Left=35
   Top=105
   Width=981
   Height=727
   Visible=1
   Caption="test 2"
   Position=1
   Point(doShowModal)
  }
  Add(Button,14999685,266,504)
  {
   Left=250
   Top=540
   Width=110
   Height=35
   Font=[MS Sans Serif,12,0,0,1]
   TabOrder=9
   Layout="gor_buttons"
   Caption="Отмена"
   link(onClick,6311228:In,[(298,510)])
  }
  Add(HBoxLayout,16029822,308,427)
  {
   Name="gor_buttons"
   Space=30
   Padding=10
   Layout="ver"
  }
  Add(LayoutSpacer,11853030,350,427)
  {
   Left=530
   Top=540
   Layout="gor_buttons"
   WidthScale=50
  }
  Add(LayoutSpacer,8885556,266,427)
  {
   Left=130
   Top=540
   Layout="gor_buttons"
   WidthScale=50
  }
  Add(VBoxLayout,13052431,308,378)
  {
   Name="ver"
  }
  Add(MTStrTbl,4197214,217,182)
  {
   Left=190
   Top=65
   Width=455
   Height=140
   Font=[MS Sans Serif,12,0,0,1]
   Name="Table2"
   Layout="ver"
   Columns=#7:1=54==2|7:2=50==2|5:3=400|5:4=100|5:5=120|5:6=120|7:7=90==2|3:8=0|
   Grid=0
   Point(onMouseDown)
  }
  Add(LineBreak,11823247,168,77)
  {
   Caption="close"
   link(Out,3451375:doClose,[])
   Primary=[6311228,196,427]
  }
END_SDK
Add(MenuEx,9249265,280,287)
{
 Menu=#1:1|1:2|1:3|
 Bitmaps=[]
 link(MenuItemIdx,2300527:doShow,[])
}

unit hiPopupMenu;

interface

uses Windows,Kol,Share,Messages,Debug;

const
  US_APP               = WM_APP + 1000;
  US_DEFERREDEVENT     = US_APP + 51;

type
  THIPopupMenu = class(TDebug)
   private
    PM:PMenu;
    FC:PControl;
    Old:TOnMessage;
    FMenuList: string;
    ListMenuStr: array  of string;
    _Arr: PArray;    

    procedure SetMenu(const Value:string);
    procedure AddMenuItem(const Caption:string);
//    function  _OnDraw( Sender: PObj; DC: HDC; const Rect: TRect; ItemIdx: Integer;
//                           DrawAction: TDrawAction; ItemState: TDrawState ): Boolean;
    function _OnMes( var Msg: TMsg; var Rslt: Integer ): Boolean;
    procedure RefBMP;
    procedure RefBMPall;    

    procedure Init;
   public
    _prop_TranspIcon:boolean;
    _event_onClick:THI_Event;
    _event_onSelectStr:THI_Event;
    _event_onEndPopup:THI_Event;
    _data_Bitmaps:THI_Event;

    property _prop_Menu: string write SetMenu;

    constructor Create(Control:PControl);
    destructor Destroy; override;
    procedure _work_doPopup(var _Data:TData; Index:word);
    procedure _work_doPopupHere(var _Data:TData; Index:word);
    procedure _work_doAddItem(var _Data:TData; Index:word);
    procedure _work_doClear(var _Data:TData; Index:word);
    procedure _var_Handle(var _Data:TData; Index:word);

    procedure _Add(var Val:TData);
    procedure _Set(var Item: TData; var Val: TData);
    function _Get(Var Item: TData; var Val: TData): boolean;
    function _Count:integer;

    procedure _var_Array            (var _Data:TData; Index:word);
    
  end;

implementation

constructor THIPopupMenu.Create;
begin
   inherited Create;
   FC := Control;
   old := FC.OnMessage;
//   PM := NewMenu(nil,0,[],nil);
end;

{$ifdef F_P}
var ListMenu: array[0..200] of PChar;
{$endif}

procedure THIPopupMenu.Init;
type TPCharArray = array[0..0] of PChar;
//     PPCharArray = ^TPCharArray;
var i:integer;
    List:PStrList;
   {$ifndef F_P}
   ListMenu: array of PChar;
   {$endif}
    //k:PPCharArray;
begin
   List := NewStrList;
   List.text := FMenuList;
   if List.Count > 0 then
    begin
     SetLength(ListMenuStr,List.Count);
     {$ifndef F_P}
     SetLength(ListMenu,List.Count);
     {$endif}
     //getmem(k,4*10);
     for i := 0 to List.Count-1 do
      begin
       ListMenuStr[i] := List.Items[i];
       ListMenu[i] := PChar(@ListMenuStr[i][1]);
       //k[i] := PChar(ListMenuStr[i]);
      end;
    end;
   if Assigned(PM) then PM.free;
   PM := NewMenu( nil, 0, ListMenu, nil );
   List.free;   
end;


(*
procedure THIPopupMenu.Init;
var   List:PStrList;
      i:integer;
begin
   List := NewStrList;
   List.text := _prop_Menu;
   for i := 0 to List.Count-1 do
      AddmenuItem(List.Items[i]);
   List.Free;
end;
*)

destructor THIPopupMenu.Destroy;
begin
   FC.OnMessage := old;
   PM.Free;
   inherited;
end;

function THIPopupMenu._OnMes;
var   m:PMenu;
begin
   case Msg.message of
      WM_COMMAND: begin
           m := PM.Items[Msg.WParam];
           if m <> nil then begin
              _hi_OnEvent(_event_onSelectStr,PM.Items[PM.IndexOf(m)].Caption);
              _hi_OnEvent(_event_onClick,PM.IndexOf(m));
         end;  
         end;
      US_DEFERREDEVENT: begin
           TrackPopupMenu(PM.Handle,0,Msg.WParam,Msg.LParam,0,FC.Handle,nil);
           _hi_OnEvent(_event_onEndPopup);
         end;
      end;
   Result := Old(Msg,Rslt);
end;

procedure THIPopupMenu.AddMenuItem;
begin
   if Caption = '-' then
      PM.AddItem('-',nil,[moSeparator])
   else
      PM.AddItem(PChar(Caption),nil,[]);
   Refbmp;
end;

procedure THIPopupMenu.RefBMP;
var   dt,Ind:TData;
      bmp:PBitmap;
      arr:PArray;
      i,j:integer;
      c:TColor;
begin
   Arr := ReadArray(_data_Bitmaps);
   if Arr = nil then exit;
   Ind := _DoData(PM.Count-1);
   Arr._Get(Ind,dt);
   bmp := PBitmap(dt.idata);
   if (_IsBitmap(dt)) and (bmp <> nil) and not bmp.Empty then begin
//      BmpTransparent(bmp);
      if _prop_TranspIcon then begin
         c := Bmp.Pixels[0,0];
         for i := 0 to Bmp.Width-1 do
            for j := 0 to Bmp.Height-1 do
               if Bmp.Pixels[i,j] = c then
//                  Bmp.Pixels[i,j] := clMenu;
                 Bmp.Pixels[i,j] := clNone;
      end;
      PM.Items[PM.Count-1].BitmapItem := CopyImage(bmp.Handle,IMAGE_BITMAP,0,0,LR_CREATEDIBSECTION);
   end;
end;

procedure THIPopupMenu.RefBMPall;
var   dt,Ind:TData;
      bmp:PBitmap;
      arr:PArray;
      i,j,k:integer;
      c:TColor;
begin
   Arr := ReadArray(_data_Bitmaps);
   if Arr = nil then exit;

   for k := 0 to min(Arr._Count - 1, PM.Count - 1) do
   begin 
     Ind := _DoData(k);
     Arr._Get(Ind,dt);
     bmp := PBitmap(dt.idata);
     if (_IsBitmap(dt)) and (bmp <> nil) and not bmp.Empty then
     begin
       if _prop_TranspIcon then
       begin
         c := Bmp.Pixels[0,0];
         for i := 0 to Bmp.Width-1 do
           for j := 0 to Bmp.Height-1 do
             if Bmp.Pixels[i,j] = c then
//               Bmp.Pixels[i,j] := clMenu;
               Bmp.Pixels[i,j] := clNone;
       end;
       PM.Items[k].BitmapItem := CopyImage(bmp.Handle,IMAGE_BITMAP,0,0,LR_CREATEDIBSECTION);
   end;
   end;
end;

procedure THIPopupMenu.SetMenu;
begin
  FMenuList := Value;
  Init;  
  FC.OnMessage := _OnMes;
end;

(*
function THIPopupMenu._OnDraw;
var bmp:PBitmap;
begin   // debug('ok');
   bmp := NewBitmap(0,0);
   bmp.Handle := Pm.ItemBitmap[ItemIdx];
   bmp.Draw(dc,1,Rect.Top);
   //with PM.Items[PM.Count-1]^ do
   // TextOut(dc,Rect.Left + 18,Rect.Top,PChar(Caption),Length(Caption));
   bmp.Handle := 0;
   bmp.Free;
   Result := true;
end;
*)

procedure THIPopupMenu._work_doPopup;
var   pos:cardinal;
begin
   pos := Cardinal(ToInteger(_data));
   RefBMPall;
   PostMessage(FC.Handle, US_DEFERREDEVENT, pos and $ffff, pos shr 16);
//   TrackPopupMenu(PM.Handle,0,pos and $ffff,pos shr 16,0,FC.Handle,nil);
//   _hi_OnEvent(_event_onEndPopup);
end;

procedure THIPopupMenu._work_doAddItem;
begin
   AddMenuItem(ToString(_Data));
end;

procedure THIPopupMenu._work_doClear;
begin
   if Assigned(PM) then PM.Free;
   PM := NewMenu(nil,200,[],nil);
end;

procedure THIPopupMenu._work_doPopupHere;
var   pos:TPoint;
begin
   GetCursorPos(pos);
   SetForegroundWindow( FC.Handle );
   RefBMPall;
   with pos do
   PostMessage(FC.Handle, US_DEFERREDEVENT, x, y);
//      TrackPopupMenu(PM.Handle,0,x,y,0,FC.Handle,nil);
//   _hi_OnEvent(_event_onEndPopup);
end;

procedure THIPopupMenu._var_Handle;
begin
   dtInteger(_Data,PM.ItemHandle[0]);
end;

procedure THIPopupMenu._Set;
var
  ind:integer;
begin
  ind := ToInteger(Item);
  if (ind < 0) and (ind > PM.Count - 1) then exit;
  PM.ItemText[ind] := ToString(Val);
end;

function THIPopupMenu._Get;
var
  ind: integer;
begin
  ind := ToInteger(Item);
  if (ind >= 0 ) and (ind < PM.Count) then
  begin
    dtString(Val, PM.ItemText[ind]);
    Result := true;
  end
  else
    Result := false;
end;

function THIPopupMenu._Count:integer;
begin
   Result := PM.Count;
end;

procedure THIPopupMenu._Add;
var
  sdt: string;
begin
  sdt := ToString(Val);

  if sdt = '-' then
    PM.AddItem('-',nil,[moSeparator])
  else
    PM.AddItem(PChar(sdt),nil,[]);
  Refbmp;
end;

procedure THIPopupMenu._var_Array;
begin
  if _Arr = nil then
    _Arr := CreateArray(_Set,_Get,_Count,_Add);
  dtArray(_Data, _Arr);
end;

end.