Tecsitel_FactuGES/Libreria/Mensajes.pas

{
===============================================================================
  Copyright (©) 2001. Rodax Software.
===============================================================================
  Los contenidos de este fichero son propiedad de Rodax Software titular del
  copyright. Este fichero sólo podrá ser copiado, distribuido y utilizado,
  en su totalidad o en parte, con el permiso escrito de Rodax Software, o de
  acuerdo con los términos y condiciones establecidas en el acuerdo/contrato
  bajo el que se suministra.
  -----------------------------------------------------------------------------
  Web:  www.rodax-software.com
===============================================================================
  Fecha primera versión: 01-10-2001
  Versión actual: 1.0.0
  Fecha versión actual: 01-10-2001
===============================================================================
  Modificaciones:

    Fecha         Comentarios
    ---------------------------------------------------------------------------
===============================================================================
}

unit Mensajes;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  StdCtrls, RdxBotones, Dialogs;

type
  TfMensajes = class(TForm)
  private
    procedure HelpButtonClick(Sender: TObject);
  public
    constructor CreateNew(AOwner: TComponent); reintroduce;
  end;

procedure VerMensaje(const Msg: string);
procedure VerMensajeFmt(const Msg: string; Params: array of const);
function VerMensajePregunta(const Msg: string) : integer;
function VerMensajePreguntaSN(const Msg: string) : integer;
function VerMensajePreguntaFmt(const Msg: string; Params: array of const) : integer;
function CrearVentanaMensaje(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons): TForm;
function GetAveCharSize(Canvas: TCanvas): TPoint;
function Max(I, J: Integer): Integer;

var
  fMensajes: TfMensajes;

implementation

uses
   extctrls, Colores, Consts;
{$R-,T-,H+,X+,G+}
resourcestring
  SMsgDlgWarning = 'Atención';
  SMsgDlgError = 'Error';
  SMsgDlgInformation = 'Información';
  SMsgDlgConfirm = 'Confirmar';
  SMsgDlgYes = '&Si';
  SMsgDlgNo = '&No';
  SMsgDlgOK = '&Aceptar';
  SMsgDlgCancel = '&Cancelar';
  SMsgDlgHelp = '&Ayuda';
  SMsgDlgHelpNone = 'No hay ayuda disponible';
  SMsgDlgHelpHelp = 'Ayuda';
  SMsgDlgAbort = '&Abortar';
  SMsgDlgRetry = '&Reintentar';
  SMsgDlgIgnore = '&Ignorar';
  SMsgDlgAll = '&Todo';
  SMsgDlgNoToAll = '&No a todo';
  SMsgDlgYesToAll = '&Si a todo';

var
  Captions: array[TMsgDlgType] of Pointer = (@SMsgDlgWarning, @SMsgDlgError,
    @SMsgDlgInformation, @SMsgDlgConfirm, nil);
  IconIDs: array[TMsgDlgType] of PChar = (IDI_EXCLAMATION, IDI_HAND,
    IDI_ASTERISK, IDI_QUESTION, nil);
  ButtonNames: array[TMsgDlgBtn] of string = (
    'Si', 'No', 'OK', 'Cancelar', 'Abortar', 'Reintentar', 'Ignorar', 'Todo', 'NoToAll',
    'YesToAll', 'Ayuda');
  ButtonCaptions: array[TMsgDlgBtn] of Pointer = (
    @SMsgDlgYes, @SMsgDlgNo, @SMsgDlgOK, @SMsgDlgCancel, @SMsgDlgAbort,
    @SMsgDlgRetry, @SMsgDlgIgnore, @SMsgDlgAll, @SMsgDlgNoToAll, @SMsgDlgYesToAll,
    @SMsgDlgHelp);
  ModalResults: array[TMsgDlgBtn] of Integer = (
    mrYes, mrNo, mrOk, mrCancel, mrAbort, mrRetry, mrIgnore, mrAll, mrNoToAll,
    mrYesToAll, 0);
var
  ButtonWidths : array[TMsgDlgBtn] of integer;  // initialized to zero


constructor TfMensajes.CreateNew(AOwner: TComponent);
var
  NonClientMetrics: TNonClientMetrics;
