本例效果图:
代码文件:unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormKeyPress(Sender: TObject; var Key: Char);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
str: string;
x1,y1: Integer;
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
var
x2: Integer;
begin
HideCaret(Handle);
Repaint;
if Key = #8 then
begin
if Length(str) > 0 then
SetLength(str, Length(str) - 1);
end else str := str + Key;
Text := str;
Canvas.TextOut(x1, y1, str);
x2 := x1 + Canvas.TextWidth(str);
SetCaretPos(x2, y1);
ShowCaret(Handle);
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
str := '';
DestroyCaret;
CreateCaret(Handle, 0, 0, Canvas.TextHeight('A'));
SetCaretPos(X,Y);
ShowCaret(Handle);
x1 := X;
y1 := Y;
end;
end.
窗体文件:
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 206
ClientWidth = 339
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnKeyPress = FormKeyPress
OnMouseDown = FormMouseDown
PixelsPerInch = 96
TextHeight = 13
end