Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)
-   -   iconos del mesagebox (https://www.clubdelphi.com/foros/showthread.php?t=31249)

Choclito 03-05-2006 15:52:19

iconos del mesagebox
 
hola amigos del foro, contarles q estoy haciendo un sistema en el cual gracias a la web y al foro hice mi propio mesagebox y todo iva bien hasta q no me di cuentas q los iconos q se muestran son muy pequeños y me exigen q se vea mas grandes pero la verdad nose como hacerlo ahi les muestro la unit es la siguiente:
Código Delphi [-]
unit UnitShowMessage;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, LMDControl, LMDBaseControl, LMDBaseGraphicButton,
  LMDCustomSpeedButton, LMDSpeedButton, Buttons, ExtCtrls,
  LMDCustomButton, LMDButton, ImgList;

type
  TFrmMessageBox = class(TForm)
    LTitulo: TLabel;
    LMensaje: TLabel;
    BAceptar: TLMDButton;
    BCancelar: TLMDButton;
    PBMovible: TPaintBox;
    BReintentar: TLMDButton;
    PBIcono: TPaintBox;
    ILIcono: TImageList;
    ImageList1: TImageList;
    procedure FormShow(Sender: TObject);
    procedure PBMovibleMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PBMovibleMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PBMovibleMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PBIconoPaint(Sender: TObject);


  private
    { Private declarations }
    RatonPulsado: Boolean;
    Punto: TPoint;

  public
    { Public declarations }
  end;
  function Maximo (a,b:integer):integer;
      FUNCTION MsgBox (Titulo, Mensaje: String; Flags: DWord):integer;
var
  FrmMessageBox: TFrmMessageBox;
  IndiceImagen:integer;
implementation

{$R *.dfm}


procedure TFrmMessageBox.FormShow(Sender: TObject);
begin
RatonPulsado := False;
end;

procedure TFrmMessageBox.PBMovibleMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 IF Button = mbLeft THEN
  BEGIN
    RatonPulsado := True;
    Punto.x := x;
    Punto.y := y;
  END;
end;
function Maximo(a,b:integer):integer;
begin
if a>b then
Maximo:=a
else
Maximo:=b;

end;

FUNCTION MsgBox (Titulo, Mensaje: String; Flags: DWord): Integer;
CONST
  PosLeft = 112;
  PosWidth = 320;
  LeftBotones = 25;
  SepBotones = 7;
VAR
  Botones, Icono: Word;
  AlineacionDerecha: Boolean;
  ResModal: TModalResult;
  IdBotonPulsado: Integer;

BEGIN
  { Comenzamos separando de la variable Flags los botones, el icono
    así como si el texto del mensaje está alineado o no a la derecha }

  Botones := Flags AND $F;
  Icono := Flags AND $F0;
  AlineacionDerecha := (Flags AND $F0000) = $80000;
 IndiceImagen := 0;  { Un valor inicial no perjudicial }

  WITH FrmMessageBox DO
  BEGIN
    Caption := Titulo;
    LTitulo.AutoSize := False;
    LMensaje.AutoSize := False;
    LTitulo.Caption := Titulo;
    LTitulo.Left := LeftBotones;
    LTitulo.Width := 2 *(PosWidth DIV 3);
    LTitulo.AutoSize := True;
    LMensaje.Caption := Mensaje;
    LMensaje.Left := PosLeft;
    LMensaje.Width := PosWidth;
    LMensaje.Alignment := taLeftJustify;
    LMensaje.AutoSize := True;
    LMensaje.Top := LTitulo.Top + LTitulo.Height + 15;
    BAceptar.Top := LMensaje.Top + Maximo(LMensaje.Height, PBIcono.Height);
    BCancelar.Top := BAceptar.Top;
    BReintentar.Top := BAceptar.Top;
    ClientHeight := BAceptar.Top + BAceptar.Height + 20;

    { Ahora pasamos a arreglar los botones en función del que nos han pedido }

    CASE Botones OF
      MB_OK:  { Sólo debe estar visible el de 'Aceptar' y centrado }
      BEGIN
        BAceptar.Visible := True;
        BCancelar.Visible := False;
       BReintentar.Visible := False;

        //BAceptar.Kind := bkOK;
        BAceptar.Caption := 'ACEPTAR';

        BAceptar.Left := Width DIV 2 - BAceptar.Width DIV 3;
        BAceptar.Width:=90;
      END;

      MB_OKCANCEL:  { Visibles 'Aceptar' y 'Cancelar', centrados }
      BEGIN
        BAceptar.Visible := True;
        BCancelar.Visible := True;
       BReintentar.Visible := False;

      //  BAceptar.Kind := bkOK;
        BAceptar.Caption := ' Aceptar';
       // BCancelar.Kind := bkCancel;
        BCancelar.Caption := ' Cancelar';

        BAceptar.Left := Width DIV 3 - BAceptar.Width DIV 3;
        BCancelar.Left := BAceptar.Left + BAceptar.Width + SepBotones;
      END;

      MB_RETRYCANCEL:  { Visibles 'Reintentar' y 'Cancelar', centrados }
      BEGIN
        BAceptar.Visible := False;
        BCancelar.Visible := True;
       BReintentar.Visible := True;

        //BCancelar.Kind := bkCancel;
        BCancelar.Caption := ' Cancelar';
       // BReintentar.Kind := bkRetry;
        BReintentar.Caption := ' Reintentar';

        BReintentar.Left := Width DIV 3 - BReintentar.Width DIV 3;
        BCancelar.Left := BReintentar.Left + BReintentar.Width + SepBotones;
      END;

      MB_YESNO:  { De nuevo visibles 'Aceptar' y 'Cancelar', centrados }
      BEGIN
        BAceptar.Visible := True;
        BCancelar.Visible := True;
       BReintentar.Visible := False;

       // BAceptar.Kind := bkYes;
        BAceptar.Caption := ' SI';
       // BCancelar.Kind := bkNo;
        BCancelar.Caption := ' NO';

        BAceptar.Left := 112;
        BAceptar.Width:=49;
        BCancelar.Left := 232;
      END;

      MB_YESNOCANCEL:  { Todos los botones deben ser visibles }
      BEGIN
        BAceptar.Visible := True;
        BCancelar.Visible := True;
       BReintentar.Visible := True;

       // BAceptar.Kind := bkYes;
        BAceptar.Caption := ' Sí';
      //  BCancelar.Kind := bkNo;
        BCancelar.Caption := ' No';
      //  BReintentar.Kind := bkCancel;
       BReintentar.Caption := ' Cancelar';

        BAceptar.Left := LeftBotones;
        BCancelar.Left := BAceptar.Left + BAceptar.Width + SepBotones;
        BReintentar.Left := BCancelar.Left + BCancelar.Width + SepBotones;
      END;

    END;

    { Ahora vamos a averiguar qué icono nos han pedido para dibujarlo }

   CASE Icono OF
      MB_ICONINFORMATION: { MB_ICONASTERISK }
        IndiceImagen := 1;

      MB_ICONERROR:       { MB_ICONHAND, MB_ICONSTOP}
        IndiceImagen := 2;

      MB_ICONEXCLAMATION:{MB_ICONWARNING}
        IndiceImagen := 3;

      MB_ICONQUESTION:
       IndiceImagen := 4;
    END;

    IF AlineacionDerecha THEN LMensaje.Alignment := taRightJustify;
  END;

  //MessageBeep(Icono);
  { Esto es un extra ;-) Llama a una función del
                         API que emite un sonido estándar de Windows,
                         con lo que lo hacemos más parecido al MessageBox
                         de verdad :-) }

  ResModal := FrmMessageBox.ShowModal;
  IdBotonPulsado := 0;

  { Por último, convertimos los valores de ModalResult a las constantes
    definidas por Windows como respuesta de MessageBox }

  CASE ResModal OF
    mrOk:     IdBotonPulsado := IDOK;
    mrCancel: IdBotonPulsado := IDCANCEL;
    mrAbort:  IdBotonPulsado := IDABORT;
    mrRetry:  IdBotonPulsado := IDRETRY;
    mrIgnore: IdBotonPulsado := IDIGNORE;
    mrYes:    IdBotonPulsado := IDYES;
    mrNo :    IdBotonPulsado := IDNO;
  END;

  MsgBox := IdBotonPulsado;
