Context Navigation

source: trunk/Components/ACLDialogs.pas@ 369

Last change on this file since 369 was 253, checked in by RBRi, 18 years ago
small optimization
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}
[253]	87	CharUtilsUnit,
	88	DebugUnit;
[15]	89
	90	// -------------------------------------------------
	91
	92	Function DoACLDialog( const Caption: string;
	93	const Message: string;
	94	const List: TStrings;
	95	const ShowCancel: boolean;
	96	const IconType: TMessageIconType;
	97	const ShowHelp: boolean;
	98	const UseYesNo: boolean;
	99	const ListHelpCallBack: TListHelpCallBack ): TModalResult;
	100	var
	101	TheDialog: TMessageForm;
	102	PMessage: PChar;
	103	Begin
	104	TheDialog := TMessageForm.Create( nil );
	105	TheDialog.Caption := Caption;
[210]	106	PMessage := NewPCharAsCopyOfStr(Message);
[15]	107	TheDialog.TheText := PMessage;
	108
	109	TheDialog.ShowCancel := ShowCancel;
	110	TheDialog.IconType := IconType;
	111	TheDialog.ShowHelp := ShowHelp;
	112	TheDialog.UseYesNo := UseYesNo;
	113	TheDialog.ListHelpCallBack := ListHelpCallBack;
	114
	115	if List <> nil then
	116	begin
	117	TheDialog.ShowList := true;
	118	TheDialog.ListBox.Items.Assign( List );
	119	end
	120	else
	121	begin
	122	TheDialog.ShowList := false;
	123	end;
	124
	125	Result := TheDialog.ShowModal;
	126
	127	TheDialog.Destroy;
	128	StrDispose( PMessage );
	129	end;
	130
	131	Procedure DoMessageListDlg( Caption: string;
	132	Message: string;
	133	List: TStrings );
	134	Begin
	135	DoACLDialog( Caption,
	136	Message,
	137	List,
	138	false, // show cancel
	139	mitInfo,
	140	false, // show help
	141	false, // use yes no
	142	nil
	143	);
	144	End;
	145
	146	Procedure DoMessageListHelpDlg( Caption: string;
	147	Message: string;
	148	List: TStrings;
	149	ListHelpCallback: TListHelpCallback );
	150	Begin
	151	DoACLDialog( Caption,
	152	Message,
	153	List,
	154	false, // show cancel
	155	mitInfo,
	156	true, // show help
	157	false, // use yes no
	158	ListHelpCallBack
	159	);
	160	End;
	161
	162	Function DoConfirmListDlg( Caption: string;
	163	Message: string;
	164	List: TStrings ): boolean;
	165	Begin
	166	Result :=
	167	DoACLDialog( Caption,
	168	Message,
	169	List,
	170	true, // show cancel
	171	mitQuestion,
	172	false, // show help
	173	false, // use yes no
	174	nil // no help callback
	175	) = mrOK;
	176	End;
	177
	178	Function DoConfirmDlg( Caption: string;
	179	Message: string ): boolean;
	180	Begin
	181	Result :=
	182	DoACLDialog( Caption,
	183	Message,
	184	nil, // no list
	185	true, // show cancel
	186	mitQuestion,
	187	false, // show help
	188	false, // use yes no
	189	nil // no help callback
	190	) = mrOK;
	191	End;
	192
	193	Procedure DoLongMessageDlg( Caption: String;
	194	Message: PChar );
	195	Var
	196	TheDialog: TMessageForm;
	197	Begin
	198	TheDialog := TMessageForm.Create( nil );
	199	TheDialog.Caption := Caption;
	200	TheDialog.TheText := Message;
	201
	202	TheDialog.ShowList := false;
	203	TheDialog.ShowCancel := false;
	204	TheDialog.IconType := mitInfo;
	205	TheDialog.ShowHelp := false;
	206	TheDialog.UseYesNo := false;
	207
	208	TheDialog.ShowModal;
	209	TheDialog.Destroy;
	210	End;
	211
	212	Procedure DoMessageDlg( Caption: String;
	213	Message: string );
	214	Begin
	215	DoACLDialog( Caption,
	216	Message,
	217	nil, // no list
	218	false, // show cancel
	219	mitInfo,
	220	false, // show help
	221	false, // use yes no
	222	nil // no help callback
	223	);
	224	End;
	225
	226	Procedure DoErrorListDlg( Caption: string;
	227	Message: string;
	228	List: TStrings );
	229	Begin
	230	DoACLDialog( Caption,
	231	Message,
	232	List,
	233	false, // show cancel
	234	mitError,
	235	false, // show help
	236	false, // use yes no
	237	nil // no help callback
	238	);
	239	End;
	240
	241	Procedure DoErrorDlg( Caption: String;
	242	Message: string );
	243	Begin
	244	DoACLDialog( Caption,
	245	Message,
	246	nil, // no list
	247	false, // show cancel
	248	mitError,
	249	false, // show help
	250	false, // use yes no
	251	nil // no help callback
	252	);
	253	End;
	254
	255	Procedure DoWarningDlg( Caption: String;
	256	Message: string );
	257	begin
	258	DoACLDialog( Caption,
	259	Message,
	260	nil, // no list
	261	false, // show cancel
	262	mitWarning,
	263	false, // show help
	264	false, // use yes no
	265	nil // no help callback
	266	);
	267	end;
	268
	269	Function DoYesNoListDlg( Caption: string;
	270	Message: string;
	271	List: TStrings ): boolean;
	272	Begin
	273	Result :=
	274	DoACLDialog( Caption,
	275	Message,
	276	List,
	277	true, // show "cancel" (=no)
	278	mitQuestion,
	279	false, // show help
	280	true, // use yes no
	281	nil // no help callback
	282	) = mrYes;
	283	End;
	284
	285	Function DoYesNoDlg( Caption: string;
	286	Message: string ): boolean;
	287	Begin
	288	Result :=
	289	DoACLDialog( Caption,
	290	Message,
	291	nil, // no list
	292	true, // show "cancel" (=no)
	293	mitQuestion,
	294	false, // show help
	295	true, // use yes no
	296	nil // no help callback
	297	) = mrYes;
	298	End;
	299
	300	{$ifdef os2}
	301
	302	var
	303	OKButtonCaption: string;
	304	CancelButtonCaption: string;
	305
