پنجره پیغام با بررسی کلید فشرده شده

[mbshareat]

سلام علیکم
من نیاز به یک پنجره پیغام دارم که در اون یک متن رو نشون بدم که یک عبارت تکرار شده در اون رنگی هست.
مثلا عبارت (ایاک نعبد و ایاک نستعین) رو نشون میده و اولین (ایاک) قرمز هست و دومی آبی . تا اینجا رو انجام دادم. حالا میخوام وقتی کاربر کلید خاصی رو فشار داد، مورد بعدی از عبارت رنگی قرمز بشه(ایاک دوم).
برای این کار باید رویداد فشار کلید برای پنجره پیغام که شکلش هم توسط کل طراحی میشه بذارم.
فکر کردم شاید چنین کدی جواب بده ولی کار نکرد:

  TForm2 = class(TForm)

  private

    procedure MyKeyPress(Sender: TObject; var Key: Char);

  End;



..



Procedure TForm2.MyKeyPress(Sender: TObject; var Key: Char);

begin

  If Key='.' then

  Begin

    ShowMessage(IntToStr(1));

  End;

  If Key=',' then

  Begin

    ShowMessage(IntToStr(12));

  End;

end;

..

procedure ColorMsg2(....);

var

  Form2:TForm2;

Begin

..

    Form2:=TForm2.Create(nil);

    Form.OnKeyPress:=Form2.MyKeyPress;

..

End;

وارد جزئیات نمیشم. فقط اینکه اسم پنجره پیغام که با برنامه ساخته میشه، Form هست.
به طور کلی سوالم این هست که چطور میشه formKeyPress یک پنجره که توسط برنامه ساخته شده، تنظیم کرد که به کلید خاصی حساس باشه و کار خاصی بکنه.
یک کد نسبتا ساده برای ساخت پنجره پیغام اینه:

Procedure Msg(ACaption, APrompt: string);

var

  Form: TForm;

  Prompt: TLabel;

begin

  Form := TForm.Create(Application);

  with Form do

    try

      BorderStyle := bsDialog;

      Caption := '     '+ACaption;

      Width :=400 ;

      Height := 130;

      Position := poScreenCenter;

      FormStyle:=fsStayOnTop;

      Prompt := TLabel.Create(Form);

      with Prompt do

      begin

        Parent := Form;

        Caption := APrompt;

        AutoSize:=False;

        SetBounds(10,10, 370,50);

        WordWrap := True;

        BidiMode:=bdRightToLeft;

      end;

      with TButton.Create(Form) do

      begin

        Parent := Form;

        Caption := 'Ok!';

        Default := True;

        ModalResult := mrOk;

        SetBounds(150,50, 100,35);

      end;

      SetForeGroundWindow(Form.Handle);

      ShowModal;

    finally

      Form.Free;

    end;

end;

اگر جواب این سوال رو بگیرم تازه میمونه اینکه چطور به پنجره بگم مورد دوم عبارت رو قرمز کن؟ چون متن رو در یک Image مینویسم!!!

[دلفــي]

سلام
من دقیقا متوجه منظورت نشدم ولی از کد زیر می تونی کمک بگیری
(از کلیدهای جهت نمای سمت راست و چپ برای انتقال به کلمه ی بعدی یا قبلی استفاده کن)

01.jpg

unit Unit1;





interface





uses

  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,

  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, RichEdit, Vcl.StdCtrls, Vcl.ComCtrls, PNGImage, Vcl.ExtCtrls;





type

  TForm1 = class(TForm)

    RichEdit1: TRichEdit;

    Image1: TImage;

    Edit1: TEdit;

    Button1: TButton;

    procedure FormShow(Sender: TObject);

    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);

    procedure Button1Click(Sender: TObject);

    procedure Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);

  private

    Num: Integer;

    { Private declarations }

  public

    C2: Integer;

    procedure DrawImage;

    { Public declarations }

  end;





var

  Form1: TForm1;





type TTextAttributes = record

     Font      : TFont;

     BackColor : TColor;

end;





implementation





{$R *.dfm}





procedure SetTextColor(x:integer; var c:integer; oRichEdit : TRichEdit; sText : String; rAttributes, rAttributes2 : TTextAttributes);

var

          iPos : Integer;

          iLen : Integer;

          y : Integer;





          Format: CHARFORMAT2;

begin

          y := 0;





          FillChar(Format, SizeOf(Format), 0);

          Format.cbSize := SizeOf(Format);

          Format.dwMask := CFM_BACKCOLOR;

          Format.crBackColor := rAttributes.BackColor;





          iPos := 0;

          iLen := Length(oRichEdit.Lines.Text) ;

          if iLen > 0 then

          begin

          iPos := oRichEdit.FindText(sText, iPos, iLen, []);





          while iPos > -1 do

            begin

                inc(y);





                if x = 1 then

                   Inc(C);





                if x <= c then

                Begin

                if y = x then

                begin

                oRichEdit.SelStart  := iPos;

                oRichEdit.SelLength := Length(sText) ;

                oRichEdit.SelAttributes.Color := rAttributes.Font.Color;

                oRichEdit.SelAttributes.Size  := rAttributes.Font.Size;

                oRichEdit.SelAttributes.Style := rAttributes.Font.Style;

                oRichEdit.SelAttributes.Name  := rAttributes.Font.Name;





                oRichEdit.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format));





                end else

                begin

                oRichEdit.SelStart  := iPos;

                oRichEdit.SelLength := Length(sText) ;

                oRichEdit.SelAttributes.Color := rAttributes2.Font.Color;

                oRichEdit.SelAttributes.Size  := rAttributes2.Font.Size;

                oRichEdit.SelAttributes.Style := rAttributes2.Font.Style;

                oRichEdit.SelAttributes.Name  := rAttributes2.Font.Name;





                oRichEdit.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format));





                end;

                End;





                iPos := oRichEdit.FindText(sText,iPos + Length(sText),iLen, []) ;





            end;

          end;

end;









procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);

var

          rAttrib, rAttrib2 : TTextAttributes;

begin

          if Key = 39 then

          inc(Num);





          if Key = 37 then

          dec(Num);





          if Num < 1 then

          Num := 1;





          rAttrib.Font := TFont.Create;

          rAttrib.Font.Color := clRed;

          rAttrib.Font.Size  := 14;

          rAttrib.Font.Style := [fsBold];

          rAttrib.BackColor := clWhite;





          rAttrib2.Font := TFont.Create;

          rAttrib2.Font.Color := clBlue;

          rAttrib2.Font.Size  := 14;

          rAttrib2.Font.Style := [fsBold];

          rAttrib2.BackColor := clWhite;





          SetTextColor(Num,C2,RichEdit1,'إیَّاک',rAttr  ib,rAttrib2);





          rAttrib.Font.Free;

          rAttrib2.Font.Free;

          DrawImage;

end;





procedure TForm1.FormShow(Sender: TObject);





begin

RichEdit1.Clear;

end;





procedure TForm1.Button1Click(Sender: TObject);

var

          rAttrib, rAttrib2 : TTextAttributes;

begin

          Num := 1;

          C2 := 0;

          RichEdit1.Lines.Clear;

          RichEdit1.Lines.Add(Trim(Edit1.Text));





          rAttrib.Font := TFont.Create;

          rAttrib.Font.Color := clRed;

          rAttrib.Font.Size  := 14;

          rAttrib.Font.Style := [fsBold];

          rAttrib.BackColor := clWhite;





          rAttrib2.Font := TFont.Create;

          rAttrib2.Font.Color := clBlue;

          rAttrib2.Font.Size  := 14;

          rAttrib2.Font.Style := [fsBold];

          rAttrib2.BackColor := clWhite;





          SetTextColor(Num,C2,RichEdit1,'إیَّاک',rAttr  ib,rAttrib2);





          rAttrib.Font.Free;

          rAttrib2.Font.Free;

          DrawImage;

          Edit1.SetFocus;

end;





procedure TForm1.DrawImage;

var

  BMP: TBitmap;

  fmtRange: TFormatRange;

  intPPI, Flags: Integer;

begin

  BMP := TBitmap.Create;

  Try

    BMP.PixelFormat := pf32bit;

    BMP.SetSize(RichEdit1.Width, RichEdit1.Height);





    FillChar(fmtRange, SizeOf(fmtRange), 0);

    with fmtRange do begin

      hDC := BMP.Canvas.Handle;

      hdcTarget := hDC;

      intPPI := Screen.PixelsPerInch;

      rc := Rect(

        0,

        0,

        RichEdit1.Width*1440 div intPPI,

        RichEdit1.Height*1440 div intPPI

      );

      rcPage := rc;

      chrg.cpMin := 0;

      chrg.cpMax := -1;

    end;

    Flags := 1;

    RichEdit1.Perform(EM_FORMATRANGE, Flags, Longint(@fmtRange));

    RichEdit1.Perform(EM_FORMATRANGE, 0, 0);

    Image1.Picture.Bitmap.Assign(BMP);

  Finally

    FreeAndNil(BMP);

  End;

end;









procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);

var

          rAttrib, rAttrib2 : TTextAttributes;

begin

          if Key = 37 then

          inc(Num);





          if Key = 39 then

          dec(Num);





          if Num < 1 then

          Num := 1;





          if Num > C2 then

          Num := C2;





          rAttrib.Font := TFont.Create;

          rAttrib.Font.Color := clRed;

          rAttrib.Font.Size  := 14;

          rAttrib.Font.Style := [fsBold];

          rAttrib.BackColor := clWhite;





          rAttrib2.Font := TFont.Create;

          rAttrib2.Font.Color := clBlue;

          rAttrib2.Font.Size  := 14;

          rAttrib2.Font.Style := [fsBold];

          rAttrib2.BackColor := clWhite;





          SetTextColor(Num, C2,RichEdit1,'إیَّاک',rAttrib,rAttrib2);





          rAttrib.Font.Free;

          rAttrib2.Font.Free;

          DrawImage;

end;





end.

[mbshareat]

ممنون بابت وقتی که گذاشتید. آخرش خودم در حالت طراحی یه پنجره براش تعریف کردم.کد شما کمی پیچیده هست.از بعضی جاهاش سر در نمیارم( مثلا C,X ).باز هم ممنونم.
در روش خودم دو طرف عبارت تکراری <B>,<-> میذارم(برای مورد مد نظر رو با <R> به معنی رنگ قرمز به کا می برم). موقتا تگ رنگ (با تعریف خودم!) رو به کاکتر نامرئی157 تبدیل می کنم و از WordWrap ,Memo استفاده می کنم.خیلی پیش که از RichEdit استفاده می کردم متوجه شدم هم در رنگ پردازی و استایل کند هست و هم کار باهاش سخته.نتونستم یه تصویر گیف یا Jpg به صورت ضمنی یا ضمیمه بذارم. اما در این لینک یه تصویر آپلود کردم
https://s26.picofile.com/file/8458714442/a.JPG