دخول

abdelali91 · 08-09-2011, 03:48 PM

السلام عليكم

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

cargem · 08-09-2011, 06:20 PM

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

cargem · 08-09-2011, 07:16 PM

كود :
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.

دخول
اسم المستخدم/البريد الالكتروني :
كلمة المرور :	فقدت كلمة المرور ؟
	تذكرني بالمرة القادمة