Context Navigation

source: trunk/Components/ACLDialogs.pas@ 226

Last change on this file since 226 was 226, checked in by RBRi, 18 years ago
refactoring unused things removed, unit tests written, save translations improved
Property svn:eol-style set to `native`
File size: 10.6 KB

Rev	Line
[15]	1	Unit ACLDialogs;
	2	// A variety of useful message box functions, including displaying
	3	// lists. They all allow specification of a caption.
	4
	5	Interface
	6
	7	Uses
	8	Classes,
	9	{$ifdef os2}
	10	ACLMessageForm
	11	{$else}
	12	Controls,
	13	MessageFormWin
	14	{$endif}
	15	;
	16
	17	// Shows a message box
	18	Procedure DoMessageDlg( Caption: String;
	19	Message: string );
	20
	21	// Shows an error message box
	22	Procedure DoErrorDlg( Caption: String;
	23	Message: string );
	24
	25	// Shows a warning message box
	26	Procedure DoWarningDlg( Caption: String;
	27	Message: string );
	28
	29	// Shows a long message box
	30	Procedure DoLongMessageDlg( Caption: String;
	31	Message: PChar );
	32
	33	// Shows a dialog with OK and cancel buttons
	34	// Returns true if OK pressed
	35	Function DoConfirmDlg( Caption: string;
	36	Message: string ): boolean;
	37
	38	// Returns true if confirmation given.
	39	Function DoConfirmListDlg( Caption: string;
	40	Message: string;
	41	List: TStrings ): boolean;
	42
	43	// Shows a message containing a list
	44	Procedure DoMessageListDlg( Caption: string;
	45	Message: string;
	46	List: TStrings );
	47
	48	// Shows an error message containing a list
	49	Procedure DoErrorListDlg( Caption: string;
	50	Message: string;
	51	List: TStrings );
	52
	53	// Returns true if yes is clicked
	54	Function DoYesNoListDlg( Caption: string;
	55	Message: string;
	56	List: TStrings ): boolean;
	57
	58	// Returns true if yes is clicked
	59	Function DoYesNoDlg( Caption: string;
	60	Message: string ): boolean;
	61
	62	// Shows a message containing a list
	63	// with a help callback for items in the list
	64	Procedure DoMessageListHelpDlg( Caption: string;
	65	Message: string;
	66	List: TStrings;
	67	ListHelpCallback: TListHelpCallback );
	68
	69	{$ifdef os2}
	70	Function DoInputQuery( Const ACaption: String;
	71	Const APrompt: String;
	72	Var Value: String ): Boolean;
	73
	74	{$endif}
	75
	76	Implementation
	77
	78	uses
	79	SysUtils,
[210]	80	Forms,
	81	Dialogs,
	82	StdCtrls,
	83	Buttons,
[15]	84	{$ifdef os2}
[210]	85	ACLLanguageUnit, ControlsUtility,
[15]	86	{$endif}
[210]	87	CharUtilsUnit;
[15]	88
	89	// -------------------------------------------------
	90
	91	Function DoACLDialog( const Caption: string;
	92	const Message: string;
	93	const List: TStrings;
	94	const ShowCancel: boolean;
	95	const IconType: TMessageIconType;
	96	const ShowHelp: boolean;
	97	const UseYesNo: boolean;
	98	const ListHelpCallBack: TListHelpCallBack ): TModalResult;
	99	var
	100	TheDialog: TMessageForm;
	101	PMessage: PChar;
	102	Begin
	103	TheDialog := TMessageForm.Create( nil );
	104	TheDialog.Caption := Caption;
