Creando un componte despleglable que sobresalga por encima del padre

[juank1971]

Hola :
Estoy haciendo un componente el de la "derecha" de la imagen y quisiera saber si alguien me puede decir como logra el componente TComboBox basico de la "Izquierda" de la imagen , esa característica que se ve de sobresalir por encima de el Padre.

https://i.postimg.cc/W3K7V9jD/Sin-t-tulo.png

Mi componente es algo parecido a un ComboBox con un panel desplegable debajo que contiene un Edit y un ListBox ,
hereda de TCustomControl pero quisiera poder mostrar al desplegar el panel si esta muy próximo a el final del padre
que sobresalga por encima del padre, como lo hace TComboBox Básico de toda la vida jj.

Alguien me puede dar una idea como hacerlo?

[duilioisola]

Mira como se utilizan los popUpMenu.
Ahora no tengo a mano Delphi como para darte un ejemplo, pero si no recuerdo mal, en el evento que desees (OnClick por ejemplo) le dices qué popUp quieres abrir y en qué posición.
El popUp se compone de MenuItems.
Algo así:


procedure OnClick();
var
p : TpopupMenu;
begin
[...]
p := MiPopUp;
RellenarMenuItemsDePopUp(p);
if Assigned(p) then
p.Popup(Mouse.CursorPos.X, Mouse.CursorPos.y);
[...]
end

[juank1971]

ok gracias

[Neftali [Germán.Estévez]]

Mi componente es algo parecido a un ComboBox con un panel desplegable debajo que contiene un Edit y un ListBox ,
hereda de TCustomControl pero quisiera poder mostrar al desplegar el panel si esta muy próximo a el final del padre
que sobresalga por encima del padre, como lo hace TComboBox Básico de toda la vida jj.



Yo creo que depende de cómo hayas creado el elemento que debe sobresalir. Al final es una nueva ventana (TWincontrol).
Revisa el Parent que le estás asignando.

El problema es que sin más información es difícil.

[juank1971]

saludos, este es el código del componente o al menos del inicio.

En resumen de lo que quiero es un componente muy parecido a un DBlookupComboBox, pero con diferencias en estilos y en accesos a datos.

Quise crear un componente heredando de TCustomControl, un TEdit sin bordes , con una línea debajo de este y una pequeña fecha a la derecha, cuando pasas el mouse por encima del componente se pone verde la línea y la flecha, cuando lo quitas se ponen gris.

Al dar click en el TEdit , este esta asociado a datos muy parecido al Lookup, pero con búsquedas diferentes y personalizadas,
entonces los muestro en una lista despleglable con un TForm (no encontré otra manera de mostrar para que sobresalga de un borde del padre)
y dentro un listbox, que va creando o mostrando según escribes letras en el TEdit en onChange. al escoger un elemento de este listbox se muestra en el Tedit. y se destruye el Tform

el problema que tengo es que, pensé que podía destruir el Tform al perder el foco con procedure WMKillFocus(var Message: TWMSetFocus); message WM_KILLFOCUS;
pero como dentro del componente creo un Tform y lo muestro debajo, ya perdí el foco de mi componente para mostrar estos resultados que quiero escoger en la lista de Tform.

No se si me explique bien pero lo que tengo es lo mismo que un DBlookupComboBox, que lo que se muestra debajo es un Tform con un listbox dentro, y no veo la manera de poder hacer el FreeAndNil(FForma); correctamente.





unit PanelSel;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, Graphics, StdCtrls, ExtCtrls,
forms, dialogs;

type
TPanelSel = class(TCustomControl)
private
FBorder: Boolean;
FBorderWidth: Integer;
FColor: TColor;
FBorderColor: TColor;
FOver: Boolean;
FEdit: Tedit;
FShape: TShape;
FFlecha: TImage;
FForma: TForm;
FListBox: TListBox;
FAbierto: boolean;
procedure SetBorder(Value: Boolean);
procedure SetBorderWidth(Value: integer);
procedure SetColor(Value: TColor);
procedure SetBorderColor(Value: TColor);
procedure MuestraPanel;
procedure CreaFondo;
procedure CreaComponentes;
procedure EditClick(Sender: TObject);
protected
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
procedure WMKillFocus(var Message: TWMSetFocus); message WM_KILLFOCUS;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure Paint; override;
procedure Click; override;
procedure ColorControl(col: boolean);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Border: Boolean read FBorder write SetBorder default True;
property BorderWidth: integer read FBorderWidth write SetBorderWidth default 1;
property Color: TColor read FColor write SetColor default clBtnFace;
property BorderColor: TColor read FBorderColor write SetBorderColor default clBlack;
property Tabstop;
{ Published declarations }
end;

