unit uBusca;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,EditNew,
Db, DBTables, fOx3Bus, DBGrids, IBQuery, Grids, Buttons, WinTypes,
WinProcs, Rotger,IbDataBase;
type
Tbusca = class(TIbquery)
private
{ Private declarations }
procedure FormkeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState); Protected
procedure FormKeyPress(Sender: TObject; var Key: Char); Protected
procedure DBGrid1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState); Protected
procedure BitBtn2Click(Sender: TObject); Protected
procedure BitBtn1Click(Sender: TObject); Protected
Procedure DBGrid1DblClick(Sender: TObject); Protected
procedure ComboChange(Sender: TObject); Protected
procedure ComboExit(Sender: TObject); Protected
Procedure EditChange(Sender: TObject); Protected
Procedure EditExit(Sender: TObject); Protected
Procedure CarregarDados(Primeiro: Boolean); Protected
Procedure AdPesquisa(Campo,Mascara: String; Campos: String); Protected
Function PegaLargura: Integer; Protected
FTitulo: String;
FCondicaoRetorno: String;
Flargura: Integer;
FModo: TModalREsult;
FMostrarTudo: Boolean;
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner : Tcomponent); override;
procedure Execute;
published
{ Published declarations }
property Titulo: String read FTitulo write FTitulo;
property CondicaoRetorno: String read FCondicaoRetorno write
FCondicaoRetorno;
property Largura: Integer read FLargura write FLargura;
property ModalResult: TModalREsult read Fmodo Write Fmodo;
property MostrarTudo: Boolean read FMostrarTudo Write FMostrarTudo;
end;
procedure Register;
implementation
Var
Qtos: Integer;
c: Tbusca;
procedure Register;
begin
RegisterComponents('Vc', [Tbusca]);
end;
Procedure TBusca.Execute;
Var
I,N: Integer;
Tbus: String;
Vet: Array Of String;
Begin
Fox3Busca:=TfOx3Busca.Create(Application);
Fox3Busca.Width:=PegaLargura;
if Titulo='' then Titulo:='Consulta de Dados.';
CarregarDados(True);
Fox3Busca.Dbgrid1.Options:=[dgTitles,dgColLines,dgIndicator,dgRowLines,dgTabs,dgRowSelect,dgAlwaysShowSelection,dgConfirmDelete];
Fox3Busca.KeyPreview:=True;
Fox3Busca.OnKeyDown:=FormKeyDown;
Fox3Busca.OnKeyPress:=FormKeyPress;
Fox3Busca.suiButton1.OnClick:=BitBtn1click;
Fox3Busca.suiButton2.OnClick:=BitBtn2click;
Fox3Busca.Dbgrid1.OnDblClick:=DBGrid1DblClick;
Fox3Busca.DbGrid1.OnKeyDown:=DbGrid1KeyDown;
Fox3Busca.Combo.OnChange:=ComboChange;
Fox3Busca.Combo.OnExit:=ComboExit;
Fox3Busca.Editn1.OnChange:=EditChange;
Fox3Busca.Editn1.OnExit:=EditExit;
Fox3Busca.Caption:=Titulo;
Fox3Busca.ShowModal;
If Sair=1 Then ModalResult:=MrOk
Else ModalResult:=MrCancel;
Fox3Busca.Free;
End;
procedure Tbusca.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
If Fox3Busca.Combo.Tag<>2 Then
Begin
If Fox3Busca.dbgrid1.Focused Then Exit;
If Key=Vk_Up Then Prior;
If Key=Vk_Down Then Next;
If IntToStr(Key)='34' Then MoveBy(14);
If IntToStr(Key)='33' Then MoveBy(-14);
If (Not Fox3Busca.DbGrid1.Focused) and (Not
Fox3Busca.Suibutton1.Focused) Then
Begin
// If (IntToStr(Key)='38') or (IntToStr(Key)='34') or
(IntToStr(Key)='40') Then Fox3Busca.DbGrid1.SetFocus;
If IntToStr(Key)='13' Then Fox3Busca.suiButton1.SetFocus;
End;
End;
If Key=Vk_F12 Then
Begin
Fox3Busca.Combo.SetFocus;
Fox3Busca.Combo.Tag:=2;
End;
end;
procedure Tbusca.FormKeyPress(Sender: TObject; var Key: Char);
begin
end;
procedure Tbusca.DbGrid1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
If IntToStr(Key)='13' Then Fox3Busca.suiButton1.SetFocus;
end;
procedure Tbusca.BitBtn2Click(Sender: TObject);
Begin
Sair:=2;
Fox3Busca.Close;
End;
procedure Tbusca.BitBtn1Click(Sender: TObject);
Begin
Sair:=1;
Fox3Busca.Close;
End;
procedure Tbusca.DBGrid1DblClick(Sender: TObject);
Var
TqArq: TQuery;
Wcampo: String;
I:Integer;
Begin
// Verifica Campo Retorno
If Not Vazio(CondicaoRetorno) Then
Begin
Wcampo:='';
For I:=1 to Length(CondicaoRetorno) do
Begin
If Vazio(Copy(CondicaoRetorno,I,1)) Then Break;
Wcampo:=Wcampo+Copy(CondicaoRetorno,I,1);
End;
If Not Vazio(Wcampo) Then
Begin
TqArq:=TQuery.Create(Application);
*******************
TqArq.Database:=database; // AQUI EXATAMENTE DA O ERRO - Cannot
assign to a read-only property
*******************
For I:=0 to Sql.Count-1 Do
Begin
If (Pos('ORDER',UpperCase(Sql[i]))<>0) or
(Pos('Where',UpperCase(Sql[i]))<>0) Then Break;
Tqarq.Sql.Add(Sql[i]);
End;
For I:=0 to FieldCount-1 do
begin
If UpperCase(Wcampo)=UpperCase(Fields[i].FieldName) Then
Begin
If Fields[i].DataType=ftInteger Then
Begin
Tqarq.Sql.Add('Where
'+TrocaStr(CondicaoRetorno,Wcampo,InttoStr(Fox3Busca.DataSource1.DataSet.FieldValues[Wcampo])));
End;
End;
End;
Try
Tqarq.Open;
If Tqarq.Recordcount=0 Then ShowMessage('Selecao nao Valida');
Except
End;
End;
End;
Sair:=1;
Fox3Busca.Close;
End;
procedure Tbusca.ComboChange(Sender: TObject);
Begin
CarregarDados(False);
Fox3Busca.Combo.Tag:=1;
Fox3Busca.DbGrid1.SetFocus;
end;
procedure Tbusca.ComboExit(Sender: TObject);
Begin
Fox3Busca.Editn1.Clear;
Fox3Busca.Editn1.SetFocus;
end;
procedure Tbusca.EditChange(Sender: TObject);
Var
CampoPesquisa: String;
begin
If Fox3Busca.Combo.Items.Count<>0 Then
Begin;
CampoPesquisa:=Copy(Fox3Busca.Combo.Text,Pos('@',Fox3Busca.Combo.Text)+1,40);//Copy(Fox3Busca.Combo.Text,1,30);
If Fields[Fox3Busca.Combo.ItemIndex].DataType=FtString Then
Locate(CampoPesquisa,Fox3Busca.Editn1.Text,[LoPartialKey])
Else If Fields[Fox3Busca.Combo.ItemIndex].DataType=FtInteger Then
Begin
If Not Vazio(Fox3Busca.Editn1.Text) Then
Locate(CampoPesquisa,StrtoInt(Fox3Busca.Editn1.Text),[LoPartialKey])
End;
End;
end;
procedure Tbusca.EditExit(Sender: TObject);
begin
If Fox3Busca.DbGrid1.Focused Then Exit;
end;
Procedure Tbusca.CarregarDados(Primeiro: Boolean);
Var
I,N: Integer;
CampoPesquisa,Arquivo,xSql,Campos,Pedaco,Resto: String;
Vet: Array Of String;
begin
Close;
If Not Primeiro Then
Begin
For I:=0 to Sql.Count-1 Do
Begin
If Pos('ORDER',UpperCase(Sql[i]))<>0 Then
Begin
Sql[i]:='Order By
'+Copy(Fox3Busca.Combo.Text,Pos('%',Fox3Busca.Combo.Text)+1,100);
Break;
End;
End;
End;
For I:=0 To Sql.Count-1 Do
Begin
If I=0 Then Campos:=Copy(Sql[i],7,Pos('FROM',UpperCase(Sql[i]))-7);
If Pos('ORDER BY',UpperCase(Sql[i]))<>0 Then
Begin
CampoPesquisa:=TiraBrancos(Copy(Sql[i],Pos('BY',UpperCase(Sql[i]))+2,Length(Sql[i])));
CampoPesquisa:=TiraBrancos(Copy(CampoPesquisa,1,SeInt(Pos(',',CampoPesquisa)=0,Length(CampoPesquisa),Pos(',',CampoPesquisa)-1)));
End;
End;
{ For I:=0 To Sql.Count-1 Do
ShowMessage(Sql[i]);}
Open;
Active:=True;
Fox3Busca.DataSource1.dataset:=Self;
SetLength(Vet,FieldCount);
qtos:=-1;
// Verifica Alinhamentos
For I:=0 to FieldCount-1 do
begin
If Fields[i].DataType=ftCurrency Then
Fields[i].Alignment:=TaRightJustify;
If Fields[i].Visible Then
Begin
Inc(Qtos);
If (Fields[i].DataType=FtString) or (Fields[i].DataType=FtDateTime)
Then
Fox3Busca.DBGrid1.Columns[Qtos].Title.Alignment:=TaCenter;
End;
End;
For I:=0 to FieldCount-1 do
begin
If (Primeiro) and (Fields[i].Visible) and
(Fields[i].FieldKind<>fkCalculated) Then
AdPesquisa(Fields[i].fieldname,Fields[i].DisplayLabel,Campos);
//AdPesquisa(Fields[i].fieldname,Campos);
End;
If Not Primeiro Then
Begin
if fields[Fox3Busca.combo.ItemIndex].DataType=ftString then
Fox3Busca.EditN1.EditType:=etString
else if (fields[Fox3Busca.combo.ItemIndex].DataType=ftFloat) or
(fields[Fox3Busca.combo.ItemIndex].DataType=ftCurrency) then
Fox3Busca.EditN1.EditType:=etFloat
else if (fields[Fox3Busca.combo.ItemIndex].DataType=ftInteger) or
(fields[Fox3Busca.combo.ItemIndex].DataType=ftSmallInt) then
Fox3Busca.EditN1.EditType:=etInteger;
End;
N:=0;
For I:=0 to Fox3Busca.Combo.Items.Count-1 do
Begin
If
UpperCase(CampoPesquisa)=UpperCase(Copy(Fox3Busca.Combo.Items.Strings[i],Pos('%',Fox3Busca.Combo.Items.Strings[i])+1,100))
Then
Begin
N:=I;
Break
End
Else N:=0
End;
Fox3Busca.Combo.Itemindex:=N;
End;
Procedure Tbusca.AdPesquisa(Campo,Mascara:String; Campos: String);
Var
Wpos,I: Integer;
Pedaco,Wvar: String;
Begin
Wpos:=Pos(UpperCase(Campo),UpperCase(Campos));
Wvar:='';
If Wpos<>0 Then
Begin
Pedaco:='';
// Acha o Pedaco antes da variavel Ex C.
for I:=Wpos-1 downto 1 do
Begin
If Copy(Campos,I,1)=',' Then Break;
Pedaco:=Pedaco+Copy(Campos,I,1);
End;
Wvar:='';
// Acerta o Pedaco achado mudando-o de posicao
For I:=Length(Pedaco) DownTo 1 Do
Wvar:=Wvar+Copy(Pedaco,I,1);
If Pos(' AS',UpperCase(Wvar))<>0 Then Wvar:=Copy(Wvar,1,Pos('
AS',UpperCase(Wvar))-1)
Else
Begin
For I:=Wpos to Length(Campos) do
Begin
If (Copy(Campos,I,1)=' ') or (Copy(Campos,I,1)=',') Then Break;
Wvar:=Wvar+Copy(Campos,I,1);
End;
End;
End;
Fox3Busca.Combo.Items.add(Mascara+Repli('
',200)+'@'+PadDir(Campo,40)+'%'+Wvar)
end;
Function Tbusca.PegaLargura: Integer;
Var
I,Wtam,Wret: Integer;
begin
Wtam:=0;
If Largura=0 Then
Begin
For I:=0 To FieldCount-1 Do
If Fields[i].Visible Then Wtam:=Wtam+Fields[i].DisplayWidth;
If Trunc(Wtam*6.50) > Fox3Busca.Width Then Wret:=Trunc(Wtam*6.50)
Else Wret:=Fox3Busca.Width;
End
Else
Begin
Wret:=Largura;
If Wret<Fox3Busca.Width Then Wret:=Fox3Busca.Width;
End;
If Wret>796 Then Wret:=796;
Result:=Wret;
End;
constructor Tbusca.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Largura:=0;
end;
end.
----- Original Message -----
From: "Joao Morais" <[EMAIL PROTECTED]>
To: <[email protected]>
Sent: Tuesday, October 17, 2006 4:14 PM
Subject: Re: [delphi-br] Erro na criação de um componente
> Doretto wrote:
>
>> Eu acho que o problema esta em criar dentro de um componente que é
>> baseado
>> no Ibquery outro ibquery.. ele nao aceita que eu use as propriedades do
>> ibquery...
>
> Poder, pode. Passe a rotina inteira pra gente dar uma olhada.
>
> --
> João Morais
>
>
>
> --
> <<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
>
> Links do Yahoo! Grupos
>
>
>
>
--
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
<*> Para ver as mensagens antigas, acesse:
http://br.groups.yahoo.com/group/delphi-br/messages
<*> Para falar com o moderador, envie um e-mail para:
[EMAIL PROTECTED]
Links do Yahoo! Grupos
<*> Para visitar o site do seu grupo na web, acesse:
http://br.groups.yahoo.com/group/delphi-br/
<*> Para sair deste grupo, envie um e-mail para:
[EMAIL PROTECTED]
<*> O uso que você faz do Yahoo! Grupos está sujeito aos:
http://br.yahoo.com/info/utos.html
