Desenvolvi estes dois componentes faz aproximadamente 1 ano, pois estava cansado de perder tempo procurando itens em TCheckListBox e TListBox.
Chamei os componentes de:
- TEditSearchChecklist
- TEditSearchListBox
1º No delphi vá em File=>New=>Package Delphi - Win 32, será criado um projeto novo
2º Clique sobre o arquivo do projeto (aba Project Maneger) com o botão direito e em seguida em "add new unit"
3º Substitua o código dessa nova unit pelo código abaixo;
4º Salve a Unit com o nome de TEditSearchTools e o projeto com o nome que desejar
5º Clique com o arquivo direito sobre o arquivo do projeto e em seguida clique em compile.
unit TEditSearchTools;
interfaceuses SysUtils, Classes, Controls, StdCtrls, CheckLst;type TEditSearchChecklist = class(TEdit) private mat : Array of array of String; FCheckListBox: TCheckListBox; procedure SetCheckListBox(const Value: TCheckListBox); procedure CopiaItensList; procedure VerificaOnChange; procedure PassaItensMatrizList; procedure MarcaSelecionadoNaMatriz; procedure Change; override; Function RemoveAcentos(texto:String; upper:Boolean):String; public destructor Destroy; override; published property CheckListBox:TCheckListBox read FCheckListBox write SetCheckListBox; end;
TEditSearchListBox = class(TEdit) private vet : Array of String; FListBox: TListBox; procedure SetListBox(const Value: TListBox); procedure CopiaItensList; procedure PassaItensMatrizList; procedure Change; override; public constructor Create(AOwner : TComponent); override; destructor Destroy; override; published property ListBox:TListBox read FListBox write SetListBox; end;
procedure Register;
implementation
procedure Register;begin RegisterComponents('Tiemann Componets', [TEditSearchChecklist]); RegisterComponents('Tiemann Componets', [TEditSearchListBox]);end;
{ TEditSearchChecklist }procedure TEditSearchChecklist.Change;begin if Length(mat)=0 then CopiaItensList;
if Assigned(FCheckListBox) then VerificaOnChange; inherited Change;end;
procedure TEditSearchChecklist.CopiaItensList;var I:integer;begin //se o CheckListBox não estiver criado if not Assigned(FCheckListBox) then exit; //sai da função
//seta o tamanho da matriz SetLength(mat,FCheckListBox.Items.count);
//para cada linha da matriz for I := 0 to High(MAT) do begin SetLength(mat[i],2);//seta o Nº de colunas da linha mat[i, 0]:=FCheckListBox.Items[I];//armazena o texto na 1ª coluna da linha I //se o item estiver selecionado if FCheckListBox.Checked[I]=true then mat[i, 1]:='1' //armazena a String '1' na segunda coluna else mat[i, 1]:='0';//armazena a String '2' na segunda coluna end;end;
destructor TEditSearchChecklist.Destroy;begin if assigned(FCheckListBox) then FCheckListBox:=nil; inherited;end;
procedure TEditSearchChecklist.MarcaSelecionadoNaMatriz; var i, x:Integer;begin //para cada um dos itens do CheckListBox for I := 0 to FCheckListBox.items.Count - 1 do begin //vare a matriz "mat" em busca do registro com o mesmo "texto" que o item do checkListBox for X := 0 to Length(mat) - 1 do //se o texto da matriz for igual ao do item do CheckListBox if FCheckListBox.Items[I]=mat[x,0] then begin if FCheckListBox.Checked[i]=true then mat[x,1]:='1' else mat[x,1]:='0'; Break; end; end;end;
procedure TEditSearchChecklist.PassaItensMatrizList;var I:Integer;begin //limpa os itens FCheckListBox.clear; //Para cada item da matriz for I := 0 to Length(mat) - 1 do begin //adiciona o item ao checkListBox FCheckListBox.ITEMS.Add(mat[I, 0]); //se o valor armazenado no segunda coluna da matriz for '1' if mat[I, 1]='1' then FCheckListBox.Checked[I]:=true //marca o registro como selecionado else FCheckListBox.Checked[I]:=False; end;end;
function TEditSearchChecklist.RemoveAcentos(texto: String; upper:Boolean): String;var //matStr é uma matriz que vai armazenar caracteres ascentuados e outros sem matStr: array[0..95] of array [0..1] of String;
Temp :String; i :integer;begin //Abaixo encho matStr[0, 0]:='â'; matStr[0, 1]:='a'; matStr[1, 0]:='Â'; matStr[1, 1]:='A'; matStr[2, 0]:='à'; matStr[2, 1]:='a'; matStr[3, 0]:='À'; matStr[3, 1]:='A'; matStr[4, 0]:='á'; matStr[4, 1]:='a'; matStr[6, 0]:='Á'; matStr[6, 1]:='A'; matStr[7, 0]:='ã'; matStr[7, 1]:='a'; matStr[8, 0]:='Ã'; matStr[8, 1]:='A'; matStr[9, 0]:='ä'; matStr[9, 1]:='a'; matStr[10, 0]:='Ä'; matStr[10, 1]:='A';
matStr[11, 0]:='ê'; matStr[11, 1]:='e'; matStr[12, 0]:='Ê'; matStr[12, 1]:='E'; matStr[13, 0]:='è'; matStr[13, 1]:='e'; matStr[14, 0]:='È'; matStr[14, 1]:='E'; matStr[15, 0]:='é'; matStr[15, 1]:='e'; matStr[16, 0]:='É'; matStr[16, 1]:='E'; matStr[17, 0]:='ë'; matStr[17, 1]:='e'; matStr[18, 0]:='Ë'; matStr[18, 1]:='E';
matStr[19, 0]:='î'; matStr[19, 1]:='i'; matStr[20, 0]:='Î'; matStr[20, 1]:='I'; matStr[21, 0]:='ì'; matStr[21, 1]:='i'; matStr[22, 0]:='Ì'; matStr[22, 1]:='I'; matStr[23, 0]:='í'; matStr[23, 1]:='i'; matStr[25, 0]:='Í'; matStr[25, 1]:='I'; matStr[26, 0]:='ï'; matStr[26, 1]:='i'; matStr[27, 0]:='Ï'; matStr[27, 1]:='I';
matStr[28, 0]:='ô'; matStr[28, 1]:='o'; matStr[29, 0]:='Ô'; matStr[29, 1]:='O'; matStr[30, 0]:='ò'; matStr[30, 1]:='o'; matStr[31, 0]:='Ò'; matStr[31, 1]:='O'; matStr[32, 0]:='ó'; matStr[32, 1]:='o'; matStr[33, 0]:='Ó'; matStr[33, 1]:='O'; matStr[34, 0]:='ö'; matStr[34, 1]:='o'; matStr[35, 0]:='Ö'; matStr[35, 1]:='O';
matStr[36, 0]:='û'; matStr[36, 1]:='u'; matStr[37, 0]:='Û'; matStr[37, 1]:='U'; matStr[38, 0]:='ù'; matStr[38, 1]:='u'; matStr[39, 0]:='Ù'; matStr[39, 1]:='U'; matStr[40, 0]:='ú'; matStr[40, 1]:='u'; matStr[41, 0]:='Ú'; matStr[41, 1]:='U'; matStr[42, 0]:='ü'; matStr[42, 1]:='u'; matStr[43, 0]:='Ü'; matStr[43, 1]:='U';
matStr[44, 0]:='ç'; matStr[44, 1]:='c'; matStr[45, 0]:='Ç'; matStr[45, 1]:='C'; matStr[46, 0]:='ý'; matStr[46, 1]:='y'; matStr[47, 0]:='Ý'; matStr[47, 1]:='Y'; matStr[48, 0]:='ñ'; matStr[48, 1]:='n'; matStr[49, 0]:='Ñ'; matStr[49, 1]:='N';
temp:=texto; //vare a matriz removendo os ascentos for I := 0 to length(matStr) - 1 do temp:=StringReplace(temp, matStr[I, 0],matStr[I, 1], [rfReplaceAll]);
if upper then result:=UpperCase(Temp) else result:=Temp;end;
procedure TEditSearchChecklist.SetCheckListBox(const Value: TCheckListBox);begin FCheckListBox := Value; CopiaItensList;end;
procedure TEditSearchChecklist.VerificaOnChange;var I:integer;begin I:=0;
MarcaSelecionadoNaMatriz; PassaItensMatrizList; if Self.Text='' then exit;
while I<FCheckListBox.Items.Count do begin //Se o testo do edit não estiver contido no FCheckListBox if not( (Pos(RemoveAcentos(Self.Text, true), RemoveAcentos(FCheckListBox.Items[I], true))<>0)) then FCheckListBox.Items.Delete(I) else inc(I); end;end;
{ TEditSearchListBox }procedure TEditSearchListBox.Change; var I:integer;begin I:=0; if not Assigned(FListBox) then exit;
PassaItensMatrizList; if Self.Text='' then exit;
while I<FListBox.Items.Count do begin //Se o testo do edit não estiver contido no FListBox if not( (Pos(UpperCase(Self.Text), UpperCase(FListBox.Items[I]))<>0)) then FListBox.Items.Delete(I) else inc(I); end; inherited;end;
procedure TEditSearchListBox.CopiaItensList;var I:integer;begin
if (not Assigned(FListBox)) then exit;
SetLength(vet,FListBox.Items.count); for I := LOW(vet) to High(vet) do vet[i]:=FListBox.Items[I];
end;
constructor TEditSearchListBox.Create(AOwner: TComponent);begin
inherited;end;
destructor TEditSearchListBox.Destroy;begin FListBox:=nil; inherited;end;
procedure TEditSearchListBox.PassaItensMatrizList; var I:Integer;begin if not Assigned(FListBox) then exit; FListBox.clear; for I := 0 to Length(vet) - 1 do FListBox.ITEMS.Add(vet[I]);end;
procedure TEditSearchListBox.SetListBox(const Value: TListBox);begin FListBox := Value; CopiaItensList;end;
end.