END;
procedure TFrmMessageBox.PBMovibleMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
 IF RatonPulsado THEN
    SetBounds(x - Punto.x + Left, y - Punto.y + Top, Width, Height);
end;

procedure TFrmMessageBox.PBMovibleMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 IF Button = mbLeft THEN RatonPulsado := False;
end;

procedure TFrmMessageBox.PBIconoPaint(Sender: TObject);
begin
  ILIcono.Draw(PBIcono.Canvas, 0, 0, IndiceImagen);

end;

end.
y desde otras unidades lo llamo por ejemplo de la siguiente manera:
IF MsgBox ('SISTEMA DE ASISTENCIA MEDICA','¿QUIERE SALIR DEL SISTEMA ?',
MB_YESNO + MB_ICONQUESTION)=IDYES THEN

application.Terminate;

muchas gracias por sugerencias y la ayuda q me brinden

Neftali [Germán.Estévez] 03-05-2006 16:21:05

En un ImageList, que creo que es lo que usas para almacenar las imágenes, puedes definir los iconos del tamaño que necesites. Borra las imágenes que tienes y añade imágenes/iconos más grandes.

Choclito 03-05-2006 18:07:24

gracias por la respuesta
 
muchas gracias por la respuesta neftali comentarte q cambien el tamaño de iconos y bmps hata 48x48 pero me sigue saliendo la imagen pequeña, al parecer el problema es en el componente tpaintbox pero la verdad nose q mas hacer ,,,
Donde puedo estar errando?, comentarte q la unidad la baje de internet pero no me di cuenta sobre las imagenes hasta q me pidieron q sean mas grandes
Como siempre te estare muy agradecido por la ayuda
Tambien comentarte q cuando añado en el imagelist los .ico o .bmp dentro de las opciones se habilita la opcion strech pero cuando pulso ok y aply y vuelvo a abrir el imagelist todas las imagenes estan en la opcion crop
Sera por eso q muestra las imagenes pequeñas?
por mas q cambie el tamaño de las mismas
Nuevamente muchas gracias por ver este hilo

Sinaloense 04-05-2006 00:20:53

Si quieres mandame el fuente a mi correo y yo te puedo ayudar.


La franja horaria es GMT +2. Ahora son las 06:12:29.

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