unit ads_Dialogs;
{Copyright(c)2016 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
dickmaley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to dickmaley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
}
(*UnitIndex Master Index Implementation Section Download UnitsDescription: ads_Dialogs.pas This unit contains the following routines.
Dialog_List DialogLookupList DlgLookup_ads Msg_Dlg RaiseError TForm1.Button1Click
*)
interface
Uses Forms, extctrls, Buttons, StdCtrls, Controls, SysUtils, Graphics,
Dialogs, Classes;
Function DlgLookup_ads(
out sgReturn : String;
out sgDisplay : String;
sgCaption : String;
sgDisplayList : String;
sgReturnList : String;
sgDefaultDisplay : String;
inHeight : Integer;
inWidth : Integer
): Boolean;
{!~
Dialog_List
Presents a list dialog. Returns a string with the selected
values. The return string is equivalent to the text property
of TStrings. If multiselect is enabled then the return
string can contain multiple values, otherwise a single value.
If the user presses cancel then the original list of Selected
items is returned, otherwise the newly selected items are
returned.
sgCaption : Dialog caption.
sgDisplayList : List of items to display as a string.
Text property of TStrings.
sgReturnList : List of items to return as a string.
Text property of TStrings. The
Display and Return lists can be the
same or different.
sgSelectedList : List of items that appear selected.
The list is passed to this function
as a string. The string is the same
as the Text property of TStrings.
boMultiSelect : A Boolean that controls whether
multiselect is allowed or not.
inHeight : An Integer that sets the height of the
dialog window.
inWidth : An Integer that sets the width of the
dialog window.
}
Function Dialog_List(
sgCaption : String;
sgDisplayList : String;
sgReturnList : String;
sgSelectedList : String;
boMultiSelect : Boolean;
inHeight : Integer;
inWidth : Integer
): String;
{!~
DialogLookupList
Presents a Lookup dialog. Returns True if the user selects
an item and presses OK, otherwise False is returned. If
True is returned then the ItemValue argument is set to the
string value of the selected item and the ItemIndex argument
is set to the ItemIndex in the Text StringList. This is a
simple selection dialog, if more advanced features are
required then use the Dialog_List function which offers
much more control.
Text : A string that is equivalent to the Text property
in a TStringList. This string contains all of the
items to be displayed in the Lookup list.
var ItemValue : The default value to be displayed in the list. This
is also used to return the item selected.
var ItemIndex : The itemIndex of the default value. This is also
used to return the ItemIndex of the value selected.
Title : A string that contains the caption of the Lookup
dialog.
}
Function DialogLookupList(
Text : String;
var ItemValue : String;
var ItemIndex : Integer;
Title : String): Boolean;
{!~
Msg_Dlg
This Message Dialog is exactly the same as MessageDlg provided in the delphi
VCL except that there is one more parameter at the end for the dafault button.
example:
procedure TForm1.Button1Click(Sender: TObject);
begin
If Msg_Dlg(
'This is my message',
mtInformation,
[mbYes,mbNo],
1,
mbNo) = mrYes Then
Begin
ShowMessage('Yes');
End
Else
Begin
ShowMessage('No');
End;
end;
}
function Msg_Dlg(
const Msg : String;
DlgType : TMsgDlgType;
Buttons : TMsgDlgButtons;
HelpCtx : Longint;
DefaultButton : TMsgDlgBtn
) : Integer;
implementation
Uses ads_Strg;
const
UnitName = 'ads_Dialogs';
RaiseErrors = True;
Var
ProcName : String;
//Unit Description UnitIndex Master Index
Procedure RaiseError(UnitName,ProcName:String;E : Exception);
Begin
If RaiseErrors Then Raise Exception.Create(UnitName+'.'+Procname+' error: '+E.Message);
End;
{!~
DialogLookupList
Presents a Lookup dialog. Returns True if the user selects
an item and presses OK, otherwise False is returned. If
True is returned then the ItemValue argument is set to the
string value of the selected item and the ItemIndex argument
is set to the ItemIndex in the Text StringList. This is a
simple selection dialog, if more advanced features are
required then use the Dialog_List function which offers
much more control.
Text : A string that is equivalent to the Text property
in a TStringList. This string contains all of the
items to be displayed in the Lookup list.
var ItemValue : The default value to be displayed in the list. This
is also used to return the item selected.
var ItemIndex : The itemIndex of the default value. This is also
used to return the ItemIndex of the value selected.
Title : A string that contains the caption of the Lookup
dialog.
}
//Unit Description UnitIndex Master Index
Function DialogLookupList(
Text : String;
var ItemValue : String;
var ItemIndex : Integer;
Title : String): Boolean;
Var
frm : TForm;
pnlTop : TPanel;
pnlBottom : TPanel;
pnlButtons : TPanel;
lst : TListBox;
btnOk : TBitBtn;
btnCancel : TBitBtn;
inCounter : Integer;
inColEndPad: Integer;
inWidth : Integer;
inWidthMax : Integer;
inItemValue: Integer;
lab : TLabel;
ProcName : String;
begin
Result := False;
ProcName := 'DialogLookupList'; Try
frm := TForm .Create(nil);
pnlTop := TPanel .Create(nil);
pnlBottom := TPanel .Create(nil);
pnlButtons:= TPanel .Create(nil);
lst := TListBox.Create(nil);
btnOk := TBitBtn .Create(nil);
btnCancel := TBitBtn .Create(nil);
lab := TLabel .Create(nil);
Try
With frm Do
Begin
Caption := Title;
Position := poScreenCenter;
BorderIcons := [];
BorderStyle := bsDialog;
End;
inColEndPad := 3;
With pnlTop Do
Begin
Parent := frm;
Caption := ' ';
BorderStyle := bsNone;
BevelOuter := bvNone;
BevelInner := bvNone;
BorderWidth := 5;
Align := alClient;
TabOrder := 0;
End;
With lst Do
Begin
Parent := pnlTop;
BorderStyle := bsSingle;
Align := alClient;
Items .Clear;
Hint := 'Click an item to select it.';
ShowHint := True;
End;
With lab Do
Begin
Parent := lst;
Align := alNone;
Anchors := [akLeft,akTop];
AutoSize := True;
Caption := '';
Height := 13;
Hint := '';
LayOut := tlTop;
Left := 0;
ShowHint := False;
Top := 0;
Visible := True;
WordWrap := False;
End;
lst.Items.SetText(PChar(Text));
If lst.Items.Count = 0 Then
Begin
ItemValue := '';
ItemIndex := -1;
Exit;
End;
ItemValue := ItemValue;
If ItemIndex < 0 Then ItemIndex := -1;
If ItemIndex > (lst.Items.Count - 1) Then ItemIndex := -1;
inItemValue := lst.Items.IndexOf(ItemValue);
If inItemValue <> -1 Then
Begin
lst.ItemIndex := inItemValue;
End
Else
Begin
If ItemIndex <> -1 Then
Begin
lst.ItemIndex := ItemIndex;
End
Else
Begin
lst.ItemIndex := 0;
End;
End;
lst.Selected[lst.ItemIndex];
ItemValue := lst.Items[lst.ItemIndex];
ItemIndex := lst.ItemIndex;
inWidthMax := 165;
//Make sure that the title can be completely viewed
lab.Font := frm.Font;
lab.Caption := Title;
inWidth := lab.Width;
If inWidth > inWidthMax Then inWidthMax := inWidth;
lab.Font := lst.Font;
//Make sure that all list items can be completely viewed
For inCounter := 0 To lst.Items.Count - 1 Do
Begin
lab.Caption := lst.Items[inCounter];
inWidth := lab.Width;
If inWidth > inWidthMax Then
Begin
inWidthMax := inWidth;
lst.ItemHeight := lab.Height;
End;
End;
If inWidthMax > 165 Then inWidthMax := inWidthMax + 12;
frm.Width := inWidthMax+inColEndPad+10;
If frm.Width < 185 Then frm.Width := 185;
If frm.Width > Screen.Width Then frm.Width := Screen.Width;
frm.Height :=
26+ //Control Bar
35+ //Buttons Panel
10+ //pnlTop BorderWidth
(lst.Items.Count*lst.ItemHeight)+
10;
If frm.Height > Screen.Height Then frm.Height := Screen.Height;
With pnlBottom Do
Begin
Parent := frm;
Caption := ' ';
BorderStyle := bsNone;
BevelOuter := bvNone;
BevelInner := bvNone;
BorderWidth := 5;
Height := 35;
Align := alBottom;
TabOrder := 1;
End;
With pnlButtons Do
Begin
Parent := pnlBottom;
Align := alNone;
BevelInner := bvNone;
BevelOuter := bvNone;
BorderStyle := bsNone;
BorderWidth := 0;
Caption := ' ';
Height := 35;
Left := (pnlBottom.Width - pnlButtons.Width) div 2;
TabOrder := 0;
Top := 0;
Width := 155;
End;
With btnOk Do
Begin
Parent := pnlButtons;
Align := alNone;
Anchors := [akTop,akLeft];
Default := True;
Hint := 'Select the current item.';
Kind := bkOk;
Left := 0;
ShowHint := True;
TabOrder := 0;
Top := 5;
Width := 75;
End;
With btnCancel Do
Begin
Parent := pnlButtons;
Align := alNone;
Anchors := [akTop,akLeft];
Default := False;
Hint := 'Cancel all changes.';
Kind := bkCancel;
Left := 80;
ShowHint := True;
TabOrder := 1;
Top := 5;
Width := 75;
End;
lst.Focused;
pnlBottom.Align := alNone;
pnlBottom.Align := alBottom;
pnlButtons.Left := (pnlBottom.Width - pnlButtons.Width) div 2;
lab.Visible := False;
If frm.ShowModal = mrOK Then
Begin
ItemValue := lst.Items[lst.ItemIndex];
ItemIndex := lst.ItemIndex;
Result := True;
End;
Finally
btnOk .Free;
btnCancel .Free;
pnlButtons.Free;
pnlBottom .Free;
lab .Free;
lst .Free;
pnlTop .Free;
frm .Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
{!~
Dialog_List
Presents a list dialog. Returns a string with the selected
values. The return string is equivalent to the text property
of TStrings. If multiselect is enabled then the return
string can contain multiple values, otherwise a single value.
If the user presses cancel then the original list of Selected
items is returned, otherwise the newly selected items are
returned.
sgCaption : Dialog caption.
sgDisplayList : List of items to display as a string.
Text property of TStrings.
sgReturnList : List of items to return as a string.
Text property of TStrings. The
Display and Return lists can be the
same or different.
sgSelectedList : List of items that appear selected.
The list is passed to this function
as a string. The string is the same
as the Text property of TStrings.
boMultiSelect : A Boolean that controls whether
multiselect is allowed or not.
inHeight : An Integer that sets the height of the
dialog window.
inWidth : An Integer that sets the width of the
dialog window.
}
//Unit Description UnitIndex Master Index
Function Dialog_List(
sgCaption : String;
sgDisplayList : String;
sgReturnList : String;
sgSelectedList : String;
boMultiSelect : Boolean;
inHeight : Integer;
inWidth : Integer
): String;
Var
ProcName : String;
begin
Result := '';
ProcName := 'DialogList'; Try
Result :=
ads_Strg.DialogList(
sgCaption , //sgCaption : String;
sgDisplayList , //sgDisplayList : String;
sgReturnList , //sgReturnList : String;
sgSelectedList , //sgSelectedList : String;
boMultiSelect , //boMultiSelect : Boolean;
inHeight , //inHeight : Integer;
inWidth //inWidth : Integer
); //): String;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
{!~
Msg_Dlg
This Message Dialog is exactly the same as MessageDlg provided in the delphi
VCL except that there is one more parameter at the end for the dafault button.
example:
//Unit Description UnitIndex Master Index
procedure TForm1.Button1Click(Sender: TObject);
begin
If Msg_Dlg(
'This is my message',
mtInformation,
[mbYes,mbNo],
1,
mbNo) = mrYes Then
Begin
ShowMessage('Yes');
End
Else
Begin
ShowMessage('No');
End;
end;
}
//Unit Description UnitIndex Master Index
function Msg_Dlg(
const Msg : String;
DlgType : TMsgDlgType;
Buttons : TMsgDlgButtons;
HelpCtx : Longint;
DefaultButton : TMsgDlgBtn
) : Integer;
Var
DefResult : TModalResult;
frm_MsgDlg : TForm;
i : Integer;
X : Integer;
Y : Integer;
begin
x := -1;
Y := -1;
DefResult := mrYes;
If DefaultButton = mbYes Then DefResult := mrYes;
If DefaultButton = mbNo Then DefResult := mrNo;
If DefaultButton = mbOK Then DefResult := mrOK;
If DefaultButton = mbCancel Then DefResult := mrCancel;
If DefaultButton = mbAbort Then DefResult := mrAbort;
If DefaultButton = mbRetry Then DefResult := mrRetry;
If DefaultButton = mbIgnore Then DefResult := mrIgnore;
If DefaultButton = mbAll Then DefResult := mrAll;
frm_MsgDlg :=
CreateMessageDialog(Msg,DlgType,Buttons);
Try
With frm_MsgDlg Do
Begin
HelpContext := HelpCtx;
If X >= 0 Then Left := X;
If Y >= 0 Then Top := Y;
If (Y < 0) and (X < 0) then Position := poScreenCenter;
For i := 0 To ControlCount -1 Do
Begin
If Controls[i] is TButton Then
Begin
If TButton(Controls[i]).ModalResult = DefResult Then
Begin
TButton(Controls[i]).Default := True;
ActiveControl := TButton(Controls[i]);
End
Else
Begin
TButton(Controls[i]).Default := False;
End;
End;
End;
result := frm_MsgDlg.ShowModal;
End;
Finally
frm_MsgDlg.Free;
End;
end;
//Unit Description UnitIndex Master Index
Function DlgLookup_ads(
out sgReturn : String;
out sgDisplay : String;
sgCaption : String;
sgDisplayList : String;
sgReturnList : String;
sgDefaultDisplay : String;
inHeight : Integer;
inWidth : Integer
): Boolean;
Var
boMultiSelect : Boolean;
sgResult : String;
sgReturnBefore : String;
sgDisplayBefore : String;
sgReturnAfter : String;
sgDisplayAfter : String;
lstDisplayList : TStringList;
lstReturnList : TStringList;
inIndexBefore : Integer;
inIndexAfter : Integer;
Begin
Result := False;
ProcName := 'DlgLookup_ads'; Try
boMultiSelect := False;
lstDisplayList := TStringList.Create();
lstReturnList := TStringList.Create();
Try
lstDisplayList.SetText(PChar(sgDisplayList));
lstReturnList .SetText(PChar(sgReturnList));
inIndexBefore := lstDisplayList.IndexOf(sgDefaultDisplay);
If inIndexBefore <> -1 Then
Begin
sgDisplayBefore := lstDisplayList[inIndexBefore];
sgReturnBefore := lstReturnList [inIndexBefore];
End
Else
Begin
sgDisplayBefore := '';
sgReturnBefore := '';
End;
sgResult :=
Dialog_List(
sgCaption , //sgCaption : String;
sgDisplayList , //sgDisplayList : String;
sgReturnList , //sgReturnList : String;
sgDefaultDisplay, //sgSelectedList : String;
boMultiSelect , // boMultiSelect : Boolean;
inHeight , //inHeight : Integer;
inWidth //inWidth : Integer
);//): String;
inIndexAfter := lstReturnList.IndexOf(sgResult);
If inIndexAfter <> -1 Then
Begin
sgDisplayAfter := lstDisplayList[inIndexAfter];
sgReturnAfter := lstReturnList [inIndexAfter];
End
Else
Begin
sgDisplayAfter := '';
sgReturnAfter := '';
End;
If inIndexBefore = inIndexAfter Then
Begin
Result := False;
sgReturn := sgReturnBefore;
sgDisplay := sgDisplayBefore;
End
Else
Begin
Result := True;
sgReturn := sgReturnAfter;
sgDisplay := sgDisplayAfter;
End;
Finally
lstDisplayList .Free;
lstReturnList .Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Initialization
ProcName := 'Unknown';
end.
//