procedure Register;

implementation
{$R IMCompRecursos.RES}

procedure Register;
begin
RegisterComponents('Samples', [TPanelSel]);
end;

constructor TPanelSel.Create(AOwner: TComponent);
var
rs: TResourceStream;
begin
inherited;
FOver := False;
Tabstop := True;
FBorder := True;
FBorderWidth := 1;
FColor := clBtnFace;
FBorderColor := clBlack;
//Flecha
FFlecha := TImage.create(self);
FFlecha.parent := self;
FFlecha.visible := true;
FFlecha.Align := alRight;
FFlecha.Width := 16;
FFlecha.OnClick := EditClick;
FFlecha.Transparent := true;
FFlecha.BringToFront;


//linea
FShape := TShape.create(self);
FShape.parent := self;
FShape.visible := true;
FShape.Align := alBottom;
FShape.Brush.Color := clSilver;
FShape.Pen.Color := clSilver; //clLime
FShape.Height := 1;
FShape.Shape := stRectangle;
//edit
FEdit := TEdit.create(nil);
with FEdit do
begin
Align := alClient;
BorderStyle := Tborderstyle(0);
color := FColor;
onClick := EditClick;
BringToFront;
end;
Height := 21;
Width := 121;
ColorControl(false);
OnClick := EditClick;
end;

procedure TPanelSel.WMSetFocus(var Message: TWMSetFocus);
begin
inherited;
Invalidate;
end;

procedure TPanelSel.WMKillFocus(var Message: TWMSetFocus);
begin
inherited;
//MuestraPanel;
Invalidate;
end;

procedure TPanelSel.CMMouseEnter(var Message: TMessage);
begin
inherited;
FOver := True;
ColorControl(true);
Invalidate;
end;

procedure TPanelSel.CMMouseLeave(var Message: TMessage);
begin
inherited;
FOver := False;
ColorControl(false);
Invalidate;
end;

procedure TPanelSel.SetBorder(Value: Boolean);
begin
if FBorder <> Value then
begin
FBorder := Value;
Invalidate;
end;
end;

procedure TPanelSel.SetBorderWidth(Value: integer);
begin
if FBorderWidth <> Value then
begin
if Value > 0 then
FBorderWidth := Value;
Invalidate;
end;
end;

procedure TPanelSel.SetColor(Value: TColor);
begin
if FColor <> Value then
begin
FColor := Value;
Invalidate;
end;
end;

procedure TPanelSel.SetBorderColor(Value: TColor);
begin
if FBorderColor <> Value then
begin
FBorderColor := Value;
Invalidate;
end;
end;

procedure TPanelSel.Click;
begin
inherited;
SetFocus;
end;

procedure TPanelSel.Paint;
var
X, Y, W, H: Integer;
begin
with Canvas do
begin
setbkmode(Handle, TRANSPARENT);
Pen.Width := BorderWidth;
Pen.Color := BorderColor;
Brush.Color := Color;
Brush.Style := bsSolid;
X := Pen.Width div 2;
Y := X;
W := Width - Pen.Width + 1;
H := Height - Pen.Width + 1;
FillRect(ClientRect);
Brush.Style := bsClear;
{ if focused then TextOut(0,0,'FOCUS');
if Border then Rectangle(X, Y, X + W, Y + H);
if FOver then TextOut(0,TextHeight('FOCUS')+2,'OVER'); }
end;
end;

procedure TPanelSel.ColorControl(col: boolean);
var
rs: TResourceStream;
begin
try
if col then
begin
rs := TResourceStream.Create(HInstance, 'Flecha', RT_RCDATA);
FShape.Brush.Color := clLime;
FShape.Pen.Color := clLime;
end
else
begin
rs := TResourceStream.Create(HInstance, 'FlechaGris', RT_RCDATA);
FShape.Brush.Color := clSilver;
FShape.Pen.Color := clSilver;
end;

FFlecha.Picture.Bitmap.LoadFromStream(rs);
finally
rs.free;
end;
end;

procedure TPanelSel.EditClick(Sender: TObject);
var
s: string;
begin
MuestraPanel;
end;

procedure TPanelSel.MuestraPanel;
begin
if assigned(FForma) then
begin
//FEdit.free;
// FListBox.Free;
FreeAndNil(FForma);
FAbierto := false;
end
else
begin
CreaFondo;
//CreaComponentes;
// CargaDatos;
FAbierto := true;
end;
end;

procedure TPanelSel.CreaFondo;
var
p: Tpoint;
begin
p.x := fedit.left;
p.y := fedit.top;
p := self.ClientToScreen(p);
FForma := TForm.create(nil);
with FForma do
begin
Visible := false;
BorderIcons := [];
BorderStyle := bsNone;
FormStyle := fsStayOnTop;
Color := clWhite;
left := p.x;
Width := self.Width + 5;
top := p.y + self.Height + 3;
show;
end;
end;

procedure TPanelSel.CreaComponentes;
begin

//ListBox
FListBox := TListBox.create(FForma);
with FListBox do
begin
parent := FForma;
Align := alClient;
Visible := true;
BorderStyle := bsNone;
// OnClick := ListBoxClick;
// OnDblClick := ListBoxClick;
Style := lbVirtualOwnerDraw;
Color := FColor;
// Font := FListBoxFont;
end;
end;



destructor TPanelSel.Destroy;
begin
try
// FLista.free;
// FMostrarCampos.free;
// FDataLink.Free;
// FDataLink := nil;
FreeAndNil(FForma);
finally
end;
inherited;
end;

end.

[juank1971]

ya con estos cambios logre que funcione como quiero, agregé el evento FormDeactivate en la FForma y al perder esta el foco se autodestruye

era eso lo que quería, se despliega la lista con el FForma y el listbox dentro, pero al perder el foco se destruye , por ejemplo si el usuario sin escoger ningún item del listbox da click en otro lugar del formulario, entonces este se detruye .

este es el código funcionando por si alguien quisiera usarlo


unit PanelSel;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, Graphics, StdCtrls, ExtCtrls,
forms, dialogs;