[210]	105	PMessage := NewPCharAsCopyOfStr(Message);
[15]	106	TheDialog.TheText := PMessage;
	107
	108	TheDialog.ShowCancel := ShowCancel;
	109	TheDialog.IconType := IconType;
	110	TheDialog.ShowHelp := ShowHelp;
	111	TheDialog.UseYesNo := UseYesNo;
	112	TheDialog.ListHelpCallBack := ListHelpCallBack;
	113
	114	if List <> nil then
	115	begin
	116	TheDialog.ShowList := true;
	117	TheDialog.ListBox.Items.Assign( List );
	118	end
	119	else
	120	begin
	121	TheDialog.ShowList := false;
	122	end;
	123
	124	Result := TheDialog.ShowModal;
	125
	126	TheDialog.Destroy;
	127	StrDispose( PMessage );
	128	end;
	129
	130	Procedure DoMessageListDlg( Caption: string;
	131	Message: string;
	132	List: TStrings );
	133	Begin
	134	DoACLDialog( Caption,
	135	Message,
	136	List,
	137	false, // show cancel
	138	mitInfo,
	139	false, // show help
	140	false, // use yes no
	141	nil
	142	);
	143	End;
	144
	145	Procedure DoMessageListHelpDlg( Caption: string;
	146	Message: string;
	147	List: TStrings;
	148	ListHelpCallback: TListHelpCallback );
	149	Begin
	150	DoACLDialog( Caption,
	151	Message,
	152	List,
	153	false, // show cancel
	154	mitInfo,
	155	true, // show help
	156	false, // use yes no
	157	ListHelpCallBack
	158	);
	159	End;
	160
	161	Function DoConfirmListDlg( Caption: string;
	162	Message: string;
	163	List: TStrings ): boolean;
	164	Begin
	165	Result :=
	166	DoACLDialog( Caption,
	167	Message,
	168	List,
	169	true, // show cancel
	170	mitQuestion,
	171	false, // show help
	172	false, // use yes no
	173	nil // no help callback
	174	) = mrOK;
	175	End;
	176
	177	Function DoConfirmDlg( Caption: string;
	178	Message: string ): boolean;
	179	Begin
	180	Result :=
	181	DoACLDialog( Caption,
	182	Message,
	183	nil, // no list
	184	true, // show cancel
	185	mitQuestion,
	186	false, // show help
	187	false, // use yes no
	188	nil // no help callback
	189	) = mrOK;
	190	End;
	191
	192	Procedure DoLongMessageDlg( Caption: String;
	193	Message: PChar );
	194	Var
	195	TheDialog: TMessageForm;
	196	Begin
	197	TheDialog := TMessageForm.Create( nil );
	198	TheDialog.Caption := Caption;
	199	TheDialog.TheText := Message;
	200
	201	TheDialog.ShowList := false;
	202	TheDialog.ShowCancel := false;
	203	TheDialog.IconType := mitInfo;
	204	TheDialog.ShowHelp := false;
	205	TheDialog.UseYesNo := false;
	206
	207	TheDialog.ShowModal;
	208	TheDialog.Destroy;
	209	End;
	210
	211	Procedure DoMessageDlg( Caption: String;
	212	Message: string );
	213	Begin
	214	DoACLDialog( Caption,
	215	Message,
	216	nil, // no list
	217	false, // show cancel
	218	mitInfo,
	219	false, // show help
	220	false, // use yes no
	221	nil // no help callback
	222	);
	223	End;
	224
	225	Procedure DoErrorListDlg( Caption: string;
	226	Message: string;
	227	List: TStrings );
	228	Begin
	229	DoACLDialog( Caption,
	230	Message,
	231	List,
	232	false, // show cancel
	233	mitError,
	234	false, // show help
	235	false, // use yes no
	236	nil // no help callback
	237	);
	238	End;
	239
	240	Procedure DoErrorDlg( Caption: String;
	241	Message: string );
	242	Begin
	243	DoACLDialog( Caption,
	244	Message,
	245	nil, // no list
	246	false, // show cancel
	247	mitError,
	248	false, // show help
	249	false, // use yes no
	250	nil // no help callback
	251	);
	252	End;
	253
	254	Procedure DoWarningDlg( Caption: String;
	255	Message: string );
	256	begin
	257	DoACLDialog( Caption,
	258	Message,
	259	nil, // no list
	260	false, // show cancel
	261	mitWarning,
	262	false, // show help
	263	false, // use yes no
	264	nil // no help callback
	265	);
	266	end;
	267
	268	Function DoYesNoListDlg( Caption: string;
	269	Message: string;
	270	List: TStrings ): boolean;
	271	Begin
	272	Result :=
	273	DoACLDialog( Caption,
	274	Message,
	275	List,
	276	true, // show "cancel" (=no)
	277	mitQuestion,
	278	false, // show help
	279	true, // use yes no
	280	nil // no help callback
	281	) = mrYes;
	282	End;
	283
	284	Function DoYesNoDlg( Caption: string;
	285	Message: string ): boolean;
	286	Begin
	287	Result :=
	288	DoACLDialog( Caption,
	289	Message,
	290	nil, // no list
	291	true, // show "cancel" (=no)
	292	mitQuestion,
	293	false, // show help
	294	true, // use yes no
	295	nil // no help callback
	296	) = mrYes;
	297	End;
	298
	299	{$ifdef os2}
	300
	301	var
	302	OKButtonCaption: string;
	303	CancelButtonCaption: string;
	304