[226]	306	Procedure OnLanguageEvent(Language: TLanguageFile; const Apply: boolean);
	307	var
	308	tmpPrefix : String;
[15]	309	begin
[226]	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
[253]	383	begin
[15]	384	QueryDlg := TACLQueryDialog.Create( Screen.ActiveForm );
[253]	385	end;
[15]	386
	387	QueryDlg.Caption := ACaption;
	388	QueryDlg.FMessageLabel.Caption := APrompt;
	389	QueryDlg.FEdit.Text := Value;
	390
	391	QueryDlg.Execute;
	392	Case QueryDlg.ModalResult Of
	393	cmOk:
	394	Begin
	395	Value := QueryDlg.FEdit.Text;
	396	Result := True;
	397	End;
	398
	399	Else
	400	Begin
	401	Result := False;
	402	End;
	403	End; {Case}
	404
	405	End;
	406
	407	{$endif}
	408
	409	{$ifdef os2}
	410	Initialization
	411	RegisterProcForLanguages( OnLanguageEvent );
	412
	413	// load our defaults in case the app using us doesn't know about languages
	414	OnLanguageEvent( nil, true );
	415
	416	Finalization
	417
	418	// I think application .Destroy will do this.
	419	// if QueryDlg <> nil then
	420	// QueryDlg.Destroy;
	421
	422	{$endif}
	423
	424	End.

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

Download in other formats: