[Chaja]

Bueno como sigue esto , puse un popMenu en el form Principal y le puse " Generar Acc.Directo"
con este codigo

Código Delphi [-]

procedure TFMenu.CrearAccesoDirectoExecute(Sender: TObject);
var accIcono:TAccesoDirecto;
    path:String;
Puntero:TPoint;
begin
  CDSAccesos.Insert;
  Path:=ExtractFilePath(ParamStr(0));
  GetCursorPos(Puntero);

  accIcono         := TAccesoDirecto.Create(FMenu);
//  accIcono.Picture.LoadFromFile(Path+'kcmdf.gif');// := imgAccesoDirecto.Picture;
  accIcono.Picture.LoadFromFile(Path+'kcmdf.gif');
  accIcono.PosXPicture:=20;
  accIcono.PosYPicture:=0;
  accIcono.PosXText   :=1;
  accIcono.PosYText   :=0;
  accIcono.Text       :='Acceso Directo';
  accIcono.Left       := Puntero.X;
  accIcono.Top        := Puntero.Y;
  accIcono.Height     := 76;
  accIcono.width      := 70;
  accIcono.OnMouseDown:= AccesoDirecto1MouseDown;
  accIcono.OnMouseMove:= AccesoDirecto1MouseMove;
  accIcono.OnMouseUp  := AccesoDirecto1MouseUp;
  accIcono.PopupMenu  := mOpcionAccesoDirecto;
  accIcono.Parent     := FMenu;
  accIcono.Name       := 'Acc_'+CDSAccesosID.AsString;
  accIcono.Caption    := '';
  accIcono.Parent     := FMenu;
  accIcono.TextAlign  := taCenter;
  accIcono.Border     := False;
  accIcono.Visible    := True;


 // CDSAccesosIMAGEN.AsVariant:=accIcono.Picture;
  CDSAccesos.Post;
  CDSAccesos.ApplyUpdates(0);
//  lbAccesoDirecto          := TLabel.Create ( pnAccesoDirecto );
//  lbAccesoDirecto.Parent   := pnAccesoDirecto;
//  lbAccesoDirecto.Caption  :='Nuevo Acceso Directo';
end;

una cosa, genere una tabla en la base de datos con los parametros del icono que genero
asi:

Código SQL [-]

CREATE TABLE ACCESOS_DIRECTOS (
    ID          INTEGER NOT NULL,
    ID_USUARIO  FLOAT NOT NULL,
    POS_X       INTEGER,
    POS_Y       INTEGER,
    CAPTION     VARCHAR(100),
    ACCION      VARCHAR(100),
    IMAGEN      BLOB SUB_TYPE 2 SEGMENT SIZE 8192
);

para hacerme mas facil las cosas puse en el form y con visble fasle , un TAccesoDirecto, un ListtBox, y un Edit

en el Acceso Directo puse en el

Código Delphi [-]

procedure TFMenu.AccesoDirecto1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Seleccionado:=False;
  if (Button = mbLeft) then
    Seleccionado:=True;
  MouseDownSpot.X := X;
  MouseDownSpot.Y := Y;
  AccNombre  := TAccesoDirecto(Sender).Name;
end;

procedure TFMenu.AccesoDirecto1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 if Seleccionado then
    begin
      TAccesoDirecto(Sender).Left := TAccesoDirecto(Sender).Left - (MouseDownSpot.x - x);
      TAccesoDirecto(Sender).Top  := TAccesoDirecto(Sender).Top - (MouseDownSpot.y - y);
//      FindComponent('L'+TImage(Sender).Name)
//      Etiqueta.Top  := TImage(Sender).Top+TImage(Sender).Height;
//      Etiqueta.Left := TImage(Sender).Left-Trunc((Etiqueta.Width-TImage(Sender).Width) /2);

    end;

end;

procedure TFMenu.AccesoDirecto1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var Nombre:String;
begin
 if Seleccionado then
    begin
      ReleaseCapture;
      Seleccionado := false;
      TAccesoDirecto(Sender).Left := TAccesoDirecto(Sender).Left - (MouseDownSpot.x - x);
      TAccesoDirecto(Sender).Top  := TAccesoDirecto(Sender).Top - (MouseDownSpot.y - y);
      Nombre:=TAccesoDirecto(Sender).Name;
      CDSAccesos.Close;
      CDSAccesos.Params.ParamByName('id_usuario').Value:= DMMain_2.UsuarioActivoId;
      CDSAccesos.Params.ParamByName('id').Value        := StrToInt(Trim(copy(Nombre,5,10)));
      CDSAccesos.Open;
      CDSAccesos.Edit;
      CDSAccesosPOS_X.Value:= TAccesoDirecto(Sender).Left - (MouseDownSpot.x - x);
      CDSAccesosPOS_Y.Value:= TAccesoDirecto(Sender).Top - (MouseDownSpot.y - y);
      CDSAccesos.Post;
      CDSAccesos.ApplyUpdates(0);
    end;
end;

en el ListBox

Código Delphi [-]

procedure TFMenu.ListBoxDblClick(Sender: TObject);
var mi:TMenuItem;
acc:TAccesoDirecto;
c:TObject;
begin
  mi := TMenuItem(ListBox.Items.Objects[ListBox.ItemIndex]);
  if mi<>nil then
  begin
    CDSAccesos.Close;
    CDSAccesos.Params.ParamByName('id_usuario').Value:= DMMain_2.UsuarioActivoId;
    CDSAccesos.Params.ParamByName('id').Value        := StrToInt(Trim(copy(AccNombre,5,10)));
    CDSAccesos.Open;
    CDSAccesos.Edit;
    CDSAccesosACCION.Value:=mi.Name;
    CDSAccesos.ApplyUpdates(0);

    c:= FindComponent(AccNombre);
    acc:=(C as TAccesoDirecto);
    if acc<>nil then
    begin
    with acc do
      begin
       Caption    :='';
       Text       := mi.Caption;
       OnDblClick := mi.OnClick;
      end;
    end;
  end;
  Lista.Free;
 // Visible:=False;
  //Sender.Visible:=False;
