جستجو در DBMemo و DBGrid

[shareh]

من برای جستجو در دیتابیس از این کد استفاده نمودم

.adoQuery1.Active:=FALSE;
adoQuery1.SQL.Clear;
adoQuery1.SQL.Add('SELECT * ');
adoQuery1.SQL.Add('FROM table1');
adoQuery1.SQL.Add('WHERE (file1 like ''%'+ edit1.TEXT+'%'') ');
adoQuery1.ExecSQL;
.adoQuery1.Active:=TRUE;

اما می خوام یه کار دیگه هم انجام بده
نتایج جستجو را در DBMemo و DBGrid با رنگ دیگری نشان بدهد

لطفا راهنمایی بفرمایید

[nasr]

مقدار File1 در دیتابیس از چه نوعی است
عدد یا رشته؟

[shareh]

رشته از نوع memo

[vcldeveloper]

خط AdoQuery1.ExecQuery اضافه هست و ربطی به کاری که شما انجام میدید نداره (قبلا بحث شده).
DBGrid اطلاعات فیلدهای Memo را نمایش نمیده.
برای تغییر در نحوه نمایش محتویات یک فیلد بدون ثبت تغییرات اعمال شده (مثل highlight کردن نتایج یک جستجو)، می تونید از کامپوننت هایی که Data-aware نیستند استفاده کنید، مثلا RichEdit یا Memo معمولی. برای پیدا کردن متن در کنترل مربوطه می تونید از تابع Pos ، و برای Highlight کردنش هم از خصوصیت های SelStart, SelLength و SelAttribute استفاده کنید.

[solook]

اتفاقا من هم همین مورد را می خوام.
اگه کسی می تونه با همون کد راهی نشون بده که نتیجه جستجو را بصورت رنگی نشون بده خیلی متشکر می شم

[nasr]

فکر کنم خوب باشه



unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
x: Integer;
find: Boolean = False;
implementation
{$R *.dfm}
//Suchenbutton:
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
a: string;
begin
Memo1.Lines.Add('');
Memo1.Lines.Text := ' ' + Memo1.Lines.Text;
for i := 0 to Length(Memo1.Lines.Text) - Length(edit1.Text) do
begin
a := Copy(Memo1.Lines.Text, i, Length(edit1.Text));
if CheckBox1.Checked = True then
begin
if a = edit1.Text then
begin
find := True;
x := 2;
Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
Memo1.SetFocus;
Memo1.SelStart := i - 2;
Memo1.SelLength := Length(edit1.Text);
break;
end;
end
else
begin
if lowercase(a) = lowercase(edit1.Text) then
begin
Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
find := True;
x := 2;
Memo1.SetFocus;//delphi-center.blogfa.com
Memo1.SelStart := i - 2;
Memo1.SelLength := Length(edit1.Text);
break;
end;
end;
end;
if find = False then ShowMessage('SuchString nicht gefunden')
else
find := False;
end;
//Weitersuchenbutton:
procedure TForm1.Button2Click(Sender: TObject);
var//delphi-center.blogfa.com
i: Integer;
a: string;
d: Integer;
begin
d := 0;
for i := 0 to Length(Memo1.Lines.Text) - Length(edit1.Text) do
begin
a := Copy(Memo1.Lines.Text, i, Length(edit1.Text));
if CheckBox1.Checked = True then
begin
if a = edit1.Text then
begin
d := d + 1;
if d = x then
begin
find := True;
x := x + 1;
Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
Memo1.SetFocus;
Memo1.SelStart := i - 1;
Memo1.SelLength := Length(edit1.Text);
break;
Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
end;
end;
end
else
begin
if lowercase(a) = lowercase(edit1.Text) then
begin
d := d + 1;
if d = x then
begin
find := True;
x := x + 1;//delphi-center.blogfa.com
Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
Memo1.SetFocus;
Memo1.SelStart := i - 1;
Memo1.SelLength := Length(edit1.Text);
break;
Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
end;
end;
end;
end;
if find = False then ShowMessage('SuchString nicht gefunden')
else
find := False;
end;

[vcldeveloper]

وقتی توابعی مثل Pos و PosEx در دلفی آماده هستند، نیازی نیست برای مشخص کردن مکان یک متن در داخل متن دیگر اینقدر کد بنویسید.

[solook]

