delphi4arab منتديات دلفي للعرب

delphi4arab منتديات دلفي للعرب > منتديات دلفي للعرب التعليمية > سؤال و جواب حول دلفي > تلوين البحث و التغيير Search And Replace
نسخة كاملة : تلوين البحث و التغيير Search And Replace
أنت حالياً تتصفح نسخة خفيفة من المنتدى . مشاهدة نسخة كاملة مع جميع الأشكال الجمالية .
الصفحات : 1 2

cargem

17-05-2011, 04:11 PM
كيف نصحح هذه التابع لكي يعمل 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

18-05-2011, 10:46 AM
السلام عليكم
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

18-05-2011, 04:00 PM
ماشاء الله تبارك الله
كود متمكن من مبرمج بارع
النتيجة 100 /100
ولكن سؤال اخر
هل يمكن التميز بخط تحت الكلمة وتلوينه
2- هل ممكن نعمل background color

تحياتي

cargem

18-05-2011, 04:11 PM
هناك مشكلة!!
عندما تكون الكلمة المستبدلة مشابهه للكلمة الاصلية يحدث تعليق ولا يتوقف while loop
وهذا مثال
PHP كود :
procedure TForm1.btn1Click(Sender: TObject);
begin
  SearchAndReplace_color(redt1, 'SDK', 'mSDKb', Col[1]);
end; 

TF6M

19-05-2011, 12:55 AM
- تعديل بسيط , أرجــوا أن يفيدك لست متأكد 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

19-05-2011, 02:51 PM
ماشاء الله
لقد ابدعت ابداعا خارقا
المشكلة انتهت تماما

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

cargem

19-05-2011, 02:59 PM
هناك مشكلة في background color
ان background color اصبحت للكود بأكملة وليس الكلمة المستبدلة المراد تميزها
تحياتي

kachwahed

19-05-2011, 03:49 PM
للتذكير فقط، 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

19-05-2011, 04:33 PM
السلام عليكم
PHP كود :
SendMessage(RichEdit.Handle,(WM_USER + 68), $0004,Longint(@Format)); //SCF_SELECTION=$0001 

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

cargem

19-05-2011, 05:15 PM
صحيح تغير الى 4 ينجح ولكن واحد فقط وليس الكل انظر الصورة
[صورة: picture0002lr.png]
الصفحات : 1 2
delphi4arab منتديات دلفي للعرب > منتديات دلفي للعرب التعليمية > سؤال و جواب حول دلفي > تلوين البحث و التغيير Search And Replace