+- delphi4arab منتديات دلفي للعرب (https://delphi4arab.net/forum)
+-- قسم : منتديات دلفي للعرب التعليمية (https://delphi4arab.net/forum/forumdisplay.php?fid=3)
+--- قسم : سؤال و جواب حول دلفي (https://delphi4arab.net/forum/forumdisplay.php?fid=15)
+--- الموضوع : البحث في عنصر RichtEdit (/showthread.php?tid=3427)
البحث في عنصر RichtEdit - cargem - 03-10-2011
كود :
function SearchForText_AndSelect(RichEdit: TRichEdit; SearchText: string; Fgetcolor: Tcolor): Boolean;
var
StartPos, Position, Endpos: Integer;
begin
StartPos := 0;
with RichEdit do
begin
Endpos := Length(RichEdit.Text);
Lines.BeginUpdate;
while FindText(SearchText, StartPos, Endpos, [stMatchCase])<>-1 do
begin
Endpos := Length(RichEdit.Text) - startpos;
Position := FindText(SearchText, StartPos, Endpos, [stMatchCase]);
Inc(StartPos, Length(SearchText));
SetFocus;
SelStart := Position;
SelLength := Length(SearchText);
SelAttributes.Color:=Fgetcolor;
SelAttributes.Style:=[fsBold];
end;
Lines.EndUpdate;
end;
end;كود :
procedure TForm1.Button1Click(Sender: TObject);
begin
SearchForText_AndSelect(RichEdit1, Edit1.Text,ColorBox1.Selected)
end;بصراحة حل موفق
وينك من الاول
بخصوص
Lines.BeginUpdate;
Lines.EndUpdate
ما وضعهم في المعادلة وهم خارج الحلقة؟
وضح لنا الامر ؟
تحياتي
البحث في عنصر RichtEdit - paix144 - 03-10-2011
السلام عليكم
BeginUpdate قبل بداية التعديل EndUpdate عند نهاية التعديل
البحث في عنصر RichtEdit - cargem - 03-10-2011
وعليكم السلام
وعند الاستغناء عنهم ماذا يحصل؟
من كلامك استنتج ان كلا التابعين يتطلب وجودهم في كل T.....list (string)
اي في اي class(string)
او القوائم ومنافذ تحرير النصوص بشكل عــــــــــــــــام
BeginUpdate يضل في وضع التشغيل الى ان تعمل ايقاف لعملية التنصيص والتعديل بأستخدام
EndUpdate وكأنهم switches
وفي حالة عدم استخدامهم !!!
وضح الفارق من وجودهم او عدم وجودهم؟
تحياتي
البحث في عنصر RichtEdit - paix144 - 03-10-2011
انزع BenginUpadate/EndUpdate و لاحظ التذبذب
هنالك شئ ثاني مع BenginUpadate/EndUpdate تتم العملية بسرعة
بالتوفيق أخي
البحث في عنصر RichtEdit - cargem - 04-10-2011
صحيح تتم العملية بسرعة
اذا طلبت منك الاستغناء عن دالة
FindText
كيف تحل المسئلة؟
البحث في عنصر RichtEdit - paix144 - 04-10-2011
كود :
procedure TForm1.Button1Click(Sender: TObject);
var
L,M,i,j : integer;
found : boolean;
begin
found := false;
for i := 0 To RichEdit1.Lines.Count do
begin
L:=[color=Red]pos[/color](Edit1.Text,RichEdit1.Lines[i]);
Label1.Caption:='la ligne de texte est a la position '+ IntToStr(i+1);
if L <> 0 then
begin
M := 0;
for j := 0 to i-1 do
M := M+length(RichEdit1.Lines[j]);
M := M+(i*2);
M := M+L-1;
RichEdit1.SetFocus;
RichEdit1.SelStart := M;
RichEdit1.SelLength := length(Edit1.Text);
found := True;
Break;
end;
end;
If found =False then
ShowMessage('Non trouvé!!');
end;للمزيد من المعلومات أنظر هذا الموضوع
http://www.delphi4arab.net/forum/showthread.php?tid=2584
البحث في عنصر RichtEdit - cargem - 05-10-2011
للاسف
اخي paix144 حلك غير صحيح
pos لا تنفع في هذه الحالات
لونها وانت تعرف
حاول مرة اخرى
البحث في عنصر RichtEdit - cargem - 05-10-2011
وهذه محاولتي الخاطئة ايضا
لابد ان نضبط المسألة
![[صورة: picture0001v.png]](http://img200.imageshack.us/img200/7527/picture0001v.png)
كود :
procedure TForm1.GetTextColor(FRichEdit: TRichEdit; SearchTxt: string;
Fgetcolor: Tcolor);
var
i, j, t, Len, StartPos: integer;
FRichEditTemp: TRichEdit;
StrFind, TempStr: string;
StrBuffer: TStringList;
begin
// StrFind := SearchTxt;
Len := 0;
j := 0;
t := 1;
inc(j);
StartPos := j;
// StrBuffer:= TStringList.Create();
// try
for i := 0 to FRichEdit.Lines.Count - 1 do
begin
// FRichEdit.Text:= GetSwapUpToDownText(FRichEdit.Text);
FRichEdit.Lines.BeginUpdate;
TempStr := FRichEdit.Lines.Strings[i];
// StartPos:=Pos(SearchTxt, TempStr);
// j :=PosEx(SearchTxt, FRichEdit.Text, StartPos) ;
while PosEx(SearchTxt, FRichEdit.Text, StartPos) > 0 do
Begin
j := PosEx(SearchTxt, FRichEdit.Text, StartPos);
// FRichEdit.Lines.Strings[i];
// for i := 0 to FRichEdit.Lines.Count - 1 do
// begin
if FRichEdit.Lines.IndexOf(TempStr)=t-1 then
begin
FRichEdit.SelectAll;
// FRichEdit.SelAttributes.Color := clWindowText; -3
FRichEdit.SetFocus;
FRichEdit.SelStart := j- t ;
FRichEdit.SelLength := length(SearchTxt);
FRichEdit.SelAttributes.Style := [fsBold];
FRichEdit.SelAttributes.Color := Fgetcolor;
end;
// end;
StartPos := j + 1;
FRichEdit.Lines.EndUpdate;
End;
inc(t);
StartPos := 1;
Len := Len + length(TempStr);
// StartPos:=length(TempStr)-StartPos;
// FRichEdit.Lines.Exchange(i,FRichEdit.Lines.Count-1 );
// end;
/// / FRichEdit.Text:= FRichEditTemp.Text ;
// finally
/// / FRichEditTemp.FreeOnRelease;
// end;
end;
end;كود :
procedure TForm1.Button1Click(Sender: TObject);
begin
GetTextColor(RichEdit1, Edit1.Text, clred);
end;BenginUpadate/EndUpdate لا فائدة تذكر في هذه الحالة
البحث في عنصر RichtEdit - paix144 - 05-10-2011
cargem كتب :للاسفالكود الذي طرحته يعمل
اخي paix144 حلك غير صحيح
pos لا تنفع في هذه الحالات
أنظر المرفقات
و الدالة الخاصة بالأخ kachwahed تعمل أيضا(في حالة الاخkachwahed استعملSearchBuf )
البحث في عنصر RichtEdit - cargem - 06-10-2011
الكود يبحث عن اول كلمة فقط وليس كل الكلمات الموجودة في النص
لون الكود وانت ستعرف الفرق
انا جربت الكود السابق ولا يحقق المطلوب
لا تقول بسبب break
ليس له تأثير حتى لوحدفتة
تذكر ان المطلوب الاستغناء عن findText
للعلم ان حلي صحيح 100% كبحث عن نص في كل الاسطر ولكن مع تميز بالتلوين يعتبر خطا
انظر الى هذا السطر
إقتباس :FRichEdit.SelStart := j- t ;قيمة t اذا اخدت 1 او غيرتها ب 1
تعطي اجابة صحيحة 100%100
ونفس الشيء بالنسبة للاسطر البقية
ولكن ليس الكل لابد من تعديل
نفس المشكلة حتى هنا
كود :
procedure TForm1.Button1Click(Sender: TObject);
begin
GetTextColor(RichEdit1, Edit1.Text, clred);
end;
procedure TForm1.GetTextColor(FRichEdit: TRichEdit; SearchTxt: string;
Fgetcolor: Tcolor);
var
i, j, t, Len, StartPos, intindex: integer;
FRichEditTemp: TRichEdit;
StrFind, TempStr: string;
StrBuffer: TStringList;
begin
Len := 0;
j := 0;
t := 1;
inc(j);
StartPos := j;
StrBuffer := TStringList.Create();
try
j := PosEx(SearchTxt, FRichEdit.Text, StartPos);
while j > 0 do
Begin
j := PosEx(SearchTxt, FRichEdit.Text, StartPos);
StrBuffer.Add(IntToStr(j));
StartPos := j + length(SearchTxt);
End;
FRichEdit.Lines.Add(StrBuffer.Text);
for i := 0 to StrBuffer.Count - 1 do
begin
FRichEdit.Lines.BeginUpdate;
intindex := StrToInt(StrBuffer.Strings[i]);
if intindex <= 0 then
Continue;
FRichEdit.SelStart := intindex - 3;
FRichEdit.SelLength := length(SearchTxt);
FRichEdit.SelAttributes.Style := [fsBold];
FRichEdit.SelAttributes.Color := Fgetcolor;
FRichEdit.Lines.EndUpdate;
// end;
FRichEdit.Lines.EndUpdate;
end;
finally
StrBuffer.Free;
end;محاولة اخرى
كود :
procedure TForm1.Button1Click(Sender: TObject);
begin
GetTextColor(RichEdit1, Edit1.Text, clred);
end;
procedure TForm1.GetTextColor(FRichEdit: TRichEdit; SearchTxt: string;
Fgetcolor: Tcolor);
var
i, j, t, Len, StartPos, intindex: integer;
StrFind, TempStr: string;
StrBuffer: TStringList;
begin
Len := 0;
StartPos := 0;
t := 0;
inc(StartPos);
FRichEdit.Lines.BeginUpdate;
for j := 0 to FRichEdit.Lines.Count - 1 do
begin
Len := Len + length(FRichEdit.Lines.Strings[j]);
while PosEx(SearchTxt,FRichEdit.Text, StartPos) > 0 do
Begin
intindex := PosEx(SearchTxt,FRichEdit.Text , StartPos)-1;
if intindex <= 0 then
Continue;
if intindex > Len then
begin
break;
end;
FRichEdit.SelStart := intindex - j;
FRichEdit.SelLength := length(SearchTxt);
FRichEdit.SelAttributes.Style := [fsBold];
FRichEdit.SelAttributes.Color := Fgetcolor;
StartPos := intindex + length(SearchTxt);
End;
end;
FRichEdit.Lines.EndUpdate;
end;