Page 1 of 1
Forum

Welcome to the Tweaking4All community forums!
When participating, please keep the Forum Rules in mind!

Topics for particular software or systems: Start your topic link with the name of the application or system.
For example “MacOS X – Your question“, or “MS Word – Your Tip or Trick“.

Please note that switching to another language when reading a post will not bring you to the same post, in Dutch, as there is no translation for that post!




Share:
Notifications
Clear all

Lazarus, macOS - Show macOS style dialogs ... (CocoaPromptUser, Modal sheet dialog)

1 Posts
1 Users
0 Likes
909 Views
 Hans
(@hans)
Famed Member Admin
Joined: 11 years ago
Posts: 2654
Topic starter  

Some (sloppy) code I threw together when I was playing with "CocoaPromptUser" which shows a macOS correct modal dialog.
The idea was to make an overload for MessageDlg (the last parameter, the form, would be the difference).
(I've also posted my code also in the official Lazarus forum)

The example dialog looks like this:

Maybe it is useful to someone ... 😊 

 

unit Unit1;

{$mode objfpc}{$H+}
{$modeswitch objectivec1}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls
  , CocoaInt, CocoaAll;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

function MessageDlg( aCaption, aMsg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn; const Sender:TForm): TModalResult;
var
  ButtonArrayPtr     : PLongint;            // Pointer to the button array
  ButtonCount        : Integer;             // Number of buttons
  Counter            : integer;
  NSParentWindow     : NSWindow;            // Parent Form that the sheet is attached to
  DlgTypeID          : longint;             // DialogType for conversion from TMsgDlgType
  ButtonIDs          : array of Longint;    // ButtonTypes for conversion from TMsgDlgBtn array
  ButtonPressed      : longint;             // ModalResult which gets converted to TModalResult
  aButton            : TMsgDlgBtn;
  DefaultButtonIndex : integer;
  ReversedButtons    : TMsgDlgButtons;
begin
  // Show regular message dialog if no form assigned or form not showing
  if (not Assigned(Sender)) or (not Sender.Visible) then
    begin
      Result := MessageDlg(aCaption, aMsg, DlgType, Buttons, HelpCtx, DefaultButton, Sender);
      exit;
    end;

  { Convert array of TMsgDlgBtn to idButtonXYZ (See LCLType) and convert default button (TMsgDlgBtn) to index }
  ButtonCount := 0;
  DefaultButtonIndex := -1;
  ReversedButtons := [];
  Result := mrNone;

  if Buttons<>[] then
    begin
      for aButton in Buttons do
        ReversedButtons := [aButton] + ReversedButtons;

      for aButton in ReversedButtons do
        begin
          SetLength(ButtonIDs,ButtonCount+1);

          case aButton of
            mbYes      : ButtonIDs[ButtonCount]:= 4;
            mbNo       : ButtonIDs[ButtonCount]:= 5;
            mbOK       : ButtonIDs[ButtonCount]:= 1;
            mbCancel   : ButtonIDs[ButtonCount]:= 2;
            mbAbort    : ButtonIDs[ButtonCount]:= 7;
            mbRetry    : ButtonIDs[ButtonCount]:= 8;
            mbIgnore   : ButtonIDs[ButtonCount]:= 9;
            mbAll      : ButtonIDs[ButtonCount]:= 10;
            mbNoToAll  : ButtonIDs[ButtonCount]:= 12;
            mbYesToAll : ButtonIDs[ButtonCount]:= 11;
            mbHelp     : ButtonIDs[ButtonCount]:= 3;
            else         ButtonIDs[ButtonCount]:= 6; // mbClose
          end;

          if (aButton=DefaultButton) then
            DefaultButtonIndex := ButtonCount;

          inc(ButtonCount);
        end;
    end;

  if (ButtonCount>0) then
    ButtonArrayPtr:=@{%H-}ButtonIDs[0]{%H+}
  else
    ButtonArrayPtr:=nil;


  { Convert TMsgDlgType to idDialogXYZ (See LCLType) }
  case DlgType of
    mtWarning      : DlgTypeID := $FF +1;
    mtError        : DlgTypeID := $FF +2;
    mtInformation  : DlgTypeID := $FF +3;
    mtConfirmation : DlgTypeID := $FF +4;
    else             DlgTypeID := $FF +5; //mtCustom:
  end;

  NSParentWindow := nil;
  if Assigned(Sender) then
    begin
      if not Sender.HandleAllocated then Exit;
      NSParentWindow := NSView(Sender.Handle).window;
    end
  else
    NSParentWindow := NSApplication.sharedApplication.keyWindow;

  if Assigned(NSParentWindow) then
    begin
      ButtonPressed := CocoaPromptUser(aCaption, aMsg ,DlgTypeID, ButtonArrayPtr, ButtonCount, DefaultButtonIndex, 0, NSParentWindow, true);

      case ButtonPressed of
        1  : Result := mrOK;
        2  : Result := mrCancel;
        //3:   Result := mrHelp  // Help does not return from modal;
        4  : Result := mrYes;
        5  : Result := mrNo;
        6  : Result := mrClose;
        7  : Result := mrAbort;
        8  : Result := mrRetry;
        9  : Result := mrIgnore;
        10 : Result := mrAll;
        11 : Result := mrYesToAll;
        12 : Result := mrNoToAll
        else Result := mrNone;
      end;
    end
  else
    Result := mrNone;
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  MessageDlg('Caption','',mtInformation,[mbYes,mbNo,mbIgnore],0,mbYes,self);
end;

end.

   
ReplyQuote

Like what you see and you'd like to help out? 

The best way to help is of course by assisting others with their questions here in the forum, but you can also help us out in other ways:

- Do your shopping at Amazon, it will not cost you anything extra but may generate a small commission for us,
- send a cup of coffee through PayPal ($5, $10, $20, or custom amount),
- become a Patreon,
- donate BitCoin (BTC), or BitCoinCash (BCH).

Share: