From: csi063@coventry.ac.uk (Simon Love)
Newsgroups: comp.lang.pascal
Subject: [DELPHI] - MDGDLG3D CODE
Date: 11 Apr 1995 14:36:04 +0100
Organization: Coventry University

As mentioned earlier, I have written some code for delphi for those people who
want to be able to have 3D dialogues that allow you to set the caption and body
text using the String variable type.

Basically this is an implementation of the Paradox Dialogue functions. 100% 
compatible.  Return codes are in string format eg.

var
	Answer : String;
begin

	Answer := msgQuestion('Exit Application','Do you want to exit ?';

	if Answer = 'Yes' then exit;
end;

Hope someone likes it.  Simon - please Mail replies if you use it so I can
decide if it's worth posting any more code !

Simon R. Love

PS. Sorry about the long lines, word wrapping your viewer ... 

------ SOURCE CODE FROM HERE DOWN !!! ----------------

{ CTL3D Message Box / Dialogue Unit   }
{ Delphi Development - Version 1.00   }
{ (C)Copyright 1995, SLA Consultants  }
{ Written by Simon R. Love		    }
{ Date : 04/05/95 : 02:37am		    }

unit MsgDlg3d;

interface

	{ 3D Functions, should be called before project run, in project source file }
	{ CTL3D.DLL is required for the 3D components. }
	procedure	msgInit3D;
	procedure	msgClose3D;

	{ Paradox compatable msgBox type functions }
	procedure	msgInfo(Caption, Text : String);
	function	msgAbortRetryIgnore(Caption, Text : String) : String;
	function	msgQuestion(Caption, Text : String) : String ;
	function	msgRetryCancel(Caption, Text : String) : String ;
	procedure	msgStop(Caption, Text : String);
	function	msgYesNoCancel(Caption, Text : String) : String ;
	procedure	msgbox(Caption, Text : String);

implementation

uses WinTypes, winProcs, forms, SysUtils;	{ All uses checked, all requried }

{ CTL3D DLL Externs }
function Ctl3dRegister(hwind : Hwnd) : Integer; far; external 'CTL3D' name 'CTL3DREGISTER';
function Ctl3dUnRegister(hwind : HWnd) : Integer; far; external 'CTL3D' name 'CTL3DUNREGISTER';
function Ctl3dAutoSubClass(hwind : Hwnd) : Integer; far; external 'CTL3D' name 'CTL3DAUTOSUBCLASS';

{ This procedure should be called before the application.run is called from the project	}
{ source file.  ( Only needed if you want 3D dialogs ) 							}
procedure msgInit3D;
begin
	Ctl3dRegister(Application.Handle);
	Ctl3dAutoSubClass(Application.Handle);
end;

{ This procedure should be called before the application terminates it can be placed at	}
{ the end of the project source file.  ( Only needed if you initialised 3D dialogs ) 	}
procedure msgClose3D;
begin
	Ctl3dUnRegister(Application.Handle);
end;

{ Displays a dialogue box containing a message, three buttons ( Abort, Retry and Ignore)	}
{ returns 'Abort', 'Retry', 'Ignore', 'Cancel' ( for ESC key ) or 'Error' 			}
function msgAbortRetryIgnore(Caption, Text : String) : String ;
var
localCaption : PChar;
localText : PChar;
begin

	localCaption := StrAlloc(Length(Caption)+1);
	StrPCopy(localCaption, Caption);
	localText := StrAlloc(Length(Text)+1);
	StrPCopy(localText, Text);

	case (MessageBox(Application.Handle, localText, localCaption, MB_ABORTRETRYIGNORE)) of
		ID_ABORT	:	msgAbortRetryIgnore := 'Abort';
		ID_RETRY	:	msgAbortRetryIgnore := 'Retry';
		ID_IGNORE	:	msgAbortRetryIgnore := 'Ignore';
		ID_CANCEL	:	msgAbortRetryIgnore := 'Cancel';
	else
		msgAbortRetryIgnore := 'Error';
	end;

	StrDispose(localCaption);
	StrDispose(localText);
end;

{ Displays a dialogue box containing a message, an Infomation Icon and an 'OK' Button	}
{ returns nothing															}
procedure msgInfo(Caption, Text : String);
var
localCaption : PChar;
localText : PChar;
begin

	localCaption := StrAlloc(Length(Caption)+1);
	StrPCopy(localCaption, Caption);
	localText := StrAlloc(Length(Text)+1);
	StrPCopy(localText, Text);

	MessageBox(Application.Handle, localText, localCaption, MB_OK or MB_ICONINFORMATION);

	StrDispose(localCaption);
	StrDispose(localText);
end;

{ Displays a dialogue box containing a message, two buttons ( Yea and No)				}
{ returns 'Yes', 'No', 'Cancel' ( for ESC key ) or 'Error' 						}
function msgQuestion(Caption, Text : String) : String ;
var
localCaption : PChar;
localText : PChar;
begin

	localCaption := StrAlloc(Length(Caption)+1);
	StrPCopy(localCaption, Caption);
	localText := StrAlloc(Length(Text)+1);
	StrPCopy(localText, Text);

	case (MessageBox(Application.Handle, localText, localCaption, MB_YESNO or MB_ICONQUESTION)) of
		ID_YES	:	msgQuestion := 'Yes';
		ID_NO	:	msgQuestion := 'No';
		ID_CANCEL :	msgQuestion := 'Cancel';
	else
		msgQuestion := 'Error';
	end;

	StrDispose(localCaption);
	StrDispose(localText);

end;

{ Displays a dialogue box containing a message, two buttons ( Retry and Cancel)		}
{ returns 'Retry', 'Cancel' ( for button and ESC key ) or 'Error' 					}
function msgRetryCancel(Caption, Text : String) : String ;
var
localCaption : PChar;
localText : PChar;
begin

	localCaption := StrAlloc(Length(Caption)+1);
	StrPCopy(localCaption, Caption);
	localText := StrAlloc(Length(Text)+1);
	StrPCopy(localText, Text);

	case (MessageBox(Application.Handle, localText, localCaption, MB_RETRYCANCEL )) of
		ID_RETRY	:	msgRetryCancel := 'Retry';
		ID_CANCEL :	msgRetryCancel := 'Cancel';
	else
		msgRetryCancel := 'Error';
	end;

	StrDispose(localCaption);
	StrDispose(localText);

end;

{ Displays a dialogue box containing a message, an Stop Icon and an 'OK' Button		}
{ returns nothing															}
procedure msgStop(Caption, Text : String);
var
localCaption : PChar;
localText : PChar;
begin

	localCaption := StrAlloc(Length(Caption)+1);
	StrPCopy(localCaption, Caption);
	localText := StrAlloc(Length(Text)+1);
	StrPCopy(localText, Text);

	MessageBox(Application.Handle, localText, localCaption, MB_OK or MB_ICONSTOP);

	StrDispose(localCaption);
	StrDispose(localText);
end;

{ Displays a dialogue box containing a message and an 'OK' Button					}
{ returns nothing															}
procedure msgbox(Caption, Text : String);
var
localCaption : PChar;
localText : PChar;
begin

	localCaption := StrAlloc(Length(Caption)+1);
	StrPCopy(localCaption, Caption);
	localText := StrAlloc(Length(Text)+1);
	StrPCopy(localText, Text);

	MessageBox(Application.Handle, localText, localCaption, MB_OK);

	StrDispose(localCaption);
	StrDispose(localText);
end;

{ Displays a dialogue box containing a message, three buttons ( Yea, No and Cancel)		}
{ returns 'Yes', 'No', 'Cancel' ( for button and ESC key ) or 'Error' 				}
function msgYesNoCancel(Caption, Text : String) : String ;
var
localCaption : PChar;
localText : PChar;
begin

	localCaption := StrAlloc(Length(Caption)+1);
	StrPCopy(localCaption, Caption);
	localText := StrAlloc(Length(Text)+1);
	StrPCopy(localText, Text);

	case (MessageBox(Application.Handle, localText, localCaption, MB_YESNOCANCEL )) of
		ID_YES	:	msgYesNoCancel := 'Yes';
		ID_NO	:	msgYesNoCancel := 'No';
		ID_CANCEL :	msgYesNoCancel := 'Cancel';
	else
		msgYesNoCancel := 'Error';
	end;

	StrDispose(localCaption);
	StrDispose(localText);
end;

end.
 
