Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Coloboración Paypal con ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 14-06-2023
juank1971 juank1971 is offline
Miembro
 
Registrado: feb 2008
Posts: 230
Poder: 17
juank1971 Va por buen camino
Creando un componte despleglable que sobresalga por encima del padre

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.



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?

Última edición por juank1971 fecha: 14-06-2023 a las 17:25:12.
Responder Con Cita
  #2  
Antiguo 14-06-2023
Avatar de duilioisola
[duilioisola] duilioisola is offline
Miembro Premium
 
Registrado: ago 2007
Ubicación: Barcelona, España
Posts: 1.757
Poder: 21
duilioisola Es un diamante en brutoduilioisola Es un diamante en brutoduilioisola Es un diamante en bruto
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í:

Código Delphi [-]
procedure OnClick();
var
  p : TpopupMenu;
begin
  [...]
  p := MiPopUp;
  RellenarMenuItemsDePopUp(p);
  if Assigned(p) then
     p.Popup(Mouse.CursorPos.X, Mouse.CursorPos.y);
  [...]
end
Responder Con Cita
  #3  
Antiguo 14-06-2023
juank1971 juank1971 is offline
Miembro
 
Registrado: feb 2008
Posts: 230
Poder: 17
juank1971 Va por buen camino
ok gracias
Responder Con Cita
  #4  
Antiguo 15-06-2023
Avatar de Neftali [Germán.Estévez]
Neftali [Germán.Estévez] Neftali [Germán.Estévez] is offline
[becario]
 
Registrado: jul 2004
Ubicación: Barcelona - España
Posts: 18.549
Poder: 10
Neftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en bruto
Cita:
Empezado por juank1971 Ver Mensaje
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.
__________________
Germán Estévez => Web/Blog
Guía de estilo, Guía alternativa
Utiliza TAG's en tus mensajes.
Contactar con el Clubdelphi

P.D: Más tiempo dedicado a la pregunta=Mejores respuestas.
Responder Con Cita
  #5  
Antiguo 25-06-2023
juank1971 juank1971 is offline
Miembro
 
Registrado: feb 2008
Posts: 230
Poder: 17
juank1971 Va por buen camino
mas detalles

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.




Código Delphi [-]
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.
Responder Con Cita
  #6  
Antiguo 25-06-2023
juank1971 juank1971 is offline
Miembro
 
Registrado: feb 2008
Posts: 230
Poder: 17
juank1971 Va por buen camino
ya funciona

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

Código Delphi [-]
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.
Responder Con Cita
  #7  
Antiguo 26-06-2023
Avatar de Neftali [Germán.Estévez]
Neftali [Germán.Estévez] Neftali [Germán.Estévez] is offline
[becario]
 
Registrado: jul 2004
Ubicación: Barcelona - España
Posts: 18.549
Poder: 10
Neftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en bruto
Cita:
Empezado por juank1971 Ver Mensaje
este es el código funcionando por si alguien quisiera usarlo

Gracias por el aporte.
__________________
Germán Estévez => Web/Blog
Guía de estilo, Guía alternativa
Utiliza TAG's en tus mensajes.
Contactar con el Clubdelphi

P.D: Más tiempo dedicado a la pregunta=Mejores respuestas.
Responder Con Cita
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
ayuda con componte Tpagecontrols microbiano Varios 2 05-02-2011 06:19:47
Siempre Encima. Cecilio Varios 4 23-11-2007 10:55:54
Imagen encima de todo orodruin OOP 4 14-11-2005 10:32:55
MDIChild encima vtdeleon OOP 2 20-02-2005 12:49:24
Ayuda para un componte que conecte a firebird 1.5 ronimaxh Conexión con bases de datos 1 28-11-2003 22:21:43


La franja horaria es GMT +2. Ahora son las 01:51:52.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi