تلوين البحث و التغيير Search And Replace

[cargem]

كيف نصحح هذه التابع لكي يعمل SearchAndReplace
مع تميز القيمة المستبدلة بلون معين
انا حاولت اكتب ولكن بأخطاء
ممكن تحاولوا معي

PHP كود :

const
  col: array[0..5] of TColor = (clRed, clGreen, clNavy, clBlue, clAqua, clLime);

procedure SearchAndReplace_color(richedit: TRichEdit; sLookFor, sReplaceWith:
  string; col: TColor);
var
  nPos, nLenLookFor, nLenReplaceWith: integer;
  sSrc: string;
begin
  sSrc := richedit.Text;
  nPos := Pos(sLookFor, sSrc);
  nLenLookFor := Length(sLookFor);
  nLenReplaceWith := Length(sReplaceWith);
  while (nPos > 0) do
  begin
    //   richedit.Text := sSrc;
    Delete(sSrc, nPos, nLenLookFor);
    Insert(sReplaceWith, sSrc, nPos);
    with richedit do
    begin

      //      SelText := sReplaceWith;
      SelStart := nPos ;
      SelLength := nLenReplaceWith;
      SelAttributes.Color := col;

    end;
    //

    //
    nPos := Pos(sLookFor, sSrc);
    //    Delete(sSrc, nPos, nLenLookFor);
    //    Insert(sReplaceWith, sSrc, nPos);
  end; 


كود :

procedure TForm1.btn1Click(Sender: TObject); begin SearchAndReplace_color(redt1, 'SDK', 'RRR', Col[0]); end;

مثال

PHP كود :

Here we provide you SDK links to 
the 
latest SDK updates for different 
satellite SDK in order to SDK 
your box updated with the 
permanently SDK satellite 
channel SDK. 


[TF6M]

السلام عليكم

PHP كود :

Const
  col: array[1..6] of Dword =($0000FF, $008000, $800000,
                              $FF0000, $FFFF00, $00FF00);
  
{$WARNINGS OFF} {$HINTS OFF}
{$O ON}{$OverFlowChecks OFF}
Procedure SearchAndReplace_color(Richedit: TRichEdit; sLookFor, sReplaceWith:string; col: Dword);
          {$IF CompilerVersion >= 17}Inline;{$IFEND}
Var
  nPos : Integer;
  Tmp  : String ;
Begin
nPos:= Pos(sLookFor, Richedit.Text);
Tmp:= Richedit.Text;
Richedit.Text  := StringReplace(Richedit.Text, sLookFor, sReplaceWith,
                          [rfReplaceAll, rfIgnoreCase]);
 While (nPos > 0) do
 Begin
  With Richedit do
   Begin
    SelStart := nPos - 1 ;
    SelLength := Length(sReplaceWith);
    SelAttributes.Color := col;
   End;

 nPos := Pos(sLookFor, Tmp);
 Tmp  := StringReplace(Tmp, sLookFor, sReplaceWith,[rfIgnoreCase]);
 End;
End; 


بالتوفيق,,

[cargem]

ماشاء الله تبارك الله
كود متمكن من مبرمج بارع
النتيجة 100 /100
ولكن سؤال اخر
هل يمكن التميز بخط تحت الكلمة وتلوينه
2- هل ممكن نعمل background color

تحياتي

[cargem]

هناك مشكلة!!
عندما تكون الكلمة المستبدلة مشابهه للكلمة الاصلية يحدث تعليق ولا يتوقف while loop
وهذا مثال

PHP كود :

procedure TForm1.btn1Click(Sender: TObject);
begin
  SearchAndReplace_color(redt1, 'SDK', 'mSDKb', Col[1]);
end; 


[TF6M]

- تعديل بسيط , أرجــوا أن يفيدك لست متأكد 100% :

PHP كود :

{$WARNINGS OFF} {$HINTS OFF}
{$O ON}{$OverFlowChecks OFF}

Type
  CHARFORMAT = record
    cbSize: UINT;
    dwMask: DWORD;
    dwEffects: DWORD;
    yHeight: Longint;
    yOffset: Longint;
    crTextColor: TColorRef;
    bCharSet: Byte;
    bPitchAndFamily: Byte;
    szFaceName: array[0..LF_FACESIZE - 1] of AnsiChar;
    wWeight: Word;                   { Font weight (LOGFONT value)         }
    sSpacing: Smallint;              { Amount to space between letters     }
    crBackColor: TColorRef;          { Background color                     }
    lid: LCID;                       { Locale ID                         }
    dwReserved: DWORD;               { Reserved. Must be 0                 }
    sStyle: Smallint;                { Style handle                         }
    wKerning: Word;                  { Twip size above which to kern char pair }
    bUnderlineType: Byte;            { Underline type                     }
    bAnimation: Byte;                { Animated text like marching ants     }
    bRevAuthor: Byte;                { Revision author index             }
    bReserved1: Byte;
 End;

Type
 TOrdArr = Array [0..500] Of Word; //500 Mush String & 65535 Max Ord !
Var
 MyArr: TOrdArr;

Procedure GetOrdArr(_Text,sLookFor:String);
{$IF CompilerVersion >= 17}Inline;{$IFEND}
Var
 i: Word;
Begin
{Initialize Vars}
i:= 1; MyArr[0]:= 0;
While Pos(sLookFor, _Text) > 0 Do
Begin
 MyArr[i]:=Pos(sLookFor, _Text) + MyArr[i-1];
 _Text:=Copy(_Text,(Pos(sLookFor, _Text)+1),Length(_Text));
Inc(i);
End;
End;

Const
  col: array[1..6] of Dword =($0000FF, $008000, $800000,
                              $FF0000, $FFFF00, $00FF00);

Procedure SearchAndReplace_color(Richedit: TRichEdit; sLookFor, sReplaceWith:string; col: Dword);
          {$IF CompilerVersion >= 17}Inline;{$IFEND}
Var
  nPos : Integer;
  i: Word;
Begin
nPos:= Pos(sLookFor, Richedit.Text);
Richedit.Text  := Trim(StringReplace(Richedit.Text,
                                     sLookFor     ,
                                     sReplaceWith ,
                                     [rfReplaceAll{,rfIgnoreCase}]));
GetOrdArr(Richedit.Text,sReplaceWith);
i:= 1;
 While (MyArr[i] > 0) do
 Begin
  With Richedit do
   Begin
    SelStart := MyArr[i]-1;
    SelLength := Length(sReplaceWith);
    SelAttributes.Color := col;
    inc(i);
   End;
 End;
End;

procedure SetRichEditBgColor(RichEdit: TRichEdit; AColor: Dword);
                       {$IF CompilerVersion >= 17}Inline;{$IFEND}
var
  Format: CHARFORMAT;
begin
  FillChar(Format, SizeOf(Format), 0);
  with Format do
  begin
    cbSize := SizeOf(Format);
    dwMask := $04000000;
    crBackColor := AColor;
    SendMessage(RichEdit.Handle,(WM_USER + 68), $0004,Longint(@Format)); //SCF_SELECTION=$0001  
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 SearchAndReplace_color(redt1, 'SDK', 'xxx', Col[1]);
 //SetRichEditBgColor(redt1, $FFFF00);
end; 


بالتوفيق,,

[cargem]

ماشاء الله
لقد ابدعت ابداعا خارقا
المشكلة انتهت تماما

بالامانة الكود الذي عملته جبار لقد صدمتنا فعلا
انا اشكرك على هذا التألق
تحياتي

[cargem]

هناك مشكلة في background color
ان background color اصبحت للكود بأكملة وليس الكلمة المستبدلة المراد تميزها
تحياتي

[kachwahed]

للتذكير فقط، TRichEdit يملك تابع للبحث FindText مباشرة:

PHP كود :

aPos := RichEdit1.FindText('SearchStr', StartPos, Length, [stMatchCase, stWholeWord]); 


ويرجع موضع النص محل البحث...

هناك مشكلة في background color

جرب:

PHP كود :

Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format)); 


المصدر:

كود :

http://www.delphipages.com/forum/showthread.php?tid=203456

[maryhelin]

السلام عليكم

PHP كود :

SendMessage(RichEdit.Handle,(WM_USER + 68), $0004,Longint(@Format)); //SCF_SELECTION=$0001 


يكفي استبدال القيمة 4 التي تعني تحديد الكل بالقيمة 1
لتلوين الجزء المحدد

[cargem]

صحيح تغير الى 4 ينجح ولكن واحد فقط وليس الكل انظر الصورة