+- delphi4arab منتديات دلفي للعرب (https://delphi4arab.net/forum)
+-- قسم : منتديات دلفي للعرب التعليمية (https://delphi4arab.net/forum/forumdisplay.php?fid=3)
+--- قسم : سؤال و جواب حول دلفي (https://delphi4arab.net/forum/forumdisplay.php?fid=15)
+--- الموضوع : تلوين البحث و التغيير Search And Replace (/showthread.php?tid=3093)
الصفحات:
1
2
تلوين البحث و التغيير Search And Replace - cargem - 17-05-2011
كيف نصحح هذه التابع لكي يعمل 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.
تلوين البحث و التغيير Search And Replace - TF6M - 18-05-2011
السلام عليكم
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;
تلوين البحث و التغيير Search And Replace - cargem - 18-05-2011
ماشاء الله تبارك الله
كود متمكن من مبرمج بارع
النتيجة 100 /100
ولكن سؤال اخر
هل يمكن التميز بخط تحت الكلمة وتلوينه
2- هل ممكن نعمل background color
تحياتي
تلوين البحث و التغيير Search And Replace - cargem - 18-05-2011
هناك مشكلة!!
عندما تكون الكلمة المستبدلة مشابهه للكلمة الاصلية يحدث تعليق ولا يتوقف while loop
وهذا مثال
PHP كود :
procedure TForm1.btn1Click(Sender: TObject);
begin
SearchAndReplace_color(redt1, 'SDK', 'mSDKb', Col[1]);
end;
تلوين البحث و التغيير Search And Replace - TF6M - 19-05-2011
- تعديل بسيط , أرجــوا أن يفيدك لست متأكد 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;
تلوين البحث و التغيير Search And Replace - cargem - 19-05-2011
ماشاء الله
لقد ابدعت ابداعا خارقا
المشكلة انتهت تماما
بالامانة الكود الذي عملته جبار لقد صدمتنا فعلا
انا اشكرك على هذا التألق
تحياتي
تلوين البحث و التغيير Search And Replace - cargem - 19-05-2011
هناك مشكلة في background color
ان background color اصبحت للكود بأكملة وليس الكلمة المستبدلة المراد تميزها
تحياتي
تلوين البحث و التغيير Search And Replace - kachwahed - 19-05-2011
للتذكير فقط، 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تلوين البحث و التغيير Search And Replace - maryhelin - 19-05-2011
السلام عليكم
PHP كود :
SendMessage(RichEdit.Handle,(WM_USER + 68), $0004,Longint(@Format)); //SCF_SELECTION=$0001
يكفي استبدال القيمة 4 التي تعني تحديد الكل بالقيمة 1
لتلوين الجزء المحدد
تلوين البحث و التغيير Search And Replace - cargem - 19-05-2011
صحيح تغير الى 4 ينجح ولكن واحد فقط وليس الكل انظر الصورة
![[صورة: picture0002lr.png]](http://img703.imageshack.us/img703/9122/picture0002lr.png)