B
biyesheng
Unregistered / Unconfirmed
GUEST, unregistred user!
我不会做控件,谁能帮我把一个控制在Edit里输出文字格式的小程序写成一个Tedit的
控件?代码如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
procedure Edit1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
var
EditFlag:boolean;
{$R *.dfm}
procedure TForm1.Edit1Change(Sender: TObject);
var
s,s1,s2:string;
n:integer;
begin
s:=Edit1.Text;
n:=length(s);
s1:=copy(s,n,1);
s2:=copy(s,n-1,1);
if (EditFlag) and (n>1) then
begin
Edit1.SelStart := Length (Edit1.Text);
if (s1<>' ') and (s2<>' ') then
begin
s:=s+' ';
Edit1.SelStart := Length (Edit1.Text);
setfocus;
Edit1.Text:=s;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
EditFlag:=true;
end;
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var
sk:string;
ss:integer;
begin
ss:=Edit1.SelStart;
sk:=copy(Edit1.Text,ss+1,1);
if key=chr(vk_back) then
begin
EditFlag:=false;
//aa |bb cc时不允许删除空格
if copy(Edit1.Text,ss,1)=' ' then
key:=#0;
exit;
end
else
EditFlag:=true;
if (ss<>length(edit1.Text)) and (key<>chr(vk_back)) then
begin
EditFlag:=false;
//(aa |bb cc) or (aa |b cc)
if (sk<>' ') and (copy(Edit1.Text,ss,1)=' ') then
//(aa |bb cc)
if copy(Edit1.Text,ss+2,1)<>' ' then
Edit1.SelLength:=1;
//aa b|b cc
if (sk<>' ') and (copy(Edit1.Text,ss,1)<>' ') then
Edit1.SelLength:=1
else
begin
//(aa bb| cc) or (aa b| cc)
if (sk=' ') and (copy(Edit1.Text,ss,1)<>' ') then
//(aa bb| cc)
if copy(Edit1.Text,ss-1,1)<>' ' then
begin
Edit1.SelStart:=ss+1;
Edit1.SelLength:=1;
end;
end;
end
else
EditFlag:=true;
end;
end.
控件?代码如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
procedure Edit1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
var
EditFlag:boolean;
{$R *.dfm}
procedure TForm1.Edit1Change(Sender: TObject);
var
s,s1,s2:string;
n:integer;
begin
s:=Edit1.Text;
n:=length(s);
s1:=copy(s,n,1);
s2:=copy(s,n-1,1);
if (EditFlag) and (n>1) then
begin
Edit1.SelStart := Length (Edit1.Text);
if (s1<>' ') and (s2<>' ') then
begin
s:=s+' ';
Edit1.SelStart := Length (Edit1.Text);
setfocus;
Edit1.Text:=s;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
EditFlag:=true;
end;
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var
sk:string;
ss:integer;
begin
ss:=Edit1.SelStart;
sk:=copy(Edit1.Text,ss+1,1);
if key=chr(vk_back) then
begin
EditFlag:=false;
//aa |bb cc时不允许删除空格
if copy(Edit1.Text,ss,1)=' ' then
key:=#0;
exit;
end
else
EditFlag:=true;
if (ss<>length(edit1.Text)) and (key<>chr(vk_back)) then
begin
EditFlag:=false;
//(aa |bb cc) or (aa |b cc)
if (sk<>' ') and (copy(Edit1.Text,ss,1)=' ') then
//(aa |bb cc)
if copy(Edit1.Text,ss+2,1)<>' ' then
Edit1.SelLength:=1;
//aa b|b cc
if (sk<>' ') and (copy(Edit1.Text,ss,1)<>' ') then
Edit1.SelLength:=1
else
begin
//(aa bb| cc) or (aa b| cc)
if (sk=' ') and (copy(Edit1.Text,ss,1)<>' ') then
//(aa bb| cc)
if copy(Edit1.Text,ss-1,1)<>' ' then
begin
Edit1.SelStart:=ss+1;
Edit1.SelLength:=1;
end;
end;
end
else
EditFlag:=true;
end;
end.