begin
  inherited CreateNew(AOwner);
  Color := RdxHueso;
  Font.Name := 'Tahoma';
  NonClientMetrics.cbSize := sizeof(NonClientMetrics);
  if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
    Font.Handle := CreateFontIndirect(NonClientMetrics.lfMessageFont);
end;

procedure TfMensajes.HelpButtonClick(Sender: TObject);
begin
  Application.HelpContext(HelpContext);
end;

function CrearVentanaMensaje(const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons): TForm;
const
  mcHorzMargin = 8;
  mcVertMargin = 8;
  mcHorzSpacing = 10;
  mcVertSpacing = 10;
  mcButtonWidth = 50;
  mcButtonHeight = 14;
  mcButtonSpacing = 4;
var
  DialogUnits: TPoint;
  HorzMargin, VertMargin, HorzSpacing, VertSpacing, ButtonWidth,
  ButtonHeight, ButtonSpacing, ButtonCount, ButtonGroupWidth,
  IconTextWidth, IconTextHeight, X, ALeft: Integer;
  B, DefaultButton, CancelButton: TMsgDlgBtn;
  IconID: PChar;
  TextRect: TRect;
begin
  Result := TfMensajes.CreateNew(Application);
  with Result do
  begin
    BiDiMode := Application.BiDiMode;
    BorderStyle := bsDialog;
    Canvas.Font := Font;
    DialogUnits := GetAveCharSize(Canvas);
    HorzMargin := MulDiv(mcHorzMargin, DialogUnits.X, 4);
    VertMargin := MulDiv(mcVertMargin, DialogUnits.Y, 8);
    HorzSpacing := MulDiv(mcHorzSpacing, DialogUnits.X, 4);
    VertSpacing := MulDiv(mcVertSpacing, DialogUnits.Y, 8);
    ButtonWidth := MulDiv(mcButtonWidth, DialogUnits.X, 4);
    for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
    begin
      if B in Buttons then
      begin
        if ButtonWidths[B] = 0 then
        begin
          TextRect := Rect(0,0,0,0);
          Windows.DrawText( canvas.handle,
            PChar(LoadResString(ButtonCaptions[B])), -1,
            TextRect, DT_CALCRECT or DT_LEFT or DT_SINGLELINE or
            DrawTextBiDiModeFlagsReadingOnly);
          with TextRect do ButtonWidths[B] := Right - Left + 8;
        end;
        if ButtonWidths[B] > ButtonWidth then
          ButtonWidth := ButtonWidths[B];
      end;
    end;
    ButtonHeight := MulDiv(mcButtonHeight, DialogUnits.Y, 8);
    ButtonSpacing := MulDiv(mcButtonSpacing, DialogUnits.X, 4);
    SetRect(TextRect, 0, 0, Screen.Width div 2, 0);
    DrawText(Canvas.Handle, PChar(Msg), Length(Msg)+1, TextRect,
      DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or
      DrawTextBiDiModeFlagsReadingOnly);
    IconID := IconIDs[DlgType];
    IconTextWidth := TextRect.Right;
    IconTextHeight := TextRect.Bottom;
    if IconID <> nil then
    begin
      Inc(IconTextWidth, 32 + HorzSpacing);
      if IconTextHeight < 32 then IconTextHeight := 32;
    end;
    ButtonCount := 0;
    for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
      if B in Buttons then Inc(ButtonCount);
    ButtonGroupWidth := 0;
    if ButtonCount <> 0 then
      ButtonGroupWidth := ButtonWidth * ButtonCount +
        ButtonSpacing * (ButtonCount - 1);
    ClientWidth := Max(IconTextWidth, ButtonGroupWidth) + HorzMargin * 2;
    ClientHeight := IconTextHeight + ButtonHeight + VertSpacing +
      VertMargin * 2;
    Left := (Screen.Width div 2) - (Width div 2);
    Top := (Screen.Height div 2) - (Height div 2);
    if DlgType <> mtCustom then
      Caption := LoadResString(Captions[DlgType]) else
      Caption := Application.Title;
    if IconID <> nil then
      with TImage.Create(Result) do
      begin
        Name := 'Image';
        Parent := Result;
        Picture.Icon.Handle := LoadIcon(0, IconID);
        SetBounds(HorzMargin, VertMargin, 32, 32);
      end;
    with TLabel.Create(Result) do
    begin
      Name := 'Message';
      Parent := Result;
      WordWrap := True;
      Caption := Msg;
      BoundsRect := TextRect;
      BiDiMode := Result.BiDiMode;
      ALeft := IconTextWidth - TextRect.Right + HorzMargin;
      if UseRightToLeftAlignment then
        ALeft := Result.ClientWidth - ALeft - Width;
      SetBounds(ALeft, VertMargin,
        TextRect.Right, TextRect.Bottom);
    end;
    if mbOk in Buttons then DefaultButton := mbOk else
      if mbYes in Buttons then DefaultButton := mbYes else
        DefaultButton := mbRetry;
    if mbCancel in Buttons then CancelButton := mbCancel else
      if mbNo in Buttons then CancelButton := mbNo else
        CancelButton := mbOk;
    X := (ClientWidth - ButtonGroupWidth) div 2;
    for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
      if B in Buttons then
        with TRdxBoton.Create(Result) do
        begin
          Color := rdxSepia;
          ColorBorder := rdxSepiaOscuro;
          ColorDown := rdxSepia;
          ColorFocused := rdxSepiaAmarillo;
          ColorHighLight := rdxSepiaOscuro;
          ColorShadow := rdxSepiaOscuro;
          Name := ButtonNames[B];
          Parent := Result;
          Caption := LoadResString(ButtonCaptions[B]);
          ModalResult := ModalResults[B];
          if B = DefaultButton then Default := True;
          if B = CancelButton then Cancel := True;
          SetBounds(X, IconTextHeight + VertMargin + VertSpacing,
            ButtonWidth, ButtonHeight);
          Inc(X, ButtonWidth + ButtonSpacing);
          if B = mbHelp then
            OnClick := TfMensajes(Result).HelpButtonClick;
        end;
  end;
