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

[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 مینویسم!!!

[دلفــي]

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


154449


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