ضمن عرض تشکر از دوستان
علی اقای کشاورز لطفا در مورد Pos و PosEx بیشتر توضیح بدید و اگه براتون ممکنه یه مثال بزنید و در ضمن DBGrid اطلاعات فیلدهای Memo را نمایش میده البته با اضافه کردن یک خط کد
در قسمتOnGetText این کد را اضافه می کنیم :


procedure TForm1.DBTableDataGetText( Sender: TField;
var Text: String; DisplayText: Boolean);
begin Text := Copy(DBTableData.AsString, 1, 50);
end




اما سوال من اینست که آیا میشه با توابع Pos و PosEx در DBMemo جستجو کرد و نتایج را با رنگ دیگر مشخص نمود یا نه ؟

[vcldeveloper]

برای تابع Pos در راهنمای دلفی مثال زده شده. PosEx هم در راهنمای دلفی توضیح داده شده. فقط دقت کنید که PosEx در یونیت StrUtils قرار داره.
این دو تابع فقط مکان متن مشخص شده را در رشته مورد نظر پیدا می کنند، رنگ متن پیدا شده را تغییر نمیدند. برای تغییر رنگ باید از متدهای SelStart, SelLength و SelAttribute مربوط به TRichEdit استفاده کنید. برای این توابع هم در راهنمای دلفی یک مثال وجود داره که متن خاصی را در RichEdit جستجو می کنه و اونو highlight میکنه:
از Help دلفی:


This example requires a TRichEdit, a TButton, and a TFindDialog.
Clicking the button click will display a Find Dialog to the right of the edit
control. Filling in the "Find what" text and pressing the Find Next button
will select the first matching string in the Rich Edit control that follows
the previous selection.


procedure TForm1.Button1Click(Sender: TObject);

begin
FindDialog1.Position := Point(RichEdit1.Left + RichEdit1.Width, RichEdit1.Top);
FindDialog1.Execute;
end;

procedure TForm1.FindDialog1Find(Sender: TObject);
var
FoundAt: LongInt;
StartPos, ToEnd: Integer;
begin
with RichEdit1 do
begin
{ begin the search after the current selection if there is one }
{ otherwise, begin at the start of the text }
if SelLength <> 0 then

StartPos := SelStart + SelLength
else

StartPos := 0;

{ ToEnd is the length from StartPos to the end of the text in
the rich edit control }

ToEnd := Length(Text) - StartPos;

FoundAt := FindText(FindDialog1.FindText, StartPos, ToEnd, [stMatchCase]);
if FoundAt <> -1 then
begin
SetFocus;
SelStart := FoundAt;
SelLength := Length(FindDialog1.FindText);
end;
end;
end;

[solook]

من یک کد اماده کردم و خوب جواب داد .اما فقط رکود اول را رنگی کرد و رکوردها بعدی را پیدا کرد ولی انها رنگی نکرد:


procedure TForm4.Button1Click(Sender: TObject);
var
Txt,WrdS:String;
N,Start,Len,temp:integer;
First:boolean;
begin
DataModule2.adoQuery3.Active:=FALSE;
DataModule2.adoQuery3.SQL.Clear;
DataModule2.adoQuery3.SQL.Add('SELECT * ');
DataModule2.adoQuery3.SQL.Add('FROM nahj');
DataModule2.adoQuery3.SQL.Add('WHERE (farsi like ''%'+ edit1.TEXT+'%'') ');
DataModule2.adoQuery3.ExecSQL;
DataModule2.adoQuery3.Active:=TRUE;
dbRichEdit1.SelStart:=0;
dbRichEdit1.SelLength:=length(dbRichEdit1.Text);
CurrText.Color:=clBlack;
txt:=trim(dbrichedit1.Text);
wrds:=trim(edit1.Text);
temp:=0;
First:=true;
Repeat
Len:=length(wrds);
Start:=pos(wrds,txt);
if Start<>0 then
begin
if First then
begin
temp:=Start+temp;
First:=false
end
else
temp:=Start+len+temp;
dbRichEdit1.SelStart:=temp-1;
dbRichEdit1.SelLength:=Len;

CurrText.Color:=clRed ;
end;

delete(txt,1,Start+len);
until Start=0;


end;

چه کار باید کرد تا رکوردهای بعدی را هم مانند رکورد اولی رنگی کند

[MNosouhi]

چه کار باید کرد تا رکوردهای بعدی را هم مانند رکورد اولی رنگی کند
سلوک جان من که قبلا لینکش رو برات فرستادم ، اونی که برات فرستادم با richedit کار میکنه ، وحالا شما میخای با dbrichedit کار کنی که هیچ فرقی نمیکنه.