On Sat, 07 Jan 2006 02:22:54 +0800
Funky Beast <[EMAIL PROTECTED]> wrote:
> Where should i add the below function for global use in the source,
> i want to implement AutoComplete property with this function
> for TComboBox and maybe also on some other controls.
>
> Or is there a similar function somewhere already written in the source.
Maybe add it to TextStrings or LCLProc.
> //*********************************************************************
> function GetCompleteText(sText: string; iSelStart: Integer;
> bCaseSensitive, bSearchAccending: Boolean;
I guess, you mean ascending (or acceding).
> slTextList: TStrings): string;
> var i: Integer;
> sPrefixText: string;
> sTempText: string;
> begin
> Result := sText;//Return original text if no identical text are found
> if (sText = '') then Exit;//Everything is identical with nothing, Exit.
> if (iSelStart = 0) then Exit;//Cursor at beginning
> if (slTextList.Count = 0) then Exit;//No text list to search, Exit.
> //Get text from beginning to cursor position.
> sPrefixText := LeftStr(sText, iSelStart);
> if not bCaseSensitive then sPrefixText := UpperCase(sPrefixText);
> if bSearchAccending then
> begin
> for i:=0 to slTextList.Count-1 do
> begin
> sTempText := LeftStr(slTextList[i], iSelStart);
> if not bCaseSensitive then sTempText := UpperCase(sTempText);
> if (sTempText = sPrefixText) then
> begin
> Result := slTextList[i];//Return first item with same prefix
> Break;
> end;//End if (sTempText = sPrefixText)
> end;//End for-loop i
> end else
> begin
> for i:=slTextList.Count-1 downto 0 do
> begin
> sTempText := LeftStr(slTextList[i], iSelStart);
> if not bCaseSensitive then sTempText := UpperCase(sTempText);
> if (sTempText = sPrefixText) then
> begin
> Result := slTextList[i];//Return last item with same prefix
> Break;
> end;//End if (sTempText = sPrefixText)
> end;//End for-loop i
> end;//End if bSearchAccending
> end;
> //*********************************************************************
The loop bodies look the same. Maybe they can be combined to one sub
procedure?
>
>
> An example usage of this function is:
>
> //*********************************************************************
> procedure TForm1.FormCreate(Sender: TObject);
> begin
> slList := TStringList.Create;
> slList.Add('ABCD');
> slList.Add('ABDC');
> slList.Add('ACBD');
> slList.Add('ACDB');
> slList.Add('ADBC');
> slList.Add('ADCB');
> slList.Add('BACD');
> slList.Add('BADC');
> slList.Add('BCAD');
> slList.Add('BCDA');
> slList.Add('BDAC');
> slList.Add('BDCA');
> slList.Add('CABD');
> slList.Add('CADB');
> slList.Add('CBAD');
> slList.Add('CBDA');
> slList.Add('CDAB');
> slList.Add('CDBA');
> slList.Add('DABC');
> slList.Add('DACB');
> slList.Add('DBAC');
> slList.Add('DBCA');
> slList.Add('DCAB');
> slList.Add('DCBA');
> slList.Add('AABC');
> slList.Add('AACB');
> slList.Add('ABAC');
> slList.Add('ABCA');
> slList.Add('ACAB');
> slList.Add('ACBA');
> slList.Add('BAAC');
> slList.Add('BACA');
> slList.Add('BCAA');
> slList.Add('CAAB');
> slList.Add('CABA');
> slList.Add('CBAA');
> slList.Add('AABB');
> slList.Add('ABAB');
> slList.Add('ABBA');
> slList.Add('BAAB');
> slList.Add('BABA');
> slList.Add('BBAA');
> slList.Add('AAAB');
> slList.Add('AABA');
> slList.Add('ABAA');
> slList.Add('BAAA');
> slList.Add('AAAA');
> end;
>
> procedure TForm1.FormDestroy(Sender: TObject);
> begin
> FreeAndNil(slList);
> end;
>
> procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word;
> Shift: TShiftState);
> var iSelStart: Integer;
> sCompleteText: string;
> begin
> if ((Key = VK_LEFT) or (Key = VK_RIGHT)) then Exit;
> iSelStart := Edit1.SelStart;
> sCompleteText := GetCompleteText(Edit1.Text, iSelStart,
> False, True, slList);
> if not (sCompleteText = Edit1.Text) then
> begin
> Edit1.Text := sCompleteText;
> Edit1.SelStart := iSelStart;
> Edit1.SelLength := Length(Edit1.Text);
> end;//End if not ((UpperCase(sCompleteText) = UpperCase(Edit1.Text))
> if (Key = VK_RETURN) then Edit1.SelectAll;
> end;
> //*********************************************************************
Mattias
_________________________________________________________________
To unsubscribe: mail [EMAIL PROTECTED] with
"unsubscribe" as the Subject
archives at http://www.lazarus.freepascal.org/mailarchives