end;

y en el Edit

Código Delphi [-]

procedure TFMenu.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if key=#13 then
    Edit1.OnExit(Sender);
end;

procedure TFMenu.Edit1Exit(Sender: TObject);
var c:TObject;
acc:TAccesoDirecto;
begin
  CDSAccesos.Close;
  CDSAccesos.Params.ParamByName('id_usuario').Value:= DMMain_2.UsuarioActivoId;
  CDSAccesos.Params.ParamByName('id').Value        := StrToInt(Trim(copy(AccNombre,5,10)));
  CDSAccesos.Open;
  CDSAccesos.Edit;
  CDSAccesosCAPTION.Value:=EditTemp.Text;
  CDSAccesos.ApplyUpdates(0);

  c:= FindComponent(AccNombre);
  acc:=(C as TAccesoDirecto);
  if acc<>nil then
  begin
  with acc do
    begin
     Caption    := '';
     Text       := EditTemp.Text;
    end;
  end;
  EditTemp.Free;

end;

despues puse otro popMenu asociado al acceso directo



donde los tems son asi:

Código Delphi [-]

procedure TFMenu.BorrarAccClick(Sender: TObject);
var Comp:TComponent;
begin
//  ShowMessage(AccNombre);
  CDSAccesos.Close;
  CDSAccesos.Params.ParamByName('id_usuario').Value:= DMMain_2.UsuarioActivoId;
  CDSAccesos.Params.ParamByName('id').Value        := StrToInt(Trim(copy(AccNombre,5,10)));
  CDSAccesos.Open;
  CDSAccesos.Delete;
  CDSAccesos.ApplyUpdates(0);
  Comp:=FindComponent(AccNombre);
  if (Comp<>nil) then

  FreeAndNil(Comp);
//  Comp.Free
//  Contro
//  TAccesoDirecto(Sender).Name
end;

procedure TFMenu.AsignarAccionClick(Sender: TObject);
var
  i:integer;
  str:string;
procedure GetItems(mi:TMenuItem);
  var
    i:Integer;
  begin
    for i := 0 to (mi.Count - 1) do
      begin
        if Mi.Items[i].Enabled then
          begin
            Str := mi.Items[i].Caption;
            Lista.Items.AddObject(Str, mi.Items[i]);
            // SubItems de este
            GetItems(mi.Items[i]);
          end;
    end;
  end;

begin
  Lista           := TListBox.Create(Self);
  Lista.Top       := 50;
  Lista.Left      := 50;
  Lista.Width     := 350;
  Lista.Height    := 600;
  Lista.Parent    := FMenu;
  Lista.OnDblClick:= ListBoxDblClick;
  Lista.Visible := True;
  for i := 0 to (MenuPrincipal.Items.Count - 1) do
    begin
      if MenuPrincipal.Items[i].Enabled then
        begin
          if (MenuPrincipal.Items[i].Action=Nil) then
            Lista.Font.Style:=[fsBold]
          else
            Lista.Font.Style:=[];


          Str := MenuPrincipal.Items[i].Caption;
          Lista.Items.AddObject(Str, MenuPrincipal.Items[i]);
         // SubItems de este
          GetItems(MenuPrincipal.Items[i]);
        end;
  end;
  ListBox:=Lista;
end;

procedure TFMenu.RenombrarClick(Sender: TObject);
var
comp:TObject;
Acc:TAccesoDirecto;
begin
  Comp:=FindComponent(AccNombre);
  if (Comp<>Nil) then
    begin
      Acc:=(Comp as TAccesoDirecto);
      EditTemp:=TEdit.Create(Acc);
      EditTemp.OnExit    := Edit1.OnExit;
      EditTemp.Top       := Acc.Top+Acc.Height;;
      EditTemp.Left      := Acc.left;
      EditTemp.AutoSize  := True;
      EditTemp.Visible   := True;
      EditTemp.Text      := acc.Caption;// '';
      EditTemp.Parent    := FMenu;
      EditTemp.OnKeyPress:= Edit1.OnKeyPress;
      EditTemp.BringToFront;
      EditTemp.SetFocus;
      //Nombre.SetFocus;
  end;

end;

tambien tengo declarado dos variables globales:

Código Delphi [-]

  public
    { Public declarations }
    MouseDownSpot:TPoint;
    Seleccionado:Boolean;
    AccNombre:String;
    DepositoEnUso:Integer;
    Lista:TListBox;
    EditTemp:TEdit;

lo que me falta hacer es que el user puedacambiar el icono, que aun no se como hacerlo, pero lo basico me anduvo. Veran que en la tabla tengo dos id , uno del usuario logeado, dado que manejo varios usuarios y cada uno tendira sus propios accesos, pero eso si Uds. no lo tiene no lo usen.
Y el tema de hacer los iconos con fondo transparente y el ajuste automatico. Prograne para que el usuario pueda acomodar los iconos donde quiere. Otra cosa que no se aun como solucionar, ya que recien acabo de hacer desùes de 4 dias todo esto, es que cuando se habre una ventana los icono quedan arriba



No se si me olvido de algo cualquier cosa comente..... gracias

Luis Roldan
Mar del Plata
Argentina