//Advanced Delphi Systems Code: ads_DlgLU
Unit ads_DlgLU;
{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.
}
{ $ DEFINE LOOKUPINCLUDE}
{ $ DEFINE LOOKUPUSEREDITABLE}

(*
UnitIndex Master Index Implementation Section Download Units
Description: ads_DlgLU.pas
This unit contains the following routines.

DialogList   DlgLookup_ads_1   DlgLookup_ads_2   DlgLookupEditable_ads  DlgLookupInclude_ads   PathOfAppDataLocal   PathOfSpecialFolder   TOKButton.ButtonClick  

*)
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
  ActiveX,
  Buttons,
  Classes,
  Controls,
  Dialogs,
  ExtCtrls,
  Forms,
  Graphics,
  ShlObj,
  StdCtrls,
  SysUtils,
  Windows;

Type
  TOKButton = Class(TBitBtn)
  Public
    Procedure ButtonClick(Sender: Tobject);
    Constructor Create(AOwner: TComponent); Override;
    Destructor Destroy; Override;
  End;

//
Unit Description UnitIndex Master Index
Procedure TOKButton.ButtonClick(Sender: Tobject);
Var
  boFound: Boolean;
  f: TForm;
  i: Integer;
  j: Integer;
  ListBox: TListBox;
Begin
  boFound := False;
  For i := 0 To Self.Owner.ComponentCount - 1 Do
  Begin
    If Self.Owner.Components[i] Is TListBox Then
    Begin
      ListBox := TListBox(Self.Owner.Components[i]);
      If ListBox.Name = 'lstDisplayList' Then
      Begin
        For j := 0 To ListBox.Items.Count - 1 Do
        Begin
          If listbox.Selected[j] Then
          Begin
            boFound := True;
            Break;
          End;
        End;
        If boFound Then Break;
      End;
    End;
  End;
  If boFound Then
  Begin
    If Self.Owner Is TForm Then
    Begin
      f := TForm(Self.Owner);
      f.ModalResult := mrOK;
    End;
  End
  Else
  Begin
    ShowMessage('Nothing was selected.');
  End;
End;

Constructor TOKButton.Create(AOwner: TComponent);
Begin
  Inherited;
  onClick := ButtonClick;
End;

Destructor TOKButton.Destroy;
Begin
  Inherited;
End;

//
Unit Description UnitIndex Master Index
Function PathOfSpecialFolder(Folder: Integer): String;
Var
  ppidl: PItemIdList;
  shellMalloc: IMalloc;
Begin
  Result := '';
  ppidl := Nil;
  Try
    If SHGetMalloc(shellMalloc) = NOERROR Then
    Begin
      SHGetSpecialFolderLocation(Application.Handle, Folder, ppidl);
      SetLength(Result, MAX_PATH);
      If Not SHGetPathFromIDList(ppidl, PChar(Result)) Then
        Raise exception.create('SHGetPathFromIDList failed : invalid pidl');
      SetLength(Result, lStrLen(PChar(Result)));
      If Result <> '' Then
      Begin
        If Copy(Result, Length(Result), 1) <> '\' Then
          Result := Result + '\';
      End;
    End;
  Finally
    If ppidl <> Nil Then shellMalloc.free(ppidl);
  End;
End;

//
Unit Description UnitIndex Master Index
Function PathOfAppDataLocal(): String;
Begin
  Result := '';
  Result := PathOfSpecialFolder(28);
End;

//
Unit Description UnitIndex Master Index
Function DlgLookupEditable_ads(sgCaption: String; Var sgDisplayList, sgReturnList: String): Boolean;
Var
  boFileDisplay: Boolean;
  boFileReturn: Boolean;
  boUseFileCopies: Boolean;
  DirLocalApp: String;
  DirLocalThisApp: String;
  DirLookup: String;
  ExeName: String;
  ExePath: String;
  FileDisplay: String;
  FileReturn: String;
  inDisplayCount: Integer;
  inReturnCount: Integer;
  lstDisplay: TStringList;
  lstReturn: TStringList;