type
TPanelSel = class(TCustomControl)
private
FBorder: Boolean;
FBorderWidth: Integer;
FColor: TColor;
FBorderColor: TColor;
FOver: Boolean;
FEdit: Tedit;
FShape: TShape;
FFlecha: TImage;
FForma: TForm;
FListBox: TListBox;
FAbierto: boolean;
procedure SetBorder(Value: Boolean);
procedure SetBorderWidth(Value: integer);
procedure SetColor(Value: TColor);
procedure SetBorderColor(Value: TColor);
procedure MuestraPanel;
procedure CreaFondo;
procedure CreaComponentes;
procedure EditClick(Sender: TObject);
protected
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
procedure WMKillFocus(var Message: TWMSetFocus); message WM_KILLFOCUS;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure Paint; override;
procedure Click; override;
procedure ColorControl(col: boolean);
procedure FormDeactivate(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Border: Boolean read FBorder write SetBorder default True;
property BorderWidth: integer read FBorderWidth write SetBorderWidth default 1;
property Color: TColor read FColor write SetColor default clBtnFace;
property BorderColor: TColor read FBorderColor write SetBorderColor default clBlack;
property Tabstop;
{ Published declarations }
end;

procedure Register;

implementation
{$R IMCompRecursos.RES}

procedure Register;
begin
RegisterComponents('Samples', [TPanelSel]);
end;

constructor TPanelSel.Create(AOwner: TComponent);
var
rs: TResourceStream;
begin
inherited;
FOver := False;
Tabstop := True;
FBorder := True;
FBorderWidth := 1;
FColor := clBtnFace;
FBorderColor := clBlack;
//Flecha
FFlecha := TImage.create(self);
FFlecha.parent := self;
FFlecha.visible := true;
FFlecha.Align := alRight;
FFlecha.Width := 16;
FFlecha.OnClick := EditClick;
FFlecha.Transparent := true;
FFlecha.BringToFront;


//linea
FShape := TShape.create(self);
FShape.parent := self;
FShape.visible := true;
FShape.Align := alBottom;
FShape.Brush.Color := clSilver;
FShape.Pen.Color := clSilver; //clLime
FShape.Height := 1;
FShape.Shape := stRectangle;
//edit
FEdit := TEdit.create(nil);
with FEdit do
begin
Align := alClient;
BorderStyle := Tborderstyle(0);
color := FColor;
onClick := EditClick;
BringToFront;
end;
Height := 21;
Width := 121;
ColorControl(false);
OnClick := EditClick;
FAbierto := false;

end;

procedure TPanelSel.WMSetFocus(var Message: TWMSetFocus);
begin
inherited;
Invalidate;
end;

procedure TPanelSel.WMKillFocus(var Message: TWMSetFocus);
begin
inherited;
Invalidate;
end;

procedure TPanelSel.CMMouseEnter(var Message: TMessage);
begin
inherited;
FOver := True;
ColorControl(true);
Invalidate;
end;

procedure TPanelSel.CMMouseLeave(var Message: TMessage);
begin
inherited;
FOver := False;
ColorControl(false);
Invalidate;
end;

procedure TPanelSel.SetBorder(Value: Boolean);
begin
if FBorder <> Value then
begin
FBorder := Value;
Invalidate;
end;
end;

procedure TPanelSel.SetBorderWidth(Value: integer);
begin
if FBorderWidth <> Value then
begin
if Value > 0 then
FBorderWidth := Value;
Invalidate;
end;
end;

procedure TPanelSel.SetColor(Value: TColor);
begin
if FColor <> Value then
begin
FColor := Value;
Invalidate;
end;
end;

procedure TPanelSel.SetBorderColor(Value: TColor);
begin
if FBorderColor <> Value then
begin
FBorderColor := Value;
Invalidate;
end;
end;

procedure TPanelSel.Click;
begin
MuestraPanel;
end;

procedure TPanelSel.Paint;
var
X, Y, W, H: Integer;
begin
with Canvas do
begin
setbkmode(Handle, TRANSPARENT);
Pen.Width := BorderWidth;
Pen.Color := BorderColor;
Brush.Color := Color;
Brush.Style := bsSolid;
X := Pen.Width div 2;
Y := X;
W := Width - Pen.Width + 1;
H := Height - Pen.Width + 1;
FillRect(ClientRect);
Brush.Style := bsClear;
{ if focused then TextOut(0,0,'FOCUS');
if Border then Rectangle(X, Y, X + W, Y + H);
if FOver then TextOut(0,TextHeight('FOCUS')+2,'OVER'); }
end;
end;

procedure TPanelSel.ColorControl(col: boolean);
var
rs: TResourceStream;
begin
try
if col then
begin
rs := TResourceStream.Create(HInstance, 'Flecha', RT_RCDATA);
FShape.Brush.Color := clLime;
FShape.Pen.Color := clLime;
end
else
begin
rs := TResourceStream.Create(HInstance, 'FlechaGris', RT_RCDATA);
FShape.Brush.Color := clSilver;
FShape.Pen.Color := clSilver;
end;

FFlecha.Picture.Bitmap.LoadFromStream(rs);
finally
rs.free;
end;
end;

procedure TPanelSel.EditClick(Sender: TObject);
begin
MuestraPanel;
end;

procedure TPanelSel.MuestraPanel;
begin
if FAbierto then
begin
//FEdit.free;
// FListBox.Free;
FreeAndNil(FForma);
FAbierto := false;
end
else
begin
creafondo;
CreaComponentes;
// CargaDatos;
FAbierto := true;
end;
end;

procedure TPanelSel.CreaFondo;
var
p: Tpoint;
begin
if not (csDesigning in ComponentState) then
begin

p.x := fedit.left;
p.y := fedit.top;
p := self.ClientToScreen(p);

FForma := TForm.create(nil);
with FForma do
begin
OnDeactivate := FormDeactivate;
Visible := false;
BorderIcons := [];
BorderStyle := bsNone;
FormStyle := fsStayOnTop;
Color := clWhite;
left := p.x;
Width := self.Width + 5;
top := p.y + self.Height + 3;
show;
end;
end;
end;

procedure TPanelSel.CreaComponentes;
begin
//ListBox
FListBox := TListBox.create(FForma);
with FListBox do
begin
parent := FForma;
Align := alClient;
Visible := true;
BorderStyle := bsNone;
// OnClick := ListBoxClick;
// OnDblClick := ListBoxClick;
Style := lbVirtualOwnerDraw;
Color := FColor;
// Font := FListBoxFont;
end;
end;

destructor TPanelSel.Destroy;
begin
try
// FLista.free;
// FMostrarCampos.free;
// FDataLink.Free;
// FDataLink := nil;
FreeAndNil(FForma);
finally
end;
inherited;
end;

procedure TPanelSel.FormDeactivate(Sender: TObject);
begin
FreeAndNil(FForma);
end;

end.

[Neftali [Germán.Estévez]]

este es el código funcionando por si alguien quisiera usarlo


Gracias por el aporte.
^\||/