DICAS

Visite a biblioteca de dicas da comunidade.

Saiba mais

ARTIGOS

Abordagens detalhadas sobre assuntos diversos.

Saiba mais

INICIANTES

Aprenda a programar de um modo simples e fácil.

Saiba mais

DOWNLOADS

Acesse os materiais exclusivos aos membros.

Saiba mais
voltar

PARA QUEM GOSTA DE DELPHI

Como transformar texto em uma lista de palavras?

Neste exemplo, podemos procurar por palavras escritas em um memo,
inclusive com o filtro de case sensitive.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
unit Unit1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Memo1: TMemo;
    ListBox1: TListBox;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure SplitTextIntoWords(const S: string; words: TStringList);
var
  startpos, endpos: Integer;
begin
  Assert(Assigned(words));
  words.Clear;
  startpos := 1;
  while startpos <= Length(S) do
  begin
    while (startpos <= Length(S)) and not IsCharAlpha(S[startpos]) do
      Inc(startpos);
    if startpos <= Length(S) then
    begin
      endpos := startpos + 1;
      while (endpos <= Length(S)) and IsCharAlpha(S[endpos]) do
        Inc(endpos);
      words.Add(Copy(S, startpos, endpos - startpos));
      startpos := endpos + 1;
    end;
  end;
end;
 
function StringMatchesMask(S, mask: string;
  case_sensitive: Boolean): Boolean;
var
  sIndex, maskIndex: Integer;
begin
  if not case_sensitive then
  begin
    S    := AnsiUpperCase(S);
    mask := AnsiUpperCase(mask);
  end; { If }
  Result    := True; // blatant optimism
  sIndex    := 1;
  maskIndex := 1;
  while (sIndex <= Length(S)) and (maskIndex <= Length(mask)) do
  begin
    case mask[maskIndex] of
      '?':
        begin
          Inc(sIndex);
          Inc(maskIndex);
        end; { case '?' }
      '*':
        begin
          Inc(maskIndex);
          if maskIndex > Length(mask) then
            Exit
          else if mask[maskindex] in ['*', '?'] then
            raise Exception.Create('Invalid mask');
          while (sIndex <= Length(S)) and
            (S[sIndex] <> mask[maskIndex]) do
            Inc(sIndex);
          if sIndex > Length(S) then
          begin
            Result := False;
            Exit;
          end;
 
        end; { Case '*' }
      else if S[sIndex] = mask[maskIndex] then
        begin
          Inc(sIndex);
          Inc(maskIndex);
        end
        else
          begin
            Result := False;
            Exit;
          end;
    end;
  end;
  if (sIndex <= Length(S)) or (maskIndex <= Length(mask)) then
    Result := False;
end;
 
procedure FindMatchingWords(const S, mask: string;
  case_sensitive: Boolean; matches: Tstrings);
var
  words: TstringList;
  i: Integer;
begin
  Assert(Assigned(matches));
  words := TstringList.Create;
  try
    SplitTextIntoWords(S, words);
    matches.Clear;
    for i := 0 to words.Count - 1 do
    begin
      if stringMatchesMask(words[i], mask, case_sensitive) then
        matches.Add(words[i]);
    end; { For }
  finally
    words.Free;
  end;
end;
{
The Form has one TMemo for the text to check, one TEdit for the mask,
one TCheckbox (check = case sensitive), one TListbox for the results,
one Tbutton
}
 
{ Coloque um form com um TMemo, um edit para a palavra procurada, um checkbox
para o case sensitive e um listbox para os resultados }
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  FindMatchingWords(memo1.Text, edit1.Text, checkbox1.Checked, listbox1.Items);
end;
 
 
end.

Fonte: http://www.delphitricks.com/

Dúvidas ou sugestões deixe nos comentários do post.

Facebook Comments Box
  • InfusTec
  • 3.606 views
  • 0 comentários
  • 28 de outubro de 2015

Está gostando do conteúdo? Considere pagar um cafezinho para nossa equipe!

Deixe um comentário

Ir ao topo

© 2024 Infus Soluções em Tecnologia - Todos os Direitos Reservados