delphi4arab منتديات دلفي للعرب - البحث في عنصر RichtEdit

الصفحات : 1 2 3

كود :
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
ما وضعهم في المعادلة وهم خارج الحلقة؟
وضح لنا الامر ؟

تحياتي

السلام عليكم
BeginUpdate قبل بداية التعديل EndUpdate عند نهاية التعديل

وعليكم السلام
وعند الاستغناء عنهم ماذا يحصل؟
من كلامك استنتج ان كلا التابعين يتطلب وجودهم في كل T.....list (string)
اي في اي class(string)
او القوائم ومنافذ تحرير النصوص بشكل عــــــــــــــــام

BeginUpdate يضل في وضع التشغيل الى ان تعمل ايقاف لعملية التنصيص والتعديل بأستخدام
EndUpdate وكأنهم switches

وفي حالة عدم استخدامهم !!!
وضح الفارق من وجودهم او عدم وجودهم؟
تحياتي

انزع BenginUpadate/EndUpdate و لاحظ التذبذب
هنالك شئ ثاني مع BenginUpadate/EndUpdate تتم العملية بسرعة
بالتوفيق أخي Smile

صحيح تتم العملية بسرعة
اذا طلبت منك الاستغناء عن دالة
FindText
كيف تحل المسئلة؟

كود :
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;

باستخدام الدالة Pos
للمزيد من المعلومات أنظر هذا الموضوع
http://www.delphi4arab.net/forum/showthr...p?tid=2584

للاسف
اخي paix144 حلك غير صحيح
pos لا تنفع في هذه الحالات
لونها وانت تعرف
حاول مرة اخرى

وهذه محاولتي الخاطئة ايضا
لابد ان نضبط المسألة
[صورة: 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 لا فائدة تذكر في هذه الحالة

cargem كتب :للاسف
اخي paix144 حلك غير صحيح
pos لا تنفع في هذه الحالات

الكود الذي طرحته يعمل
أنظر المرفقات
و الدالة الخاصة بالأخ kachwahed تعمل أيضا(في حالة الاخkachwahed استعملSearchBuf )

الكود يبحث عن اول كلمة فقط وليس كل الكلمات الموجودة في النص
لون الكود وانت ستعرف الفرق
انا جربت الكود السابق ولا يحقق المطلوب

لا تقول بسبب 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;

الصفحات : 1 2 3