Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)
-   -   Mensaje sobre un botón. (https://www.clubdelphi.com/foros/showthread.php?t=83989)

DOS 25-08-2013 03:14:34
Mensaje sobre un botón.
 
Hola resulta que quiero mostrar un mensaje en un memo cuando paso sobre un botón, lo realice de la siguiente manera, en el evento onmousemove del botón.
Código Delphi [-]
procedure TForm2.BitBtn10MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
Memo1.Lines.LoadFromFile(ImagePath12);
end;
y declarando la direccion de imagePath que es un txt, el asunto es que mientras esta sobre el botón, esta constantemente actualizando el texto como en un loop o bucle hasta que salimos de estar sobre él(parpadea el texto), es posible ponerle un stop.
Muchas gracias.

ecfisa 25-08-2013 06:09:21
Hola DOS.

Una opción diferente:
Código Delphi [-]
...
type
  TBitBtn = class(Buttons.TBitBtn)
  private
    procedure CMMouseEnter(var M: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var M: TMessage); message CM_MOUSELEAVE;
  end;

  TForm1 = class(TForm)
    BitBtn_Del_Memo: TBitBtn;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    ...
    Memo1: TMemo;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

...

procedure TBitBtn.CMMouseEnter(var M: TMessage);
var
  WC : TWinControl;
begin
  inherited;
  WC := FindVCLWindow(Mouse.CursorPos);
  if Assigned(WC) and (WC.Name = 'BitBtn_Del_Memo') then
    with Form1.Memo1 do
    begin
      Clear;
      Lines.LoadFromFile(ImagePath12);
    end;
end;

procedure TBitBtn.CMMouseLeave(var M: TMessage);
begin
  inherited;
  Form1.Memo1.Clear;
end;
...

Saludos :)

DOS 25-08-2013 17:56:45
Gracias ecfisa, seguro que estoy haciendo algo mal, pero no me doy cuenta, algo esta mal puesto, te muestro el codigo mas completo con tus cambios a ver si te das cuenta
Código Delphi [-]
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ExtCtrls, jpeg, Buttons, DBCtrls, DB, DBTables;

type
  TForm2 = class(TForm)
    TBitBtn = class(Buttons.TBitBtn)    //ya parto del error aca
    Panel1: TPanel;
    MainMenu1: TMainMenu;
    Peluqueria1: TMenuItem;
    Administrador1: TMenuItem;
    Acercade1: TMenuItem;
    Ayuda1: TMenuItem;
    Image1: TImage;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    BitBtn5: TBitBtn;
    BitBtn6: TBitBtn;
    BitBtn7: TBitBtn;
    BitBtn8: TBitBtn;
    BitBtn9: TBitBtn;
    BitBtn10: TBitBtn;
    BitBtn11: TBitBtn;
    Image2: TImage;
    BitBtn_Del_Memo: TBitBtn;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure BitBtn7Click(Sender: TObject);
    procedure BitBtn8Click(Sender: TObject);
    procedure BitBtn9Click(Sender: TObject);
    procedure BitBtn10Click(Sender: TObject);
    procedure BitBtn11Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Acercade1Click(Sender: TObject);
    procedure Administrador1Click(Sender: TObject);
    procedure Peluqueria1Click(Sender: TObject);
    procedure Ayuda1Click(Sender: TObject);
    
  private
    procedure CMMouseEnter(var M: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var M: TMessage); message CM_MOUSELEAVE;
  end;
   
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;
  ImagenTemp:TImage;
implementation

uses Unit19, Unit5, Unit3, Unit14, Unit13, Unit17, Unit10, Unit20, Unit7,
  Unit6, Unit4, Unit24, Unit9, Unit1;
Const

   ImagePath1 = 'C:\ITM\imagenes\BMP\menu.bmp';
   ImagePath2 = 'C:\ITM\imagenes\BMP\mascota.bmp';
   ImagePath3 = 'C:\ITM\imagenes\BMP\Propietario.bmp';
   ImagePath4 = 'C:\ITM\imagenes\BMP\turnosgeneral.bmp';
   ImagePath5 = 'C:\ITM\imagenes\BMP\enfermedades.bmp';
   ImagePath6 = 'C:\ITM\imagenes\BMP\serviciosgenerales.bmp';
   ImagePath7 = 'C:\ITM\imagenes\BMP\inventario.bmp';
   ImagePath8 = 'C:\ITM\imagenes\BMP\facturacion.bmp';
   ImagePath9 = 'C:\ITM\imagenes\BMP\ayuda.bmp';
   ImagePath10 = 'C:\ITM\imagenes\BMP\productosvarios.bmp';
   ImagePath11 = 'C:\ITM\imagenes\BMP\propietario.txt';
   ImagePath12 = 'C:\ITM\imagenes\BMP\mascota.txt';

{$R *.dfm}

procedure TBitBtn.CMMouseEnter(var M: TMessage);
var
  WC : TWinControl;
begin
  inherited;
  WC := FindVCLWindow(Mouse.CursorPos);
  if Assigned(WC) and (WC.Name = 'BitBtn_Del_Memo') then
    with Form2.Memo1 do
    begin
      Clear;
      Lines.LoadFromFile(ImagePath12);
    end;
end;

procedure TBitBtn.CMMouseLeave(var M: TMessage);
begin
  inherited;
  Form2.Memo1.Clear;
end;

ecfisa 25-08-2013 21:43:24
Hola DOS.

"Boton_Del_Memo" era un nombre arbitrario como para denotar que ese era el botón sobre el que se aplicaba el código...

De todos modos supongo que al ser los archivos de tipo .BMP, estaremos hablando de un TImage, no de un TMemo.

Si no interpreto mal la lógica de tu código, la intención es mostrar una imágen diferente cuando se pasa por los distintos TBitBtn. Si es así creo que podrías hacer algo parecido a esto:
Código Delphi [-]
...
type
  TBitBtn = class(Buttons.TBitBtn)
  private
    procedure CMMouseEnter(var M: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var M: TMessage); message CM_MOUSELEAVE;
  end;

  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    Image1: TImage;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    BitBtn5: TBitBtn;
    BitBtn6: TBitBtn;
    BitBtn7: TBitBtn;
    BitBtn8: TBitBtn;
    BitBtn9: TBitBtn;
    BitBtn10: TBitBtn;
    BitBtn11: TBitBtn;
    BitBtn12: TBitBtn;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

const
   PATHTOIMAGES = 'C:\ITM\imagenes\BMP\';
   IMAGENAME : array[1..12] of string = ('menu.bmp','mascota.bmp', 'propietario.bmp',
     'turnosgeneral.bmp', 'enfermedades.bmp','serviciosgenerales.bmp', 'inventario.bmp',
     'facturacion.bmp', 'ayuda.bmp','productosvarios.bmp','propietario.bmp','mascota.bmp');


procedure TBitBtn.CMMouseEnter(var M: TMessage);
begin
  inherited;
  Form1.Image1.Picture.LoadFromFile(PATHTOIMAGES+IMAGENAME[Tag]);
end;

procedure TBitBtn.CMMouseLeave(var M: TMessage);
begin
  inherited;
  Form1.Image1.Picture := nil;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
  C: TComponent;
begin
  for i := 0 to ComponentCount - 1 do
  begin
    C := FindComponent('BitBtn' + IntToStr(i + 1));
    if Assigned(C) then
      TBitBtn(C).Tag := i + 1;
  end
end;
...
El código de asignación a la propiedad Tag en el evento OnCreate, servirá siempre que tus TBitBtn se llamen BitBtn1, BitBtn2, ..., BitBtn12. De otro modo lo tendrás que asignar individualmente.

Saludos :)

DOS 26-08-2013 00:44:40
Gracias ecfisa, en realidad los botones hacen dos cosas mostrar una imagen(esto lo realiza bien) y lo que quiero que hagan ademas mostrar un texto en un memo, fijate que en el path 11 y 12 son .txt nada mas que estan en la misma direccion que las imagenes, a ver si se entendio mejor ahora.^\||/

ecfisa 26-08-2013 01:18:25
Hola DOS.

No me queda claro lo siguiente: ¿ Existe un archivo txt diferente para cada TBitBtn y debe mostrarse en el TMemo cuando pase por encima de cada uno ?

Si es así, del código del mensaje #4, sólo tenes que cambiar:
Código Delphi [-]
...
const
   (* Según tu mensaje los .txt estan en la misma ruta de las imágenes *)
   PATHTOTXT = 'C:\ITM\imagenes\BMP\';  
   (* Nota: Los nombres no tienen que ser estos necesariamente... *)
   TXTNAME : array[1..12] of string = ('menu.txt','mascota.txt', 'propietario.txt',
     'turnosgeneral.txt', 'enfermedades.txt','serviciosgenerales.txt', 'inventario.txt',
     'facturacion.txt', 'ayuda.txt','productosvarios.txt','propietario.txt','mascota.txt');

