A
aijpccjcy
Unregistered / Unconfirmed
GUEST, unregistred user!
我做了一个RichEdit捕捉 超联接的小程序,可是一运行就报错
project Project1.exe raised exception class EOSError whth message 'a call to an OS function failed'
我也不知道这是什么错误
当我把自己定义的过程 procedure WndProc(var Msg:TMessage);override;
后面的override;屏蔽了 就不提示错误了~
有没人知道这是为什么啊????/急@@@@@@@@@@@@@
我的代码如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Mask, RzEdit, ComCtrls, RzSpnEdt, RzCmboBx, RzLstBox,
DBCtrls, RzDBEdit;
type
TForm1 = class(TForm)
RichEdit1: TRichEdit;
ScrollBox1: TScrollBox;
Label1: TLabel;
Label2: TLabel;
RzFontComboBox1: TRzFontComboBox;
RzColorEdit1: TRzColorEdit;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
RzSpinEdit1: TRzSpinEdit;
RichEdit2: TRichEdit;
procedure RzColorEdit1Change(Sender: TObject);
procedure RzSpinEdit1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure RzFontComboBox1Change(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);
procedure CheckBox3Click(Sender: TObject);
procedure CheckBox4Click(Sender: TObject);
procedure RichEdit2KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
procedure InitRichEditURLDetection(RE: TRichEdit); //捕捉超联接
{ Private declarations }
public
procedure WndProc(var Msg:TMessage);override;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses ShellApi,RichEdit;
procedure TForm1.InitRichEditURLDetection(RE: TRichEdit);
var
mask: Word;
begin
mask := SendMessage(RE.Handle, EM_GETEVENTMASK, 0, 0);
SendMessage(RE.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);
SendMessage(RE.Handle, EM_AUTOURLDETECT, Integer(True), 0);
end;
procedure TForm1.WndProc(var Msg: TMessage);
var
p: TENLink;
sURL: string;
CE : TRichEdit;
begin
if (Msg.Msg = WM_NOTIFY) then
begin
if (PNMHDR(Msg.lParam).code = EN_LINK) then
begin
p := TENLink(Pointer(TWMNotify(Msg).NMHdr)^);
if (p.Msg = WM_LBUTTONDOWN) then
begin
try
CE := TRichEdit(Form1.ActiveControl);
SendMessage(CE.Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));
sURL := CE.SelText;
ShellExecute(Handle,'open',PChar(sURL), 0, 0, SW_SHOWNORMAL);//启动浏览器
except
end;
end;
end;
end;
end;
procedure TForm1.RzColorEdit1Change(Sender: TObject);
begin
RichEdit1.Font.Color:=RzColorEdit1.SelectedColor; //改变颜色
end;
procedure TForm1.RzSpinEdit1Change(Sender: TObject);
begin
RichEdit1.Font.Size:=RzSpinEdit1.IntValue; //改变字体大小
end;
procedure TForm1.FormCreate(Sender: TObject);
var
s: string;
begin
RzSpinEdit1.IntValue:=8;//默认字体为8号字体
end;
procedure TForm1.RzFontComboBox1Change(Sender: TObject);
begin
RichEdit1.font.name:=RzFontComboBox1.FontName; //改变字体
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if CheckBox1.Checked=true then //黑体
begin
RichEdit1.Font.Style:=richedit1.font.style+[fsBold];
end
else
RichEdit1.Font.Style:=richedit1.font.style-[fsBold];
end;
procedure TForm1.CheckBox2Click(Sender: TObject);
begin
if CheckBox2.Checked=true then //倾斜
begin
RichEdit1.Font.Style:=richedit1.font.style+[fsItalic];
end
else
RichEdit1.Font.Style:=richedit1.font.style-[fsItalic];
end;
procedure TForm1.CheckBox3Click(Sender: TObject);
begin
if CheckBox3.Checked=true then //下划线
begin
RichEdit1.Font.Style:=richedit1.font.style+[fsUnderline];
end
else
RichEdit1.Font.Style:=richedit1.font.style-[fsUnderline];
end;
procedure TForm1.CheckBox4Click(Sender: TObject);
begin
if CheckBox4.Checked=true then //删除线
begin
RichEdit1.Font.Style:=richedit1.font.style+[fsStrikeOut];
end
else
RichEdit1.Font.Style:=richedit1.font.style-[fsStrikeOut];
end;
procedure TForm1.RichEdit2KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=13 then
begin
InitRichEditURLDetection(RichEdit1);
RichEdit1.Lines.Add(RichEdit2.text);
RichEdit2.Text:='';
end;
end;
end.
project Project1.exe raised exception class EOSError whth message 'a call to an OS function failed'
我也不知道这是什么错误
当我把自己定义的过程 procedure WndProc(var Msg:TMessage);override;
后面的override;屏蔽了 就不提示错误了~
有没人知道这是为什么啊????/急@@@@@@@@@@@@@
我的代码如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Mask, RzEdit, ComCtrls, RzSpnEdt, RzCmboBx, RzLstBox,
DBCtrls, RzDBEdit;
type
TForm1 = class(TForm)
RichEdit1: TRichEdit;
ScrollBox1: TScrollBox;
Label1: TLabel;
Label2: TLabel;
RzFontComboBox1: TRzFontComboBox;
RzColorEdit1: TRzColorEdit;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
RzSpinEdit1: TRzSpinEdit;
RichEdit2: TRichEdit;
procedure RzColorEdit1Change(Sender: TObject);
procedure RzSpinEdit1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure RzFontComboBox1Change(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);
procedure CheckBox3Click(Sender: TObject);
procedure CheckBox4Click(Sender: TObject);
procedure RichEdit2KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
procedure InitRichEditURLDetection(RE: TRichEdit); //捕捉超联接
{ Private declarations }
public
procedure WndProc(var Msg:TMessage);override;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses ShellApi,RichEdit;
procedure TForm1.InitRichEditURLDetection(RE: TRichEdit);
var
mask: Word;
begin
mask := SendMessage(RE.Handle, EM_GETEVENTMASK, 0, 0);
SendMessage(RE.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);
SendMessage(RE.Handle, EM_AUTOURLDETECT, Integer(True), 0);
end;
procedure TForm1.WndProc(var Msg: TMessage);
var
p: TENLink;
sURL: string;
CE : TRichEdit;
begin
if (Msg.Msg = WM_NOTIFY) then
begin
if (PNMHDR(Msg.lParam).code = EN_LINK) then
begin
p := TENLink(Pointer(TWMNotify(Msg).NMHdr)^);
if (p.Msg = WM_LBUTTONDOWN) then
begin
try
CE := TRichEdit(Form1.ActiveControl);
SendMessage(CE.Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));
sURL := CE.SelText;
ShellExecute(Handle,'open',PChar(sURL), 0, 0, SW_SHOWNORMAL);//启动浏览器
except
end;
end;
end;
end;
end;
procedure TForm1.RzColorEdit1Change(Sender: TObject);
begin
RichEdit1.Font.Color:=RzColorEdit1.SelectedColor; //改变颜色
end;
procedure TForm1.RzSpinEdit1Change(Sender: TObject);
begin
RichEdit1.Font.Size:=RzSpinEdit1.IntValue; //改变字体大小
end;
procedure TForm1.FormCreate(Sender: TObject);
var
s: string;
begin
RzSpinEdit1.IntValue:=8;//默认字体为8号字体
end;
procedure TForm1.RzFontComboBox1Change(Sender: TObject);
begin
RichEdit1.font.name:=RzFontComboBox1.FontName; //改变字体
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if CheckBox1.Checked=true then //黑体
begin
RichEdit1.Font.Style:=richedit1.font.style+[fsBold];
end
else
RichEdit1.Font.Style:=richedit1.font.style-[fsBold];
end;
procedure TForm1.CheckBox2Click(Sender: TObject);
begin
if CheckBox2.Checked=true then //倾斜
begin
RichEdit1.Font.Style:=richedit1.font.style+[fsItalic];
end
else
RichEdit1.Font.Style:=richedit1.font.style-[fsItalic];
end;
procedure TForm1.CheckBox3Click(Sender: TObject);
begin
if CheckBox3.Checked=true then //下划线
begin
RichEdit1.Font.Style:=richedit1.font.style+[fsUnderline];
end
else
RichEdit1.Font.Style:=richedit1.font.style-[fsUnderline];
end;
procedure TForm1.CheckBox4Click(Sender: TObject);
begin
if CheckBox4.Checked=true then //删除线
begin
RichEdit1.Font.Style:=richedit1.font.style+[fsStrikeOut];
end
else
RichEdit1.Font.Style:=richedit1.font.style-[fsStrikeOut];
end;
procedure TForm1.RichEdit2KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=13 then
begin
InitRichEditURLDetection(RichEdit1);
RichEdit1.Lines.Add(RichEdit2.text);
RichEdit2.Text:='';
end;
end;
end.