Solved

Getting same sequence of characters in an edit and a listbox?

Posted on 2004-10-22
175 Views
Last Modified: 2011-10-03
If the same SEQUENCE OF CHARACTERS appear in both an edit and a listbox, I need the wording in the listbox to be shown in a label.  Note that other words will be listed as well, ie:

Example wording in edit: "path/to/elephant.gif"
Another example in edit: "What is the path to elephant.gif?"

Example wording in listbox:
animal/lion.gif
insect/fly.jpg
animal/elephant.gif
animal/dog

In the above example, I want "animal/elephant.gif" as a label. Note that the wording in the edit could contain spaces (or not) or end with a "?" (or not) or end with any other wording.

I am using Delphi 6.  Many thanks for your help.
0
Question by:rincewind666
    7 Comments
     
    LVL 1

    Expert Comment

    by:vacerose
    SEQUENCE OF CHARACTERS here needs to be more accurately defined.

    I say this because in your example path/to/elephant.gif all of the following are sequences of characters.

    p
    a
    el
    an
    phan

    You need to decide on a way to tokenize the edit text, in your examples using / and space will work, or decide on a minimum sequence length to scan for.  In the stated example you could use a minimum length of say 4 or 5 characters but that may not work if the list box contains shorter data than this example.
    0
     

    Author Comment

    by:rincewind666
    The sequence will be a filename (a dot followed by a 3 letter extension). The beginning will either be a space or a slash (/).
    0
     
    LVL 7

    Expert Comment

    by:sftweng
    Code:
    =============================
    unit uQ_21179046;

    interface

    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls;

    type
      TFormQ_21179046 = class(TForm)
        Label1: TLabel;
        Edit1: TEdit;
        ListBox1: TListBox;
        procedure Edit1Change(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;

    var
      FormQ_21179046: TFormQ_21179046;

    implementation

    {$R *.dfm}

    procedure TFormQ_21179046.Edit1Change(Sender: TObject);
    var
      tokenText : String;
      blankPos, slashPos, dotPos, endPos : Integer;
      ix : Integer;
    begin
      tokenText := Edit1.Text;

      if Length(tokenText) > 0
      then begin
        dotPos := Pos('.',tokenText);
        if dotPos <= 0
        then Exit
        else begin
          blankPos := Pos(' ',tokenText);
          slashPos := Pos('/',tokenText);
          while ((blankPos > 0) and (blankPos < dotPos))
             or ((slashPos > 0) and (slashPos < dotPos))
          do begin
            blankPos := Pos(' ',tokenText);
            slashPos := Pos('/',tokenText);
            if blankPos > slashPos
            then Delete(tokenText,1,blankPos)
            else Delete(tokenText,1,slashPos);
          end {while};
          endPos := Length(tokenText);
          dotPos := Pos('.',tokenText);
          if (endPos = dotPos+3)
          then begin
            for ix := 0 to ListBox1.Items.Count-1
            do begin
              if Pos(tokenText,ListBox1.Items[ix]) > 0
              then begin
                Label1.Caption := ListBox1.Items[ix];
                exit;
              end {if};
            end {for};
          end;
        end {if};
      end {if};

    end {Edit1Change};

    end.
    ================================
    Form:
    ================================
    object FormQ_21179046: TFormQ_21179046
      Left = 972
      Top = 186
      Width = 279
      Height = 563
      Caption = 'Q_21179046'
      Color = clBtnFace
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'MS Sans Serif'
      Font.Style = []
      OldCreateOrder = False
      PixelsPerInch = 96
      TextHeight = 13
      object Label1: TLabel
        Left = 56
        Top = 32
        Width = 3
        Height = 13
      end
      object Edit1: TEdit
        Left = 56
        Top = 64
        Width = 153
        Height = 21
        TabOrder = 0
        OnChange = Edit1Change
      end
      object ListBox1: TListBox
        Left = 56
        Top = 96
        Width = 153
        Height = 353
        ItemHeight = 13
        Items.Strings = (
          'animal/lion.gif'
          'insect/fly.jpg'
          'animal/elephant.gif'
          'animal/dog')
        TabOrder = 1
      end
    end
    0
     
    LVL 14

    Accepted Solution

    by:
    Here's my version (a bit over-simplified, perhaps?)

    assuming your ListBox already contains all the values:

    procedure TForm1.Edit1Change(Sender: TObject);
    var
      i, j: Integer;
      s: string;
    begin
      for i := 0 to ListBox1.Items.Count - 1 do
      begin
        s := ListBox1.Items[i];
        j := Pos('/', s);
        // strip out the filename
        if j > 0 then
          s := Copy(s, j + 1, Length(s));
        // now we perform the search
        j := Pos(s, Edit1.Text);
        if j > 0 then
        begin
          Label1.Caption := ListBox1.Items[i];
          Break; // <--- Workshop_Alex will kill me if he sees this Break statement ;-)
        end else
          Label1.Caption := 'Not Found';
      end;
    end;



    DragonSlayer.
    0
     
    LVL 12

    Expert Comment

    by:esoftbg
    //........ Unit ........
    unit Unit1_Q_21179046;

    interface

    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, Buttons, StrUtils, CheckLst;

    type
      TChSet = set of Char;
     
      TForm1 = class(TForm)
        Edit_Question: TEdit;
        lbx_Search: TListBox;
        lbx_Questions: TListBox;
        lbl_Got_Word: TLabel;
        spb_Get_Words: TSpeedButton;
        spb_Clear: TSpeedButton;
        chlbx_Delimiters: TCheckListBox;
        lbx_Words: TListBox;
        lbl_Delimiters: TLabel;
        procedure FormCreate(Sender: TObject);
        procedure lbx_QuestionsClick(Sender: TObject);
        procedure spb_Get_WordsClick(Sender: TObject);
        procedure spb_ClearClick(Sender: TObject);
        private
        { Private declarations }
        public
        { Public declarations }
      end;

    var
      Form1: TForm1;

    implementation

    {$R *.dfm}

    procedure TForm1.FormCreate(Sender: TObject);
    var
      I:      Integer;
    begin
      for I := 0 to chlbx_Delimiters.Items.Count-1 do
        chlbx_Delimiters.Checked[I] := True;
      lbx_Questions.ItemIndex := 0;
      lbx_QuestionsClick(Self);  
    end;

    function  Get_Words(S: string; Delimit: TChSet; ListBox1, ListBox2: TListBox): string;
    var
      I:      Integer;
      J:      Integer;
      L:      Integer;
      SL:     TStringList;
      T:      string;
    begin
      Result := '';
      ListBox2.Clear;
      if (S<>'') then
      begin
        SL := TStringList.Create;
        try
          T := '';
          L := Length(S);
          for I := 1 to L do
          begin
            if not (S[I] in Delimit) then
            begin
              T := T + S[I];
              if (I=L) then
                SL.Add(T);
            end
            else
            begin
              if (T<>'') then
              begin
                SL.Add(T);
                T := '';
              end;
            end;
          end;
          ListBox2.Items.Assign(SL);
          for I := 0 to ListBox1.Items.Count-1 do
          begin
            for J := 0 to SL.Count-1 do
            begin
              if (Pos(SL[J], ListBox1.Items[I]) > 0) then
              begin
                Result := ListBox1.Items[I];
                Break;
              end;
            end;
          end;
        finally
          SL.Free;
        end;
      end;
    end;

    procedure TForm1.spb_Get_WordsClick(Sender: TObject);
    var
      I:      Integer;
      Delimit:TChSet;
    begin
      Delimit := [];
      for I := 0 to chlbx_Delimiters.Items.Count-1 do
        if chlbx_Delimiters.Checked[I] then
          Delimit := Delimit + [chlbx_Delimiters.Items[I][1]];
      lbl_Got_Word.Caption := Get_Words(Trim(Edit_Question.Text), Delimit, lbx_Search, lbx_Words);
    end;

    procedure TForm1.lbx_QuestionsClick(Sender: TObject);
    begin
      Edit_Question.Text := lbx_Questions.Items[lbx_Questions.ItemIndex];
    end;

    procedure TForm1.spb_ClearClick(Sender: TObject);
    begin
      lbl_Got_Word.Caption := '............................................';
      lbx_Questions.Clear;
    end;

    end.

    //........ Form ........
    object Form1: TForm1
      Left = 215
      Top = 111
      BorderIcons = [biSystemMenu, biMinimize]
      BorderStyle = bsSingle
      Caption = 'Getting same sequence of characters in an edit and a listbox?'
      ClientHeight = 350
      ClientWidth = 504
      Color = clBtnFace
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'MS Sans Serif'
      Font.Style = []
      OldCreateOrder = False
      Position = poDesktopCenter
      OnCreate = FormCreate
      PixelsPerInch = 96
      TextHeight = 13
      object lbl_Got_Word: TLabel
        Left = 24
        Top = 142
        Width = 177
        Height = 16
        Caption = '............................................'
        Font.Charset = DEFAULT_CHARSET
        Font.Color = clBlue
        Font.Height = -13
        Font.Name = 'MS Sans Serif'
        Font.Style = [fsBold]
        ParentFont = False
      end
      object spb_Get_Words: TSpeedButton
        Left = 16
        Top = 94
        Width = 192
        Height = 22
        Caption = 'Getting same sequence of characters '
        OnClick = spb_Get_WordsClick
      end
      object spb_Clear: TSpeedButton
        Left = 1
        Top = 141
        Width = 22
        Height = 16
        Caption = 'CL'
        OnClick = spb_ClearClick
      end
      object lbl_Delimiters: TLabel
        Left = 220
        Top = 16
        Width = 56
        Height = 13
        Caption = 'Delimiters'
        Font.Charset = DEFAULT_CHARSET
        Font.Color = clWindowText
        Font.Height = -11
        Font.Name = 'MS Sans Serif'
        Font.Style = [fsBold]
        ParentFont = False
      end
      object lbx_Questions: TListBox
        Left = 16
        Top = 16
        Width = 192
        Height = 76
        ItemHeight = 13
        Items.Strings = (
          'Do you want lion.gif?'
          'Do you want fly.jpg?'
          'Do you want elephant.gif?'
          'Do you want dog.bmp?'
          'Do you want eagle.jpg?')
        TabOrder = 0
        OnClick = lbx_QuestionsClick
      end
      object Edit_Question: TEdit
        Left = 16
        Top = 118
        Width = 192
        Height = 21
        Font.Charset = DEFAULT_CHARSET
        Font.Color = clPurple
        Font.Height = -11
        Font.Name = 'MS Sans Serif'
        Font.Style = []
        ParentFont = False
        TabOrder = 1
        Text = 'Do you want elephant.gif?'
      end
      object lbx_Search: TListBox
        Left = 288
        Top = 16
        Width = 192
        Height = 320
        TabStop = False
        ItemHeight = 13
        Items.Strings = (
          'animal/lion.gif'
          'insect/fly.jpg'
          'animal/elephant.gif'
          'animal/dog.bmp'
          'bird/eagle.jpg')
        TabOrder = 2
      end
      object chlbx_Delimiters: TCheckListBox
        Left = 224
        Top = 32
        Width = 48
        Height = 304
        Font.Charset = DEFAULT_CHARSET
        Font.Color = clRed
        Font.Height = -11
        Font.Name = 'MS Sans Serif'
        Font.Style = [fsBold]
        ItemHeight = 13
        Items.Strings = (
          ' '
          '/'
          '?')
        ParentFont = False
        TabOrder = 3
      end
      object lbx_Words: TListBox
        Left = 16
        Top = 160
        Width = 128
        Height = 176
        ItemHeight = 13
        TabOrder = 4
      end
    end
    0
     
    LVL 12

    Expert Comment

    by:esoftbg
    procedure TForm1.spb_ClearClick(Sender: TObject);
    begin
      lbl_Got_Word.Caption := '............................................';
      lbx_Words.Clear; // this is correct as I would like to be
    end;
    0
     

    Author Comment

    by:rincewind666
    Many thanks for all your help.  BTW DragonSlayer, nothing can be "a bit over-simplified" as far as I am concerned :-)
    0

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone. Privacy Policy Terms of Use

    Featured Post

    Shellfire Box VPN + Lifetime Subscription

    The Shellfire Box easily connects all of your devices, even those that don't offer the possibility to establish a safe vpn connection. Access blocked content and surf safely, no matter where in the world you are located.

    In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
    Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
    Migrating to Microsoft Office 365 is becoming increasingly popular for organizations both large and small. If you have made the leap to Microsoft’s cloud platform, you know that you will need to create a corporate email signature for your Office 365…
    In this sixth video of the Xpdf series, we discuss and demonstrate the PDFtoPNG utility, which converts a multi-page PDF file to separate color, grayscale, or monochrome PNG files, creating one PNG file for each page in the PDF. It does this via a c…

    875 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    8 Experts available now in Live!

    Get 1:1 Help Now