delphi4arab منتديات دلفي للعرب
كيفية تغير لون او نوع خط كلمة معيتة في عنصر memo برمجيا - نسخة قابلة للطباعة

+- delphi4arab منتديات دلفي للعرب (https://delphi4arab.net/forum)
+-- قسم : منتديات دلفي للعرب التعليمية (https://delphi4arab.net/forum/forumdisplay.php?fid=3)
+--- قسم : سؤال و جواب حول دلفي (https://delphi4arab.net/forum/forumdisplay.php?fid=15)
+--- الموضوع : كيفية تغير لون او نوع خط كلمة معيتة في عنصر memo برمجيا (/showthread.php?tid=3406)



كيفية تغير لون او نوع خط كلمة معيتة في عنصر memo برمجيا - abdelali91 - 08-09-2011

السلام عليكم

كيف تغير نمط خط أو لون كلمة معينة موجودة في عنصر memo وليس النص كاملا
شكرا


كيفية تغير لون او نوع خط كلمة معيتة في عنصر memo برمجيا - cargem - 08-09-2011

لا يمكن عمل ذللك ألا بأستخدام Richedit.pas


كيفية تغير لون او نوع خط كلمة معيتة في عنصر memo برمجيا - cargem - 08-09-2011

[صورة: picture0002x.png]

كود :
unit d_RuntimeMain; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, LMDRTFRichEdit, LMDRTFActions, ActnList, ComCtrls, ToolWin, ImgList, ExtDlgs, LMDRTFBase, LMDRTFStorage, LMDCustomComponent; type TfromRuntimeDemo = class(TForm) Panel1: TPanel; btnSelectText: TButton; btnChangeTextAttr: TButton; btnReplSelText: TButton; btnChangeJust: TButton; btnLoadFile: TButton; btnParaDialog: TButton; btnFind: TButton; btnInsertBMP: TButton; Splitter1: TSplitter; btnSaveAsHTML: TButton; btnReplace: TButton; btnCopy: TButton; panLeft: TPanel; LMDRichEdit1: TLMDRichEdit; panLeftActive: TPanel; panRight: TPanel; panRightActive: TPanel; LMDRichEdit2: TLMDRichEdit; LMDRichStorage1: TLMDRichStorage; Label1: TLabel; procedure btnSelectTextClick(Sender: TObject); procedure btnChangeTextAttrClick(Sender: TObject); procedure btnReplSelTextClick(Sender: TObject); procedure btnChangeJustClick(Sender: TObject); procedure btnLoadFileClick(Sender: TObject); procedure btnParaDialogClick(Sender: TObject); procedure btnFindClick(Sender: TObject); procedure btnInsertBMPClick(Sender: TObject); procedure btnSaveAsHTMLClick(Sender: TObject); procedure btnCopyClick(Sender: TObject); procedure btnReplaceClick(Sender: TObject); procedure LMDRichEdit1VScroll(Sender: TObject); procedure LMDRichEdit2VScroll(Sender: TObject); procedure FormShow(Sender: TObject); procedure FormHide(Sender: TObject); procedure LMDRichEdit1SelectionChange(Sender: TObject); procedure LMDRichEdit2SelectionChange(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } Editor: TLMDRichEdit; function HasActiveEditor: Boolean; procedure CheckButtons; procedure ScreenActiveControlChange(Sender: TObject); protected public { Public declarations } end; var fromRuntimeDemo: TfromRuntimeDemo; implementation uses ShellApi; {$R *.DFM} procedure TfromRuntimeDemo.FormShow(Sender: TObject); begin Screen.OnActiveControlChange := ScreenActiveControlChange; ActiveControl := LMDRichEdit1; CheckButtons; end; procedure TfromRuntimeDemo.FormHide(Sender: TObject); begin Screen.OnActiveControlChange := nil; end; procedure TfromRuntimeDemo.ScreenActiveControlChange(Sender: TObject); begin inherited ; if (ActiveControl <> Editor) and (ActiveControl is TLMDRichEdit) then begin Editor := TLMDRichEdit(ActiveControl); if Editor = LMDRichEdit1 then begin panLeftActive.Color := clBtnShadow; panRightActive.Color := clBtnFace; end else begin panLeftActive.Color := clBtnFace; panRightActive.Color := clBtnShadow; end; end; CheckButtons; end; procedure TfromRuntimeDemo.CheckButtons; var HasEditor, HasSelected: Boolean; begin if csDestroying in ComponentState then exit; HasEditor := HasActiveEditor; HasSelected := HasEditor and (Editor.SelLength > 0); btnSelectText.Enabled := HasEditor and not HasSelected; btnParaDialog.Enabled := HasEditor; btnChangeTextAttr.Enabled := HasSelected; btnCopy.Enabled := HasSelected; btnReplSelText.Enabled := HasSelected; btnFind.Enabled := HasEditor; btnReplace.Enabled := HasEditor; btnLoadFile.Enabled := HasEditor; btnInsertBMP.Enabled := HasEditor; end; function TfromRuntimeDemo.HasActiveEditor: Boolean; begin Result := Assigned(Editor); end; procedure TfromRuntimeDemo.btnSelectTextClick(Sender: TObject); begin if not HasActiveEditor then Exit; Editor.SelStart:= 10; Editor.SelLength:= 20; Editor.SetFocus; CheckButtons; end; procedure TfromRuntimeDemo.btnChangeTextAttrClick(Sender: TObject); begin if not HasActiveEditor then Exit; Editor.SelAttributes.Style:= [fsBold]; Editor.SelAttributes.Color:= clRed; Editor.SetFocus; CheckButtons; end; procedure TfromRuntimeDemo.btnReplSelTextClick(Sender: TObject); begin if not HasActiveEditor then Exit; Editor.SelText:= 'NEW TEXT INSERTED HERE'; Editor.SetFocus; CheckButtons; end; procedure TfromRuntimeDemo.btnChangeJustClick(Sender: TObject); begin if not HasActiveEditor then Exit; if Editor.Paragraph.Alignment = paRightJustify then Editor.Paragraph.Alignment:= paLeftJustify else Editor.Paragraph.Alignment:= paRightJustify; Editor.SetFocus; CheckButtons; end; procedure TfromRuntimeDemo.btnLoadFileClick(Sender: TObject); begin if not HasActiveEditor then Exit; with TOpenDialog.Create( nil) do begin try Filter:='Rich Text files (*.rtf)|*.rtf|Text Files (*.txt)|*.txt|All Files (*.*)|*.*'; if Execute then Editor.Lines.LoadFromFile( FileName); finally Free; end; end; Editor.SetFocus; CheckButtons; end; procedure TfromRuntimeDemo.btnParaDialogClick(Sender: TObject); begin if not HasActiveEditor then Exit; Editor.Paragraph.ParagraphDialog; Editor.SetFocus; CheckButtons; end; procedure TfromRuntimeDemo.btnFindClick(Sender: TObject); var FoundAt: LongInt; begin if not HasActiveEditor then Exit; FoundAt:= Editor.FindText( 'LMD', 0, Length(Editor.Lines.Text), [stSearchDown]); if FoundAt <> -1 then begin Editor.SelStart:= FoundAt; Editor.SelLength:= 3; end; Editor.SetFocus; CheckButtons; end; procedure TfromRuntimeDemo.btnInsertBMPClick(Sender: TObject); var tmp:TPicture; begin if not HasActiveEditor then Exit; tmp:=TPicture.Create; with TOpenPictureDialog.Create(nil) do try if Execute then begin tmp.LoadFromFile(FileName); Editor.InsertBitmap(tmp.Bitmap); end; finally Free; tmp.free; end; Editor.SetFocus; CheckButtons; end; procedure TfromRuntimeDemo.btnSaveAsHTMLClick(Sender: TObject); var tmp:TFileStream; begin if not HasActiveEditor then Exit; with TSaveDialog.Create(nil) do try DefaultExt:='htm'; FileName:='*.htm'; if Execute then begin tmp:=TFileStream.Create(FileName, fmCreate); try Editor.SaveToStreamAsHTML(tmp); finally tmp.Free; end; ShellExecute(Handle, nil, PChar(FileName), nil,nil,0); end; finally Free; end; Editor.SetFocus; CheckButtons; end; procedure TfromRuntimeDemo.btnCopyClick(Sender: TObject); var tmp:TMemoryStream; begin if not HasActiveEditor then Exit; // To copy/paste a text without clipboard use CopyToStream/PasteFromStream method // In following example a TMemoryStream is created to act as data container, // but you can use any other TStream descendant as well (e.g. TFileStream) // --------------------------------------------------------------------- tmp:=TMemoryStream.Create; try Editor.CopyToStream(tmp); tmp.Position := 0; if Editor = LMDRichEdit1 then Editor := LMDRichEdit2; Editor.PasteFromStream(tmp); finally tmp.free; end; Editor.SetFocus; CheckButtons; end; procedure TfromRuntimeDemo.btnReplaceClick(Sender: TObject); begin if not HasActiveEditor then Exit; Editor.ReplaceText('LMD', 'LMDInnovative', 0, Length( Editor.Lines.Text), [stSearchDown]); Editor.SetFocus; CheckButtons; end; procedure TfromRuntimeDemo.LMDRichEdit1VScroll(Sender: TObject); begin LMDRichEdit2.SynchronizeLines(LMDRichEdit1); CheckButtons; end; procedure TfromRuntimeDemo.LMDRichEdit2VScroll(Sender: TObject); begin LMDRichEdit1.SynchronizeLines(LMDRichEdit2); CheckButtons; end; procedure TfromRuntimeDemo.LMDRichEdit1SelectionChange(Sender: TObject); begin LMDRichEdit1VScroll(Sender); CheckButtons; end; procedure TfromRuntimeDemo.LMDRichEdit2SelectionChange(Sender: TObject); begin LMDRichEdit2VScroll(Sender); CheckButtons; end; procedure TfromRuntimeDemo.FormCreate(Sender: TObject); begin // Application.OnHint := ShowHint; end; end.