procedure TBitBtn.CMMouseEnter(var M: TMessage);
begin
  inherited;
  Form1.Memo1.Lines.LoadFromFile(PATHTOTXT + TXTNAME[Tag]);
end;

procedure TBitBtn.CMMouseLeave(var M: TMessage);
begin
  inherited;
  Form1.Memo1.Clear;
end;
...

Saludos. :)

DOS 26-08-2013 01:56:06
me tira el siguiente error ...Cannot open file"C:\ITM\imagenes\BMP\Chairs"... no se a que hace referencia con chairs, esto sucede aunque no pase el mouse por arriba solo al abrir el formulario, te muestro el codigo
Código Delphi [-]
unit Unit2;  //menú veterinaria

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ExtCtrls, jpeg, Buttons, DBCtrls, DB, DBTables;

type
  TBitBtn = class(Buttons.TBitBtn)
  private
    procedure CMMouseEnter(var M: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var M: TMessage); message CM_MOUSELEAVE;
  end;

  TForm2 = class(TForm)
    Panel1: TPanel;
    MainMenu1: TMainMenu;
    Peluqueria1: TMenuItem;
    Administrador1: TMenuItem;
    Acercade1: TMenuItem;
    Ayuda1: TMenuItem;
    Image1: TImage;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    BitBtn5: TBitBtn;
    BitBtn6: TBitBtn;
    BitBtn7: TBitBtn;
    BitBtn8: TBitBtn;
    BitBtn9: TBitBtn;
    BitBtn10: TBitBtn;
    BitBtn11: TBitBtn;
    Image2: TImage;
    Memo1: TMemo;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure BitBtn7Click(Sender: TObject);
    procedure BitBtn8Click(Sender: TObject);
    procedure BitBtn9Click(Sender: TObject);
    procedure BitBtn10Click(Sender: TObject);
    procedure BitBtn11Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Acercade1Click(Sender: TObject);
    procedure Administrador1Click(Sender: TObject);
    procedure Peluqueria1Click(Sender: TObject);
    procedure Ayuda1Click(Sender: TObject);

   private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

uses Unit19, Unit5, Unit3, Unit14, Unit13, Unit17, Unit10, Unit20, Unit7,
  Unit6, Unit4, Unit24, Unit9, Unit1;
Const

   ImagePath1 = 'C:\ITM\imagenes\BMP\menu.bmp';
   ImagePath2 = 'C:\ITM\imagenes\BMP\mascota.bmp';
   ImagePath3 = 'C:\ITM\imagenes\BMP\Propietario.bmp';
   ImagePath4 = 'C:\ITM\imagenes\BMP\turnosgeneral.bmp';
   ImagePath5 = 'C:\ITM\imagenes\BMP\enfermedades.bmp';
   ImagePath6 = 'C:\ITM\imagenes\BMP\serviciosgenerales.bmp';
   ImagePath7 = 'C:\ITM\imagenes\BMP\inventario.bmp';
   ImagePath8 = 'C:\ITM\imagenes\BMP\facturacion.bmp';
   ImagePath9 = 'C:\ITM\imagenes\BMP\ayuda.bmp';
   ImagePath10 = 'C:\ITM\imagenes\BMP\productosvarios.bmp';
   ImagePath11 = 'C:\ITM\imagenes\BMP\propietario.txt';
   ImagePath12 = 'C:\ITM\imagenes\BMP\mascota.txt';
   PATHTOTXT = 'C:\ITM\imagenes\BMP\';
   TXTNAME : array[1..2] of string = ('mascota.txt', 'propietario.txt');// De prueba solo puse dos

{$R *.dfm}

procedure TBitBtn.CMMouseEnter(var M: TMessage);
begin
  inherited;
  Form2.Memo1.Lines.LoadFromFile(PATHTOTXT + TXTNAME[Tag]);
end;

procedure TBitBtn.CMMouseLeave(var M: TMessage);
begin
  inherited;
  Form2.Memo1.Clear;
end;

ecfisa 26-08-2013 02:31:31
1 Archivos Adjunto(s)
Hola DOS.

Creo que va a ser mas sencillo para ambos que te adjunte los fuentes de un programa totalmente operativo para que lo revises con tranquilidad...

Descomprimilo en cualquier carpeta, al ejecutarlo el programa crea diez archivos de texto de prueba que se irán mostrando en el TMemo de acuerdo al TBitBtn sobre el que pases el mouse.

Saludos. :)

DOS 26-08-2013 03:17:15
Muchass Gracias! ^\||/


La franja horaria es GMT +2. Ahora son las 04:20:44.

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