path: root/src/gui/messagedialog.inc

{%mainunit gui_dialogs.pas}

{$IFDEF read_interface}

type

  TfpgMessageDialog = class(TfpgForm)
  private
    FInformativeText: TStringList;
    FText: string;
    FButtons: TfpgMsgDlgButtons;
    FDefaultButton: TfpgMsgDlgBtn;
    FDialogType: TfpgMsgDlgType;
    FButtonList: TList; // pointers to buttons
    FMaxLineWidth: Integer;
    FFont: TfpgFont;
    FTextY: Integer;
    FLineHeight: Integer;
    function    GetInformativeText: string;
    procedure   SetButtons(const AValue: TfpgMsgDlgButtons);
    procedure   SetDefaultButton(const AValue: TfpgMsgDlgBtn);
    procedure   SetInformativeText(const AValue: string);
    procedure   SetText(const AValue: string);
    procedure   pnlIconPaint(Sender: TObject);
    procedure   PrepareIcon;
    procedure   PrepareText;
    procedure   PrepareButtons;
  protected
    procedure   SetWindowTitle(const ATitle: string); override;
    procedure   HandlePaint; override;
    procedure   HandleShow; override;
    procedure   HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override;
    procedure   PrepareLayout;
  public
    {@VFD_HEAD_BEGIN: fpgMessageDialog}
    lblName1: TfpgLabel;
    pnlIcon: TfpgBevel;
    {@VFD_HEAD_END: fpgMessageDialog}
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure   AfterCreate; override;
    class procedure About(const ATitle: string; const AText: string);
    class procedure AboutFPGui(const ATitle: string = '');
    class function Critical(const ATitle: string; const AText: string; AButtons: TfpgMsgDlgButtons = [mbOK]; ADefaultButton: TfpgMsgDlgBtn = mbNoButton): TfpgMsgDlgBtn;
    class function Information(const ATitle: string; const AText: string; AButtons: TfpgMsgDlgButtons = [mbOK]; ADefaultButton: TfpgMsgDlgBtn = mbNoButton): TfpgMsgDlgBtn;
    class function Question(const ATitle: string; const AText: string; AButtons: TfpgMsgDlgButtons = [mbYes, mbNo]; ADefaultButton: TfpgMsgDlgBtn = mbNo): TfpgMsgDlgBtn;
    class function Warning(const ATitle: string; const AText: string; AButtons: TfpgMsgDlgButtons = [mbOK]; ADefaultButton: TfpgMsgDlgBtn = mbNoButton): TfpgMsgDlgBtn;
    property    InformativeText: string read GetInformativeText write SetInformativeText;
    property    Text: string read FText write SetText;
    property    Buttons: TfpgMsgDlgButtons read FButtons write SetButtons;
    property    DefaultButton: TfpgMsgDlgBtn read FDefaultButton write SetDefaultButton;
    property    DialogType: TfpgMsgDlgType read FDialogType;
  end;


{$ENDIF read_interface}



{$IFDEF read_implementation}

{ TfpgMessageDialog }

procedure TfpgMessageDialog.SetInformativeText(const AValue: string);
var
  outw: integer;
begin
  if not Assigned(FInformativeText) then
    FInformativeText := TStringList.Create;
    
  WrapText(AValue, FInformativeText, FFont, FMaxLineWidth, outw);
  // adjust dialog's height
  Height := lblName1.Bottom + (FLineHeight*FInformativeText.Count) + FTextY + 35;
end;

procedure TfpgMessageDialog.SetButtons(const AValue: TfpgMsgDlgButtons);
begin
  if FButtons = AValue then
    Exit; //==>
  FButtons := AValue;
end;

function TfpgMessageDialog.GetInformativeText: string;
begin
  if Assigned(FInformativeText) then
    Result := FInformativeText.Text
  else
    Result := '';
end;

procedure TfpgMessageDialog.SetDefaultButton(const AValue: TfpgMsgDlgBtn);
begin
  if FDefaultButton = AValue then
    Exit; //==>
  FDefaultButton := AValue;
  // Remember to check if button exists in FButtons
end;

procedure TfpgMessageDialog.SetText(const AValue: string);
begin
  if FText = AValue then
    Exit; //==>
  FText := AValue;
  lblName1.Text := FText;
end;

procedure TfpgMessageDialog.pnlIconPaint(Sender: TObject);
var
  wg: TfpgBevel;
begin
  wg := TfpgBevel(Sender);
  wg.Visible := False;
end;

procedure TfpgMessageDialog.PrepareIcon;
begin
  // do nothing yet
end;

procedure TfpgMessageDialog.PrepareText;
begin
  { todo: Implement this correctly }
//  Height := 150;
end;

procedure TfpgMessageDialog.PrepareButtons;
const
  cSpacing = 4;
var
  i: integer;
  b: TfpgButton;
  lcount: integer;
  lwidth: integer;
  ltop: integer;
  lleft: integer;
  sl: TStringList;
  lDefault: integer;
  
  function GetButtonCount: integer;
  var
    i: TfpgMsgDlgBtn;
  begin
    Result := 0;
    
    // try known sets first
    if Buttons = mbYesNoCancel then
    begin
      { TODO : At some stage the StyleManager can give us the correct button
        order based on the OS and Window Manager. }
      Result := 3;
      sl.Add(cMsgDlgBtnText[mbYes] + '=' + IntToStr(Ord(mbYes)));
      sl.Add(cMsgDlgBtnText[mbNo] + '=' + IntToStr(Ord(mbNo)));
      sl.Add(cMsgDlgBtnText[mbCancel] + '=' + IntToStr(Ord(mbCancel)));
      case DefaultButton of
        mbYes:    lDefault := 0;
        mbNo:     lDefault := 1;
        mbCancel: lDefault := 2;
      end;
      Exit;
    end;
    
    // if we got here, try all known buttons.
    for i := Low(TfpgMsgDlgBtn) to High(TfpgMsgDlgBtn) do
    begin
      if i in Buttons then
      begin
        inc(Result);
        sl.Add(cMsgDlgBtnText[i] + '=' + IntToStr(Ord(i)));
        if i = DefaultButton then
          lDefault := Result-1;
      end;
    end;
  end;
  
begin
  sl      := TStringList.Create;  // holds button captions
  lcount  := GetButtonCount;
  lwidth  := 0;

  // create buttons
  for i := 0 to lcount-1 do
  begin
    b       := TfpgButton.Create(self);
    b.Name  := 'DlgButton' + IntToStr(i+1);
    b.Text  := sl.Names[i];
    b.ModalResult   := StrToInt(sl.ValueFromIndex[i]);
    if (i = lDefault) or (lcount = 1) then
      b.Default := True;
    FButtonList.Add(b);
    lwidth  := lwidth + b.Width
  end;
  lwidth := lwidth + (cSpacing * (lcount-1));
  
  // position buttons
  if Assigned(FInformativeText) then
    ltop := lblName1.Bottom + 50 + (FLineHeight*FInformativeText.Count) + 15
  else
    ltop := lblName1.Bottom + 15;

//  ltop := Height - TfpgButton(FButtonList[0]).Height - cSpacing;
  lleft := (Width - lwidth) div 2;
  for i := 0 to lcount-1 do
  begin
    b := TfpgButton(FButtonList[i]);
    b.SetPosition(lleft, ltop, b.Width, b.Height);
    lleft := lleft + b.Width + cSpacing;
  end;
  
  sl.Free;
end;

procedure TfpgMessageDialog.SetWindowTitle(const ATitle: string);
begin
  if ATitle = '' then
  begin
    case DialogType of
      mtAbout:        SetWindowTitle(Format(rsAbout, [fpGUIName]));
      mtError:        SetWindowTitle(rsError);
      mtWarning:      SetWindowTitle(rsWarning);
      mtConfirmation: SetWindowTitle(rsConfirmation);
    end;
  end
  else
    inherited SetWindowTitle(ATitle);
end;

procedure TfpgMessageDialog.HandlePaint;
var
  logo: TfpgImage;
  i: integer;
  y: integer;
  tw: integer;
begin
  Canvas.BeginDraw;
  inherited HandlePaint;
  case FDialogType of
    mtAbout:
        begin
          Canvas.Clear(BackgroundColor);
          logo := CreateImage_BMP(@stdimg_fpgui_logo, SizeOf(stdimg_fpgui_logo));
          Canvas.SetColor(clBlack);
          Canvas.DrawRectangle(12, 12, logo.Width+2, logo.Height+2);
          Canvas.DrawImage(13, 13, logo);
          logo.free;
        end;

    mtError:
        begin
          Canvas.DrawImage(12, 12, fpgImages.GetImage('stdimg.dlg.critical'));    // Do NOT localize
        end;

    mtConfirmation:
        begin
          Canvas.DrawImage(12, 12, fpgImages.GetImage('stdimg.dlg.help'));        // Do NOT localize
        end;

    mtWarning:
        begin
          Canvas.DrawImage(12, 12, fpgImages.GetImage('stdimg.dlg.warning'));     // Do NOT localize
        end;

    else
        begin // default to Information
          Canvas.DrawImage(12, 12, fpgImages.GetImage('stdimg.dlg.info'));        // Do NOT localize
        end;
  end;

  // paint informative text
  if Assigned(FInformativeText) then
  begin
    Canvas.SetFont(FFont);
    y := FTextY;
    for i := 0 to FInformativeText.Count-1 do
    begin
      // centre text
//      tw := FFont.TextWidth(FInformativeText[i]);
//      Canvas.DrawString(Width div 2 - tw div 2, y, FInformativeText[i]);
      // left align text
      if FInformativeText[i] <> '' then
        Canvas.DrawString(70, y, FInformativeText[i]);
      Inc(y, FLineHeight);
    end;
  end;
  Canvas.EndDraw;
end;

procedure TfpgMessageDialog.HandleShow;
var
  i: integer;
begin
  inherited HandleShow;
  
  for i := 0 to ComponentCount-1 do
    if Components[i] is TfpgButton then
      if TfpgButton(Components[i]).Default then
        TfpgButton(Components[i]).SetFocus;
end;

procedure TfpgMessageDialog.HandleKeyPress(var keycode: word;
  var shiftstate: TShiftState; var consumed: boolean);
begin
  if keycode = keyEscape then   // Esc cancels the dialog
    ModalResult := Ord(mbCancel)
  else
    inherited HandleKeyPress(keycode, shiftstate, consumed);
end;

procedure TfpgMessageDialog.PrepareLayout;
begin
  PrepareIcon;
  PrepareText;
  PrepareButtons;
end;

constructor TfpgMessageDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FButtonList := TList.Create;
  FMaxLineWidth := 400;
  FFont         := fpgGetFont('#Label1');
  FTextY        := 60;
  FLineHeight   := FFont.Height + 4;
end;

destructor TfpgMessageDialog.Destroy;
begin
  FFont.Free;
  FButtonList.Clear;
  FButtonList.Free;
  FInformativeText.Free;
  inherited Destroy;
end;

class procedure TfpgMessageDialog.About(const ATitle: string; const AText: string);
begin
  writeln('** Implement TfpgMessageDialog.About');
end;

class procedure TfpgMessageDialog.AboutFPGui(const ATitle: string);
var
  dlg: TfpgMessageDialog;
begin
  dlg := TfpgMessageDialog.Create(nil);
  try
    dlg.FDialogType := mtAbout;
    if ATitle = '' then
      dlg.WindowTitle := Format(rsAbout, [fpGUIName])
    else
      dlg.WindowTitle := ATitle;
    dlg.Buttons := [mbOK];
    dlg.DefaultButton := mbOK;
    dlg.PrepareLayout;
    dlg.ShowModal;
  finally
    dlg.Free;
  end;
end;

class function TfpgMessageDialog.Critical(const ATitle: string;
  const AText: string; AButtons: TfpgMsgDlgButtons;
  ADefaultButton: TfpgMsgDlgBtn): TfpgMsgDlgBtn;
var
  dlg: TfpgMessageDialog;
begin
  dlg := TfpgMessageDialog.Create(nil);
  try
    dlg.FDialogType     := mtWarning;
    dlg.FButtons        := AButtons;
    dlg.Text            := ATitle;
    dlg.InformativeText := AText;
    dlg.WindowTitle     := ATitle;
    dlg.FDefaultButton  := ADefaultButton;
    dlg.PrepareLayout;
    Result := TfpgMsgDlgBtn(dlg.ShowModal);
  finally
    dlg.Free;
  end;
end;

class function TfpgMessageDialog.Information(const ATitle: string;
  const AText: string; AButtons: TfpgMsgDlgButtons;
  ADefaultButton: TfpgMsgDlgBtn): TfpgMsgDlgBtn;
var
  dlg: TfpgMessageDialog;
begin
  dlg := TfpgMessageDialog.Create(nil);
  try
    dlg.FDialogType     := mtInformation;
    dlg.FButtons        := AButtons;
    dlg.Text            := ATitle;
    dlg.InformativeText := AText;
    dlg.WindowTitle     := ATitle;
    dlg.FDefaultButton  := ADefaultButton;
    dlg.PrepareLayout;
    dlg.ShowModal;
  finally
    dlg.Free;
  end;
end;

class function TfpgMessageDialog.Question(const ATitle: string;
  const AText: string; AButtons: TfpgMsgDlgButtons;
  ADefaultButton: TfpgMsgDlgBtn): TfpgMsgDlgBtn;
var
  dlg: TfpgMessageDialog;
begin
  dlg := TfpgMessageDialog.Create(nil);
  try
    dlg.FDialogType     := mtConfirmation;
    dlg.FButtons        := AButtons;
    dlg.Text            := ATitle;
    dlg.InformativeText := AText;
    dlg.WindowTitle     := ATitle;
    dlg.FDefaultButton  := ADefaultButton;
    dlg.PrepareLayout;
    Result := TfpgMsgDlgBtn(dlg.ShowModal);
  finally
    dlg.Free;
  end;
end;

class function TfpgMessageDialog.Warning(const ATitle: string;
  const AText: string; AButtons: TfpgMsgDlgButtons;
  ADefaultButton: TfpgMsgDlgBtn): TfpgMsgDlgBtn;
var
  dlg: TfpgMessageDialog;
begin
  dlg := TfpgMessageDialog.Create(nil);
  try
    dlg.FDialogType     := mtWarning;
    dlg.FButtons        := AButtons;
    dlg.Text            := ATitle;
    dlg.InformativeText := AText;
    dlg.WindowTitle     := ATitle;
    dlg.FDefaultButton  := ADefaultButton;
    dlg.PrepareLayout;
    Result := TfpgMsgDlgBtn(dlg.ShowModal);
  finally
    dlg.Free;
  end;
end;

procedure TfpgMessageDialog.AfterCreate;
begin
  {@VFD_BODY_BEGIN: fpgMessageDialog}
  Name := 'fpgMessageDialog';
  WindowTitle := rsMessage;
  Sizeable  := False;
  Width     := 500;
  Height    := 400;
  MinWidth  := 300;
  MinHeight := 160;
  WindowPosition := wpScreenCenter;

  lblName1 := TfpgLabel.Create(self);
  with lblName1 do
  begin
    Name := 'lblName1';
    SetPosition(116, 20, 312, Font.Height);
    Text := '';
    FontDesc := '#Label2';
  end;

  pnlIcon := TfpgBevel.Create(self);
  with pnlIcon do
  begin
    Name := 'pnlIcon';
    SetPosition(12, 12, 80, 80);
    Shape := bsSpacer;
    OnPaint := @pnlIconPaint;
  end;

  {@VFD_BODY_END: fpgMessageDialog}
end;

{$ENDIF read_implementation}