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');
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;
CDSAccesos.Post;
CDSAccesos.ApplyUpdates(0);
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);
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;
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
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);
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]);
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]);
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;
end;
end;
tambien tengo declarado dos variables globales:
Código Delphi
[-]
public
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