end;

function GetAveCharSize(Canvas: TCanvas): TPoint;
var
  I: Integer;
  Buffer: array[0..51] of Char;
begin
  for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
  for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
  GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
  Result.X := Result.X div 52;
end;

function Max(I, J: Integer): Integer;
begin
  if I > J then Result := I else Result := J;
end;

procedure VerMensaje(const Msg: string);
var
  X, Y : integer;
begin
  X := -1;
  Y := -1;
  with CrearVentanaMensaje(Msg, mtWarning, [mbOK]) do
    try
      HelpContext := 0;
      HelpFile := '';
      if X >= 0 then Left := X;
      if Y >= 0 then Top := Y;
      if (Y < 0) and (X < 0) then Position := poScreenCenter;
      MessageBeep(MB_ICONASTERISK);
      ShowModal;
    finally
      Free;
    end;
end;

procedure VerMensajeFmt(const Msg: string; Params: array of const);
begin
  VerMensaje(Format(Msg, Params));
end;

function VerMensajePregunta(const Msg: string) : integer;
var
  X, Y : integer;
begin
  X := -1;
  Y := -1;
  with CrearVentanaMensaje(Msg, mtConfirmation, [mbYes, mbNo, mbCancel]) do
    try
      HelpContext := 0;
      HelpFile := '';
      if X >= 0 then Left := X;
      if Y >= 0 then Top := Y;
      if (Y < 0) and (X < 0) then Position := poScreenCenter;
      MessageBeep(MB_ICONQUESTION);
      Result := ShowModal;
    finally
      Free;
    end;
end;

function VerMensajePreguntaSN(const Msg: string) : integer;
var
  X, Y : integer;
begin
  X := -1;
  Y := -1;
  with CrearVentanaMensaje(Msg, mtConfirmation, [mbYes, mbNo]) do
    try
      HelpContext := 0;
      HelpFile := '';
      if X >= 0 then Left := X;
      if Y >= 0 then Top := Y;
      if (Y < 0) and (X < 0) then Position := poScreenCenter;
      MessageBeep(MB_ICONQUESTION);
      Result := ShowModal;
    finally
      Free;
    end;
end;

function VerMensajePreguntaFmt(const Msg: string; Params: array of const) : integer;
begin
  Result := VerMensajePregunta(Format(Msg, Params));
end;

end.