Begin
  Result := False;
  ExeName := ExtractFileName(ParamStr(0));
  ExeName := LowerCase(Copy(ExeName, 1, Length(ExeName) - 4));
  ExeName := UpperCase(Copy(ExeName, 1, 1)) + Copy(ExeName, 2, Length(ExeName) - 1);
  ExePath := ExtractFilePath(ParamStr(0));
  DirLocalApp := PathOfAppDataLocal();
  DirLocalThisApp := DirLocalApp + ExeName + '\';
  DirLookup := DirLocalThisApp + 'Lookup\';
  If Not DirectoryExists(DirLookup) Then ForceDirectories(DirLookup);
  FileDisplay := DirLookup + sgCaption + '.Display.txt';
  FileReturn := DirLookup + sgCaption + '.Return.txt';
  boFileDisplay := FileExists(FileDisplay);
  boFileReturn := FileExists(FileReturn);
  boUseFileCopies := (boFileDisplay And boFileReturn);
  If Not boUseFileCopies Then
  Begin
    lstDisplay := TStringList.Create();
    lstReturn := TStringList.Create();
    Try
      lstDisplay.SetText(PAnsiChar(sgDisplayList));
      lstReturn.SetText(PAnsiChar(sgReturnList));
      lstDisplay.SaveToFile(FileDisplay);
      lstReturn.SaveToFile(FileReturn);
      Exit;
    Finally
      FreeAndNil(lstDisplay);
      FreeAndNil(lstReturn);
    End;
  End;
  lstDisplay := TStringList.Create();
  lstReturn := TStringList.Create();
  Try
    lstDisplay.LoadFromFile(FileDisplay);
    lstReturn.LoadFromFile(FileReturn);
    inDisplayCount := lstDisplay.Count;
    inReturnCount := lstReturn.Count;
    If inDisplayCount <> inReturnCount Then
    Begin
      lstDisplay.SaveToFile(DirLookup + sgCaption + '.Display.Bad.txt');
      lstReturn.SaveToFile(DirLookup + sgCaption + '.Return.Bad.txt');
      lstDisplay.SetText(PAnsiChar(sgDisplayList));
      lstReturn.SetText(PAnsiChar(sgReturnList));
      lstDisplay.SaveToFile(FileDisplay);
      lstReturn.SaveToFile(FileReturn);
      Raise Exception.Create('Lookup display and return files must be the same lengths.');
    End;
    If inDisplayCount = 0 Then
    Begin
      lstDisplay.SaveToFile(DirLookup + sgCaption + '.Display.Bad.txt');
      lstReturn.SaveToFile(DirLookup + sgCaption + '.Return.Bad.txt');
      lstDisplay.SetText(PAnsiChar(sgDisplayList));
      lstReturn.SetText(PAnsiChar(sgReturnList));
      lstDisplay.SaveToFile(FileDisplay);
      lstReturn.SaveToFile(FileReturn);
      Raise Exception.Create('Lookup item count must be greater than zero.');
    End;
    sgDisplayList := lstDisplay.Text;
    sgReturnList := lstReturn.Text;
    Result := True;
  Finally
    lstDisplay.Free;
    lstReturn.Free;
  End;
End;

//
Unit Description UnitIndex Master Index
Function DlgLookupInclude_ads(
  Title: String;
  sgDisplayList: String;
  sgReturnList: String
  ): Boolean;
Var
  DirHelp: String;
  DirHelpInclude: String;
  DirLocalApp: String;
  DirLocalThisApp: String;
  ExeName: String;
  ExePath: String;
  FileInclude: String;
  inCounter: Integer;
  lstDisplay: TStringList;
  lstInclude: TStringList;
  lstReturn: TStringList;
