Bu unit program liste dialog işleminde kullanılır.
Kod: Tümünü seç
unit ads_DlgLU;
interface
Function DlgLookup_ads(
out sgStore : String;
out sgDisplay : String;
sgCaption : String;
sgDisplayList : String;
sgStoreList : String;
sgDefaultDisplay : String
): Boolean; Overload;
Function DlgLookup_ads(
out sgReturn : String;
out sgDisplay : String;
sgCaption : String;
sgDisplayList : String;
sgReturnList : String;
sgDefaultDisplay : String;
inHeight : Integer;
inWidth : Integer
): Boolean; Overload;
implementation
Uses
ads_Exception, Forms, ExtCtrls, Buttons, StdCtrls, Classes, Dialogs,
Graphics, Windows, Controls, SysUtils;
Var
UnitName : String;
ProcName : String;
{!~
DialogList
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 DialogList(
sgCaption : String;
sgDisplayList : String;
sgReturnList : String;
sgSelectedList : String;
boMultiSelect : Boolean;
inHeight : Integer;
inWidth : Integer;
out sgDisplay : String;
out sgStore : String
): Boolean;
Var
inSelected : Integer;
inCounter : Integer;
frm : TForm;
pnlBase : TPanel;
pnlButtons : TPanel;
btnOK : TBitBtn;
btnCancel : TBitBtn;
lstReturnList : TListBox;
lstDisplayList : TListBox;
lstSReturnList : TStringList;
lstSDisplayList : TStringList;
lstSelected : TStringList;
lstSelectedExist : TStringList;
Begin
Result := False;
ProcName := 'DialogList'; Try
If inWidth < 180 Then inWidth := 180;
pnlBase := nil;
pnlButtons := nil;
btnOK := nil;
btnCancel := nil;
lstReturnList := nil;
lstDisplayList := nil;
frm := TForm.Create(nil);
lstSReturnList := TStringList.Create();
lstSDisplayList := TStringList.Create();
lstSelected := TStringList.Create();
lstSelectedExist := TStringList.Create();
Try
lstSReturnList .Clear;
lstSDisplayList .Clear;
lstSelected .Clear;
lstSelectedExist .Clear;
lstSReturnList .SetText(PChar(sgReturnList));
lstSDisplayList .SetText(PChar(sgDisplayList));
lstSelected .SetText(PChar(sgSelectedList));
If lstSDisplayList.Count <> lstSReturnList.Count Then
Begin
ShowMessage('DialogList Error: Display and Return lists must be the same size.');
Exit;
End;
With frm Do
Begin
Left := 477;
Top := 327;
BorderIcons := [];
BorderStyle := bsDialog;
Caption := sgCaption;
ClientHeight := inHeight;
ClientWidth := inWidth;
Color := clBtnFace;
Font.Charset := DEFAULT_CHARSET;
Font.Color := clWindowText;
Font.Height := -11;
Font.Name := 'MS Sans Serif';
Font.Style := [];
OldCreateOrder := False;
Position := poScreenCenter;
PixelsPerInch := 96;
ShowHint := True;
End;
pnlBase := TPanel.Create(frm);
With pnlBase Do
Begin
Parent := frm;
Left := 0;
Top := 0;
Width := frm.ClientWidth;
Height := frm.ClientHeight;
Align := alClient;
BevelOuter := bvNone;
BorderWidth := 10;
Caption := ' ';
TabOrder := 0;
End;
pnlButtons := TPanel.Create(frm);
With pnlButtons Do
Begin
Parent := pnlBase;
Left := 10;
Top := 270;
Width := pnlBase.Width - 20;
Height := 43;
Align := alBottom;
BevelOuter := bvNone;
Caption := ' ';
TabOrder := 0;
End;
btnOK := TBitBtn.Create(frm);
With btnOK Do
Begin
Parent := pnlButtons;
Top := 16;
Width := 75;
Height := 25;
Enabled := True;
TabOrder := 0;
Kind := bkOK;
Left := pnlButtons.Width - 160;
Hint := 'Close and return selection.';
End;
btnCancel := TBitBtn.Create(frm);
With btnCancel Do
Begin
Parent := pnlButtons;
Top := 16;
Width := 75;
Height := 25;
TabOrder := 1;
Kind := bkCancel;
Left := pnlButtons.Width - 75;
Hint := 'Close and make no selection.';
End;
lstReturnList := TListBox.Create(frm);
With lstReturnList Do
Begin
Parent := pnlBase;
Left := 10;
Top := 10;
Width := 272;
Height := 260;
Align := alClient;
ItemHeight := 13;
TabOrder := 3;
Items.SetText(PChar(sgReturnList));
End;
lstDisplayList := TListBox.Create(frm);
With lstDisplayList Do
Begin
Parent := pnlBase;
MultiSelect := boMultiSelect;
Left := 10;
Top := 10;
Width := 272;
Height := 260;
Align := alClient;
ItemHeight := 13;
TabOrder := 1;
Items.SetText(PChar(sgDisplayList));
If boMultiSelect Then
Begin
Hint := 'Ctrl-Click multiple items to select them.';
End
Else
Begin
Hint := 'Click an item to select it.';
End;
End;
sgDisplay := '';
sgStore := '';
For inCounter := 0 To lstSelected.Count - 1 Do
Begin
inSelected := lstDisplayList.Items.IndexOf(lstSelected[inCounter]);
If inSelected <> -1 Then
Begin
lstSelectedExist.Add(lstSelected[inCounter]);
If Not boMultiSelect Then
Begin
lstDisplayList.ItemIndex := inSelected;
If sgDisplay = '' Then
sgDisplay := lstDisplayList.Items[inSelected]
Else
sgDisplay := sgDisplay+#13+lstDisplayList.Items[inSelected];
If sgStore = '' Then
sgStore := lstSReturnList[inSelected]
Else
sgStore := sgStore+#13+lstSReturnList[inSelected];
Break;
End
Else
Begin
lstDisplayList.Selected[inSelected] := True;
If sgDisplay = '' Then
sgDisplay := lstDisplayList.Items[inSelected]
Else
sgDisplay := sgDisplay+#13+lstDisplayList.Items[inSelected];
If sgStore = '' Then
sgStore := lstSReturnList[inSelected]
Else
sgStore := sgStore+#13+lstSReturnList[inSelected];
End;
End
End;
If frm.ShowModal = mrOK Then
Begin
sgDisplay := '';
sgStore := '';
Result := True;
lstSReturnList.Clear;
For inCounter := 0 To lstDisplayList.Items.Count - 1 Do
Begin
If lstDisplayList.Selected[inCounter] Then
Begin
lstSReturnList.Add(lstReturnList.Items[inCounter]);
If Not boMultiSelect Then
Begin
sgStore := lstSReturnList[0];
sgDisplay := lstDisplayList.Items[inCounter];
Break;
End
Else
Begin
sgStore := lstSReturnList.Text;
If sgDisplay = '' Then
sgDisplay := lstDisplayList.Items[inCounter]
Else
sgDisplay := sgDisplay+#13+lstDisplayList.Items[inCounter];
End;
End;
End;
End
Else
Begin
Result := False;
End;
Finally
lstDisplayList .Free;
lstReturnList .Free;
btnCancel .Free;
btnOK .Free;
pnlButtons .Free;
pnlBase .Free;
frm.Free;
lstSReturnList .Free;
lstSDisplayList .Free;
lstSelected .Free;
lstSelectedExist .Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
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;
sgReturnBefore : String;
sgDisplayBefore : String;
lstDisplayList : TStringList;
lstReturnList : TStringList;
inIndexBefore : 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;
Result :=
DialogList(
sgCaption , //sgCaption : String;
sgDisplayList , //sgDisplayList : String;
sgReturnList , //sgReturnList : String;
sgDefaultDisplay, //sgSelectedList : String;
boMultiSelect , //boMultiSelect : Boolean;
inHeight , //inHeight : Integer;
inWidth , //inWidth : Integer
sgDisplay , //out sgDisplay : String;
sgReturn //out sgStore : String
);//): Boolean;
Finally
lstDisplayList .Free;
lstReturnList .Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Function DlgLookup_ads(
out sgStore : String;
out sgDisplay : String;
sgCaption : String;
sgDisplayList : String;
sgStoreList : String;
sgDefaultDisplay : String
): Boolean; Overload;
Var
inMax : Integer;
lblLabel : TLabel;
lst : TStringList;
inHeight : Integer;
inWidth : Integer;
inCounter : Integer;
inListHeight : Integer;
Begin
Result := False;
ProcName := 'DlgLookup_ads2'; Try
inWidth := 180;
lblLabel := TLabel.Create(nil);
lst := TStringList.Create();
Try
lst.SetText(PChar(sgDisplayList));
With lblLabel Do
Begin
AutoSize := True;
Font.Charset := DEFAULT_CHARSET;
Font.Color := clWindowText;
Font.Height := -11;
Font.Name := 'MS Sans Serif';
Font.Style := [];
End;
inMax := inWidth-40;
For inCounter := 0 To lst.Count - 1 Do
Begin
lblLabel.Caption := lst[inCounter];
If lblLabel.Width > inMax Then inMax := lblLabel.Width;
End;
inWidth := inMax+60;
If inWidth > Screen.Width-75 Then inWidth := Screen.Width-75;
inListHeight := lst.Count * 13;
inHeight := inListHeight + 43+26;
If inHeight > Screen.Height-100 Then inHeight := Screen.Height-100;
If inHeight < 150 Then inHeight := 150;
Result :=
DlgLookup_ads(
sgStore , //out sgReturn : String;
sgDisplay , //out sgDisplay : String;
sgCaption , //sgCaption : String;
sgDisplayList , //sgDisplayList : String;
sgStoreList , //sgReturnList : String;
sgDefaultDisplay , //sgDefaultDisplay : String;
inHeight , //inHeight : Integer;
inWidth //inWidth : Integer
);//): Boolean; Overload;
Finally
lblLabel .Free;
lst .Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Initialization
UnitName := 'ads_DlgLU';
ProcName := 'Unknown';
end.