[226]	305	Procedure OnLanguageEvent(Language: TLanguageFile; const Apply: boolean);
	306	var
	307	tmpPrefix : String;
[15]	308	begin
[226]	309	tmpPrefix := '';
	310	if Language = nil then
	311	begin
	312	OKButtonCaption := '~OK';
	313	CancelButtonCaption :='~Cancel';
	314	end
	315	else
	316	begin
	317	tmpPrefix := 'TextInputForm' + LANGUAGE_LABEL_DELIMITER; // use messageform captions
	318	Language.LL(Apply, OKButtonCaption, tmpPrefix + 'OKButtonCaption', '~OK');
	319	Language.LL(Apply, CancelButtonCaption, tmpPrefix + 'CancelButtonCaption', '~Cancel');
	320	end;
[15]	321	end;
	322
	323	type
	324	TACLQueryDialog = class( TDialog )
	325	FEdit: TEdit;
	326	FMessageLabel: TLabel;
	327	FOKButton: TButton;
	328	FCancelButton: TButton;
	329	procedure SetupComponent; override;
	330	procedure SetupShow; override;
	331	end;
	332
	333	procedure TACLQueryDialog.SetupComponent;
	334	begin
	335	inherited SetupComponent;
	336
	337	Name := 'TextInputForm';
	338
	339	ClientWidth := 340;
	340	ClientHeight := 120;
	341
	342	FMessageLabel := InsertLabel( self, 10, 90, 320, 20, '' );
	343
	344	FEdit := TEdit.Create( self );
	345	FEdit.SetWindowPos( 10, 60, 320, 20 );
	346	FEdit.parent := self;
	347	FEdit.TabOrder := 0;
	348	FEdit.AutoSize := true;
	349
	350	FOKButton := InsertButton( self, 10, 10, 90, 30, OKButtonCaption, '' );
	351	FOKButton.Name := 'OKButton';
	352	FOKButton.ModalResult := mrOK;
	353	FOKButton.Default := true;
	354	FOKButton.TabOrder := 1;
	355
	356	FCancelButton := InsertButton( self, 120, 10, 90, 30, CancelButtonCaption, '' );
	357	FCancelButton.Name := 'CancelButon';
	358	FCancelButton.ModalResult := mrCancel;
	359	FCancelButton.Cancel := true;
	360	FCancelButton.TabOrder := 2;
	361
	362	end;
	363
	364	procedure TACLQueryDialog.SetupShow;
	365	begin
	366	ScaleForm( self, 11, 16 );
	367	FOKButton.Default := true;
	368	FEdit.Focus;
	369	end;
	370
	371	Var
	372	QueryDlg: TACLQueryDialog;
	373
	374	// This is a copy of InputQuery from SPCC with the following changes:
	375	// - slight layout mods
	376	// - normal buttons instead of bitmap buttons
	377	// - buttons are centered like my other popup dialogs
	378	Function DoInputQuery( Const ACaption: String;
	379	Const APrompt: String;
	380	Var Value: String ): Boolean;
	381	Begin
	382	if QueryDlg = nil then
	383	QueryDlg := TACLQueryDialog.Create( Screen.ActiveForm );
	384
	385	QueryDlg.Caption := ACaption;
	386	QueryDlg.FMessageLabel.Caption := APrompt;
	387	QueryDlg.FEdit.Text := Value;
	388
	389	QueryDlg.Execute;
	390	Case QueryDlg.ModalResult Of
	391	cmOk:
	392	Begin
	393	Value := QueryDlg.FEdit.Text;
	394	Result := True;
	395	End;
	396
	397	Else
	398	Begin
	399	Result := False;
	400	End;
	401	End; {Case}
	402
	403	End;
	404
	405	{$endif}
	406
	407	{$ifdef os2}
	408	Initialization
	409	RegisterProcForLanguages( OnLanguageEvent );
	410
	411	// load our defaults in case the app using us doesn't know about languages
	412	OnLanguageEvent( nil, true );
	413
	414	Finalization
	415
	416	// I think application .Destroy will do this.
	417	// if QueryDlg <> nil then
	418	// QueryDlg.Destroy;
	419
	420	{$endif}
	421
	422	End.

Note: See TracBrowser for help on using the repository browser.

Download in other formats: