Ver Mensaje Individual
  #6  
Antiguo 25-06-2023
juank1971 juank1971 is offline
Miembro
 
Registrado: feb 2008
Posts: 230
Reputación: 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