![]() |
|
كيفية تغير لون او نوع خط كلمة معيتة في عنصر 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 ![]() كود : 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. |