Begin
  Result := False;
  ExeName := ExtractFileName(ParamStr(0));
  ExeName := LowerCase(Copy(ExeName, 1, Length(ExeName) - 4));
  ExeName := UpperCase(Copy(ExeName, 1, 1)) + Copy(ExeName, 2, Length(ExeName) - 1);
  ExePath := ExtractFilePath(ParamStr(0));
  DirLocalApp := PathOfAppDataLocal();
  DirLocalThisApp := DirLocalApp + ExeName + '\';
  DirHelp := DirLocalThisApp + 'Help\';
  DirHelpInclude := DirHelp + 'Include\';
  If Not DirectoryExists(DirHelpInclude) Then ForceDirectories(DirHelpInclude);
  FileInclude := DirHelpInclude + Title + '.txt';
  If Not FileExists(FileInclude) Then
  Begin
    lstDisplay := TStringList.Create();
    lstReturn := TStringList.Create();
    lstInclude := TStringList.Create();
    Try
      lstDisplay.SetText(PAnsiChar(sgDisplayList));
      lstReturn.SetText(PAnsiChar(sgReturnList));
      lstInclude.Clear;
      lstInclude.Add('');
      lstInclude.Add('
');
      lstInclude.Add('');
      lstInclude.Add('');
      lstInclude.Add('');
      lstInclude.Add('');
      lstInclude.Add('');
      lstInclude.Add('');
      lstInclude.Add('');
      lstInclude.Add('');
      lstInclude.Add('');
      lstInclude.Add('');
      lstInclude.Add('');
      lstInclude.Add('');
      lstInclude.Add('');
      lstInclude.Add('');
      lstInclude.Add('');
      lstInclude.Add('');
      For inCounter := 0 To lstDisplay.count - 1 Do
      Begin
        lstInclude.Add('');
        lstInclude.Add('');
        lstInclude.Add('');
        lstInclude.Add('');
      End;
      lstInclude.Add('
');
      lstInclude.Add('The data for the ' + Title + ' lookup is shown below.  The Code');
    //lstInclude.Add('column shows what is displayed in the database.  The ');
      lstInclude.Add('column shows what is used by the system.  The ');
      lstInclude.Add('Description column is what is shown to the user ');
      lstInclude.Add('when selecting a value.');
      lstInclude.Add('
');
      lstInclude.Add('');
      lstInclude.Add('
');
      lstInclude.Add('Code');
      lstInclude.Add('');
      lstInclude.Add('Description');
      lstInclude.Add('
');
      lstInclude.Add('');
      lstInclude.Add('
');
        lstInclude.Add(lstReturn[inCounter]);
        lstInclude.Add('');
        lstInclude.Add(lstDisplay[inCounter]);
        lstInclude.Add('
');
      lstInclude.Add('
');
      lstInclude.Add('');
      lstInclude.SaveToFile(FileInclude);
      Result := True;
    Finally
      lstInclude.Free;
      lstDisplay.Free;
      lstReturn.Free;
    End;
  End;
End;

{!~
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.
}

//
Unit Description UnitIndex Master Index
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: TOKButton;
  btnCancel: TBitBtn;
  lstReturnList: TListBox;
  lstDisplayList: TListBox;
  lstSReturnList: TStringList;
  lstSDisplayList: TStringList;
  lstSelected: TStringList;
  lstSelectedExist: TStringList;
Begin
  Result := False;
  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;

{$IFDEF LOOKUPUSEREDITABLE}
    {The user can edit the Display and Return lists by editing the following files:
    C:\Documents and Settings\\Local Settings\Application Data\\Lookups\.Display.txt
    C:\Documents and Settings\\Local Settings\Application Data\\Lookups\.Return.txt}
    DlgLookupEditable_ads(sgCaption, sgDisplayList, sgReturnList);
{$ENDIF}

    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;
      FormStyle := fsStayOnTop;
    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 := TOKButton.Create(frm);
    With btnOK Do
    Begin
      Parent := pnlButtons;
      Top := 16;
      Width := 75;
      Height := 25;
      Enabled := True;
      TabOrder := 0;
      Kind := bkOK;
      ModalResult := mrNone;
      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;
      Name := 'lstReturnList';
      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;
      Font.Name := 'QuickType II Mono';
      Height := 260;
      Align := alClient;
      ItemHeight := 13;
      Name := 'lstDisplayList';
      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;
{$IFDEF LOOKUPINCLUDE}
    DlgLookupInclude_ads(sgCaption, sgDisplayList, sgReturnList);
{$ENDIF}
    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;
      If lstSReturnList.Count = 0 Then
      Begin
        Result := False;
      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;
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;
  sgReturnBefore: String;
  sgDisplayBefore: String;
  lstDisplayList: TStringList;
  lstReturnList: TStringList;
  inIndexBefore: Integer;
Begin
  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;
End;

//
Unit Description UnitIndex Master Index
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
  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 := 'QuickType II Mono';
      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 + 40;
    If inWidth > Screen.Width Then inWidth := Screen.Width;
    inListHeight := lst.Count * 13;
    inHeight := inListHeight + 43 + 26;
    If inHeight > (Screen.Height-52) Then inHeight := Screen.Height-52;
    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;
End;

End.
//