IDC资讯中心
公司采用seskin控件包来开发。却发现seskinedit在使用汉字是有问题。主要是由汉字时光标定位不准。鼠标选字也选不准。
于是看了其代码。发现它在计算文本长度时采用的函数textlength有问题。
其实tcanvas提供了一个textlength方法，在去文本长度时汉字没有问题。
所以把这里替换下来就行了。
替换后的se_controls单元中的tsecustomedit的代码如下
tsecustomedit = class(tsecustomcontrol)
private
ftext: widestring;
flmouseselecting: boolean;
fcaretposition: integer;
fselstart: integer;
fsellength: integer;
ffirstvisiblechar: integer;
fpopupmenu: tsecustompopupmenu;
fautoselect: boolean;
fcharcase: teditcharcase;
fhideselection: boolean;
fmaxlength: integer;
freadonly: boolean;
fonchange: tnotifyevent;
fpasswordchar: widechar;
fpasswordkind: tpasswordkind;
ftextalignment: talignment;
factionstack: teditactionstack;
fpopupmenudropshadow: boolean;
fpopupmenushowanimationtime: integer;
fpopupmenublendvalue: integer;
fpopupmenushadowwidth: integer;
fpopupmenushowanimation: tseanimationrec;
fpopupmenublend: boolean;
fcontextmenuoptions: tsepopupmenuoptions;
procedure updatefirstvisiblechar;
procedure updatecareteposition;
procedure updatecarete;
procedure wmgetdlgcode(var msg: twmgetdlgcode); message wm_getdlgcode;
procedure wmcopy(var message: tmessage); message wm_copy;
procedure wmpaste(var message: tmessage); message wm_paste;
procedure wmcut(var message: tmessage); message wm_cut;
procedure wmundo(var message: tmessage); message wm_undo;
procedure wmcontexmenu(var message: tmessage); message wm_contextmenu;
procedure wmlbuttondblclk(var message: twmlbuttondblclk); message
wm_lbuttondblclk;
{ unicode }
procedure wmimestartcomposition(var message: tmessage); message
wm_ime_startcomposition;
procedure wmimecomposition(var msg: tmessage); message wm_ime_composition;
{ vcl messages }
procedure cmenabledchanged(var msg: tmessage); message cm_enabledchanged;
procedure cmfontchanged(var message: tmessage); message cm_fontchanged;
procedure cmtextchanged(var msg: tmessage); message cm_textchanged;
function getseltext: widestring;
function getvisibleseltext: widestring;
function getnextwordbeging(startposition: integer): integer;
function getprivwordbeging(startposition: integer): integer;
function getselstart: integer;
function getsellength: integer;
function gettext: widestring;
procedure settext(const value: widestring);
procedure setfont(value: tfont);
procedure setcaretposition(const value: integer);
procedure setsellength(const value: integer);
procedure setselstart(const value: integer);
procedure setautoselect(const value: boolean);
procedure setcharcase(const value: teditcharcase);
procedure sethideselection(const value: boolean);
procedure setmaxlength(const value: integer);
procedure setpasswordchar(const value: widechar);
procedure setcursor(const value: tcursor);
procedure settextalignment(const value: talignment);
procedure setpasswordkind(const value: tpasswordkind);
procedure setpopupmenublendvalue(const value: integer);
procedure setpopupmenudropshadow(const value: boolean);
procedure setpopupmenushadowwidth(const value: integer);
procedure setpopupmenushowanimation(const value: tseanimationrec);
procedure setpopupmenushowanimationtime(const value: integer);
procedure setpopupmenublend(const value: boolean);
procedure setcontextmenuoptions(const value: tsepopupmenuoptions);
protected
function geteditrect: trect; virtual;
function getpasswordcharwidth: integer; virtual;
function getcharx(a: integer): integer;
function getcoordinateposition(x: integer): integer;
function getselrect: trect; virtual;
function getalignmentflags: integer;
procedure paintbuffer; override;
procedure painttext; virtual;
procedure paintbackground(rect: trect; canvas: tcanvas); virtual;
procedure paintselectedtext; virtual;
procedure drawpasswordchar(symbolrect: trect; selected: boolean); virtual;
function validtext(newtext: widestring): boolean; virtual;
function canautosize(var newwidth, newheight: integer): boolean; override;
procedure borderchanged; override;
procedure hasfocus; override;
procedure killfocus; override;
procedure mousedown(button: tmousebutton; shift: tshiftstate; x, y:
integer);
override;
procedure mouseup(button: tmousebutton; shift: tshiftstate; x, y: integer);
override;
procedure mousemove(shift: tshiftstate; x, y: integer); override;
procedure keydown(var key: word; shift: tshiftstate); override;
procedure keypress(var key: char); override;
procedure selectword;
procedure change; dynamic;
function createpopupmenu(aowner: tcomponent): tsecustompopupmenu; virtual;
function createpopupmenuitem(aowner: tcomponent): tsecustomitem; virtual;
procedure buildpopupmenu;
procedure updatepopupmenuitems; virtual;
procedure doundo(sender: tobject);
procedure docut(sender: tobject);
procedure docopy(sender: tobject);
procedure dopaste(sender: tobject);
procedure dodelete(sender: tobject);
procedure doselectall(sender: tobject);
property caretposition: integer read fcaretposition write setcaretposition;
property popupmenu: tsecustompopupmenu read fpopupmenu;
public
constructor create(aowner: tcomponent); override;
destructor destroy; override;
procedure loaded; override;
procedure showcaret; virtual;
procedure hidecaret; virtual;
procedure copytoclipboard;
procedure pastefromclipboard;
procedure cuttoclipboard;
procedure clearselection;
procedure selectall;
procedure clear;
procedure undo;
procedure insertchar(ch: widechar);
procedure inserttext(atext: widestring);
procedure insertafter(position: integer; s: widestring; selected: boolean);
procedure deletefrom(position, length: integer; movecaret: boolean);
property selstart: integer read getselstart write setselstart;
property sellength: integer read getsellength write setsellength;
property seltext: widestring read getseltext;
published
property anchors;
property autoselect: boolean read fautoselect write setautoselect default
true;
property autosize;
property blending;
property bevelsides;
property bevelinner;
property bevelouter;
property bevelkind;
property bevelwidth;
property borderwidth;
property charcase: teditcharcase read fcharcase write setcharcase default
ecnormal;
property constraints;
property color;
property cursor write setcursor;
property dragcursor;
property dragkind;
property dragmode;
property enabled;
property imemode;
property imename;
property font write setfont;
property hideselection: boolean read fhideselection write sethideselection
default true;
property maxlength: integer read fmaxlength write setmaxlength default 0;
property performance;
property parentfont;
property parentshowhint;
property passwordkind: tpasswordkind read fpasswordkind write
setpasswordkind;
property passwordwidechar: widechar read fpasswordchar write setpasswordchar
default widechar(#0);
property contextmenuoptions: tsepopupmenuoptions read fcontextmenuoptions
write setcontextmenuoptions;
property readonly: boolean read freadonly write freadonly default false;
property showhint;
property taborder;
property tabstop default true;
property text: widestring read gettext write settext;
property textalignment: talignment read ftextalignment write settextalignment
default taleftjustify;
property visible;
property onchange: tnotifyevent read fonchange write fonchange;
property onclick;
property ondblclick;
property ondragdrop;
property ondragover;
property onenddock;
property onenddrag;
property onenter;
property onexit;
property onkeydown;
property onkeypress;
property onkeyup;
property onmousedown;
property onmousemove;
property onmouseup;
property onstartdock;
property onstartdrag;
end;
{ tsecustomedit ===============================================================}
constructor tsecustomedit.create(aowner: tcomponent);
begin
inherited;
factionstack := teditactionstack.create(self);
fcontextmenuoptions := tsepopupmenuoptions.create;
performance := kspdoublebuffer;
bevelkind := kbksingle;
bevelwidth := 1;
borderwidth := 3;
tabstop := true;
width := 121;
height := 21;
color := clwindow;
ftextalignment := taleftjustify;
fautoselect := true;
autosize := true;
fcharcase := ecnormal;
fhideselection := true;
fmaxlength := 0;
freadonly := false;
fpasswordchar := widechar(#0);
flmouseselecting := false;
fcaretposition := 0;
fselstart := 0;
fsellength := 0;
ffirstvisiblechar := 1;
controlstyle := controlstyle + [cscapturemouse];
fpopupmenublend := false;
fpopupmenublendvalue := 150;
fpopupmenudropshadow := false;
fpopupmenushadowwidth := 4;
fpopupmenushowanimationtime := 300;
cursor := cursor;
end;
destructor tsecustomedit.destroy;
begin
if fpopupmenu <> nil then
fpopupmenu.free;
fcontextmenuoptions.free;
factionstack.free;
inherited;
end;
procedure tsecustomedit.loaded;
begin
inherited;
adjustsize;
end;
procedure tsecustomedit.hasfocus;
begin
inherited;
updatecarete;
caretposition := 0;
if autoselect then
selectall;
end;
procedure tsecustomedit.killfocus;
begin
inherited;
destroycaret;
invalidate;
end;
function tsecustomedit.getcharx(a: integer): integer;
var
wholetextwidth : integer;
editrectwidth : integer;
begin
result := geteditrect.left;
if passwordkind <> pknone then
wholetextwidth := length(text) * getpasswordcharwidth
else
{wholetextwidth := textwidth(canvas, copy(text, 1, length(text)),
dt_noprefix); }
wholetextwidth := canvas.textwidth(copy(text, 1, length(text)));
if a > 0 then
begin
canvas.font.assign(controlfont);
if passwordkind <> pknone then
begin
if a <= length(text) then
result := result + (a – ffirstvisiblechar + 1) * getpasswordcharwidth
else
result := result + (length(text) – ffirstvisiblechar + 1) *
getpasswordcharwidth;
end
else
begin
if a <= length(text) then
result := result + canvas.textwidth(copy(text, ffirstvisiblechar, a –
ffirstvisiblechar + 1))
//result := result + textwidth(canvas, copy(text, ffirstvisiblechar, a – ffirstvisiblechar + 1), dt_noprefix)
else
result := result + canvas.textwidth(copy(text, ffirstvisiblechar,
length(text) – ffirstvisiblechar + 1));
//result := result + textwidth(canvas, copy(text, ffirstvisiblechar, length(text) – ffirstvisiblechar + 1), dt_noprefix);
end;
end;
editrectwidth := geteditrect.right – geteditrect.left;
if wholetextwidth < editrectwidth then
case textalignment of
tarightjustify: result := result + (editrectwidth – wholetextwidth);
tacenter: result := result + ((editrectwidth – wholetextwidth) div 2);
end;
end;
function tsecustomedit.getcoordinateposition(x: integer): integer;
var
curx : double;
tmpx,
wholetextwidth,
editrectwidth : integer;
begin
result := ffirstvisiblechar – 1;
if length(text) = 0 then
exit;
if passwordkind <> pknone then
wholetextwidth := length(text) * getpasswordcharwidth
else
wholetextwidth := canvas.textwidth(copy(text, 1, length(text)));
//wholetextwidth :=textwidth(canvas, copy(text, 1, length(text)), dt_noprefix);
editrectwidth := geteditrect.right – geteditrect.left;
tmpx := x;
if wholetextwidth < editrectwidth then
case textalignment of
tarightjustify: tmpx := x – (editrectwidth – wholetextwidth);
tacenter: tmpx := x – ((editrectwidth – wholetextwidth) div 2);
end;
if passwordkind <> pknone then
begin
result := result + (tmpx – geteditrect.left) div getpasswordcharwidth;
if result < 0 then
result := 0
else
if result > length(text) then
result := length(text);
end
else
begin
canvas.font.assign(controlfont);
{curx := geteditrect.left + textwidth(canvas, text[ffirstvisiblechar],
dt_noprefix) / 2; }
curx := geteditrect.left + canvas.textwidth(text[ffirstvisiblechar]) / 2;
while (curx < tmpx) and (result + 1 <= length(text)) and (curx <
geteditrect.right) do
begin
//curx := curx + textwidth(canvas, text[result + 1], dt_noprefix) / 2;
curx := curx + canvas.textwidth(text[result + 1]) / 2;
if result + 1 + 1 <= length(text) then
//curx := curx + textwidth(canvas, text[result + 1 + 1], dt_noprefix) / 2;
curx := curx + canvas.textwidth(text[result + 1 + 1]) / 2;
result := result + 1;
end;
end;
end;
function tsecustomedit.geteditrect: trect;
begin
with result do
begin
result := getborderrect;
canvas.font.assign(controlfont);
result.bottom := result.top + canvas.textheight(pq);
end;
end;
function tsecustomedit.getalignmentflags: integer;
begin
case ftextalignment of
tacenter: result := dt_center;
tarightjustify: result := dt_right;
else
result := dt_left;
end;
end;
procedure tsecustomedit.keydown(var key: word; shift: tshiftstate);
var
tmps : widestring;
oldcaretposition : integer;
begin
inherited keydown(key, shift);
oldcaretposition := caretposition;
case key of
vk_end: caretposition := length(text);
vk_home: caretposition := 0;
vk_left:
if ssctrl in shift then
caretposition := getprivwordbeging(caretposition)
else
caretposition := caretposition – 1;
vk_right:
if ssctrl in shift then
caretposition := getnextwordbeging(caretposition)
else
caretposition := caretposition + 1;
vk_delete, 8: {delete or backspace key was pressed}
if not readonly then
begin
if sellength <> 0 then
begin
if shift = [ssshift] then
cuttoclipboard
else
clearselection;
end
else
begin
tmps := text;
if tmps <> then
if key = vk_delete then
begin
factionstack.fragmentdeleted(caretposition + 1, tmps[caretposition
+ 1]);
delete(tmps, caretposition + 1, 1);
end
else
begin {backspace key was pressed}
if caretposition > 0 then
factionstack.fragmentdeleted(caretposition,
tmps[caretposition]);
delete(tmps, caretposition, 1);
caretposition := caretposition – 1;
end;
text := tmps;
end;
end;
vk_insert:
if shift = [ssctrl] then
copytoclipboard
else
if shift = [ssshift] then
pastefromclipboard;
ord(c),
ord(c):
if shift = [ssctrl] then
copytoclipboard;
ord(v),
ord(v):
if shift = [ssctrl] then
pastefromclipboard;
ord(x),
ord(x):
if shift = [ssctrl] then
cuttoclipboard;
ord(z), ord(z):
if shift = [ssctrl] then
undo;
end;
if key in [vk_end, vk_home, vk_left, vk_right] then
begin
if ssshift in shift then
begin
if sellength = 0 then
fselstart := oldcaretposition;
fselstart := caretposition;
fsellength := fsellength – (caretposition – oldcaretposition);
end
else
fsellength := 0;
invalidate;
end;
updatecareteposition;
end;
procedure tsecustomedit.keypress(var key: char);
begin
inherited keypress(key);
if (ord(key) >= 32) and not readonly then
insertchar(chartowidechar(key));
end;
procedure tsecustomedit.mousedown(button: tmousebutton; shift: tshiftstate;
x, y: integer);
begin
inherited;
if button = mbleft then
flmouseselecting := true;
setfocus;
if button = mbleft then
begin
caretposition := getcoordinateposition(x);
sellength := 0;
end;
end;
procedure tsecustomedit.paintbuffer;
var
r : trect;
begin
r := geteditrect;
r.bottom := fheight – r.top;
paintbackground(r, canvas);
if (self is tsecustomcombobox) and (tsecustomcombobox(self).combostyle =
kcsdropdownlist) then
exit;
if focused or not hideselection then
fillrect(canvas, getselrect, clhighlight);
painttext;
if focused or not hideselection then
paintselectedtext;
end;
procedure tsecustomedit.paintbackground(rect: trect; canvas: tcanvas);
begin
fillrect(canvas, rect, color);
end;
procedure tsecustomedit.painttext;
var
tmprect : trect;
curchar : integer;
lpwcharwidth : integer;
begin
tmprect := geteditrect;
if passwordkind <> pknone then
begin
lpwcharwidth := getpasswordcharwidth;
for curchar := 0 to length(text) – ffirstvisiblechar + 1 – 1 do
drawpasswordchar(rect(curchar * lpwcharwidth + getcharx(0),
tmprect.top,
(curchar + 1) * lpwcharwidth + getcharx(0),
tmprect.bottom), false);
end
else
begin
canvas.font.assign(controlfont);
drawtext(canvas, copy(text, ffirstvisiblechar, length(text) –
ffirstvisiblechar + 1),
tmprect, getalignmentflags or dt_noprefix);
end;
end;
procedure tsecustomedit.updatefirstvisiblechar;
var
leditrect : trect;
begin
if ffirstvisiblechar >= (fcaretposition + 1) then
begin
ffirstvisiblechar := fcaretposition;
if ffirstvisiblechar < 1 then
ffirstvisiblechar := 1;
end
else
begin
leditrect := geteditrect;
if passwordkind <> pknone then
while ((fcaretposition – ffirstvisiblechar + 1) * getpasswordcharwidth >
leditrect.right – leditrect.left)
and (ffirstvisiblechar < length(text)) do
inc(ffirstvisiblechar)
else
begin
canvas.font.assign(controlfont);
{while (textwidth(canvas, copy(text, ffirstvisiblechar, fcaretposition –
ffirstvisiblechar + 1), dt_noprefix) > leditrect.right – leditrect.left)
and (ffirstvisiblechar < length(text)) do
inc(ffirstvisiblechar); }
while (canvas.textwidth(copy(text, ffirstvisiblechar, fcaretposition –
ffirstvisiblechar + 1)) > leditrect.right – leditrect.left)
and (ffirstvisiblechar < length(text)) do
inc(ffirstvisiblechar);
end;
end;
invalidate;
end;
procedure tsecustomedit.mousemove(shift: tshiftstate; x, y: integer);
var
oldcaretposition : integer;
tmpnewposition : integer;
begin
inherited;
if flmouseselecting then
begin
tmpnewposition := getcoordinateposition(x);
oldcaretposition := caretposition;
if (x > geteditrect.right) then
caretposition := tmpnewposition + 1
else
caretposition := tmpnewposition;
if sellength = 0 then
fselstart := oldcaretposition;
fselstart := caretposition;
fsellength := fsellength – (caretposition – oldcaretposition);
end;
end;
procedure tsecustomedit.mouseup(button: tmousebutton; shift: tshiftstate;
x, y: integer);
begin
inherited;
flmouseselecting := false;
end;
procedure tsecustomedit.copytoclipboard;
var
data : thandle;
dataptr : pointer;
size : cardinal;
s : widestring;
begin
if passwordkind = pknone then
if length(seltext) > 0 then
begin
s := seltext;
if not iswinnt then
begin
clipboard.astext := s;
end
else
begin
size := length(s);
data := globalalloc(gmem_moveable + gmem_ddeshare, 2 * size + 2);
try
dataptr := globallock(data);
try
move(pwidechar(s)^, dataptr^, 2 * size + 2);
clipboard.setashandle(cf_unicodetext, data);
finally
globalunlock(data);
end;
except
globalfree(data);
raise;
end;
end;
end;
end;
procedure tsecustomedit.pastefromclipboard;
var
data : thandle;
insertion : widestring;
begin
if readonly then
exit;
if clipboard.hasformat(cf_unicodetext) then
begin
data := clipboard.getashandle(cf_unicodetext);
try
if data <> 0 then
insertion := pwidechar(globallock(data));
finally
if data <> 0 then
globalunlock(data);
end;
end
else
insertion := clipboard.astext;
inserttext(insertion);
end;
procedure tsecustomedit.paintselectedtext;
var
tmprect : trect;
curchar : integer;
lpwcharwidth : integer;
begin
tmprect := getselrect;
if passwordkind <> pknone then
begin
lpwcharwidth := getpasswordcharwidth;
for curchar := 0 to length(getvisibleseltext) – 1 do
drawpasswordchar(rect(curchar * lpwcharwidth + tmprect.left,
tmprect.top,
(curchar + 1) * lpwcharwidth + tmprect.left,
tmprect.bottom),
true);
end
else
begin
canvas.font.assign(controlfont);
canvas.font.color := clhighlighttext;
drawtext(canvas, getvisibleseltext, tmprect, getalignmentflags or
dt_noprefix)
end;
end;
function tsecustomedit.getvisibleseltext: widestring;
begin
if selstart + 1 >= ffirstvisiblechar then
result := seltext
else
result := copy(seltext, ffirstvisiblechar – selstart, length(seltext) –
(ffirstvisiblechar – selstart) + 1);
end;
procedure tsecustomedit.buildpopupmenu;
var
tmpitem : tsecustomitem;
begin
fpopupmenu := createpopupmenu(self);
if fpopupmenu = nil then
exit;
tmpitem := createpopupmenuitem(fpopupmenu);
with tmpitem do
begin
caption := seditundo;
onclick := doundo;
end;
fpopupmenu.items.add(tmpitem);
tmpitem := createpopupmenuitem(fpopupmenu);
tmpitem.caption := -;
fpopupmenu.items.add(tmpitem);
tmpitem := createpopupmenuitem(fpopupmenu);
with tmpitem do
begin
caption := seditcut;
onclick := docut;
end;
fpopupmenu.items.add(tmpitem);
tmpitem := createpopupmenuitem(fpopupmenu);
with tmpitem do
begin
caption := seditcopy;
onclick := docopy;
end;
fpopupmenu.items.add(tmpitem);
tmpitem := createpopupmenuitem(fpopupmenu);
with tmpitem do
begin
caption := seditpaste;
onclick := dopaste;
end;
fpopupmenu.items.add(tmpitem);
tmpitem := createpopupmenuitem(fpopupmenu);
with tmpitem do
begin
caption := seditdelete;
onclick := dodelete;
end;
fpopupmenu.items.add(tmpitem);
tmpitem := createpopupmenuitem(fpopupmenu);
tmpitem.caption := -;
fpopupmenu.items.add(tmpitem);
tmpitem := createpopupmenuitem(fpopupmenu);
with tmpitem do
begin
caption := seditselectall;
onclick := doselectall;
end;
fpopupmenu.items.add(tmpitem);
end;
function tsecustomedit.createpopupmenu(aowner: tcomponent): tsecustompopupmenu;
begin
result := tsecustompopupmenu.create(aowner);
end;
function tsecustomedit.createpopupmenuitem(aowner: tcomponent): tsecustomitem;
begin
result := tsecustomitem.create(self);
end;
procedure tsecustomedit.docut(sender: tobject);
begin
cuttoclipboard;
end;
procedure tsecustomedit.docopy(sender: tobject);
begin
copytoclipboard;
end;
procedure tsecustomedit.dodelete(sender: tobject);
begin
clearselection;
end;
procedure tsecustomedit.dopaste(sender: tobject);
begin
pastefromclipboard;
end;
procedure tsecustomedit.updatepopupmenuitems;
function setitemenabled(event: tnotifyevent; aenabled: boolean):
tsecustomitem;
var
item : tsecustomitem;
begin
item := fpopupmenu.items.finditem(integer(@event), fkhandle);
if item <> nil then
item.enabled := aenabled;
result := item;
end;
var
seltextempty : boolean;
begin
if fpopupmenu = nil then
buildpopupmenu;
seltextempty := seltext <> ;
setitemenabled(doundo, factionstack.atleast(1) and not readonly);
setitemenabled(docut, seltextempty and (not (passwordkind <> pknone)) and not
readonly);
setitemenabled(docopy, seltextempty and not (passwordkind <> pknone));
setitemenabled(dopaste, (clipboard.astext <> ) and not readonly);
setitemenabled(dodelete, seltextempty and not readonly);
setitemenabled(doselectall, seltext <> text);
{ set properties }
fpopupmenu.popupmenuoptions := fcontextmenuoptions;
end;
function tsecustomedit.getnextwordbeging(startposition: integer): integer;
var
spacefound,
wordfound : boolean;
begin
result := startposition;
spacefound := false;
wordfound := false;
while (result + 2 <= length(text)) and
((not ((text[result + 1] <> widespace) and spacefound))
or not wordfound) do
begin
if text[result + 1] = widespace then
spacefound := true;
if text[result + 1] <> widespace then
begin
wordfound := true;
spacefound := false;
end;
result := result + 1;
end;
if not spacefound then
result := result + 1;
end;
function tsecustomedit.getprivwordbeging(startposition: integer): integer;
var
wordfound : boolean;
begin
result := startposition;
wordfound := false;
while (result > 0) and
((text[result] <> widespace) or not wordfound) do
begin
if text[result] <> widespace then
wordfound := true;
result := result – 1;
end;
end;
procedure tsecustomedit.clearselection;
var
tmps : widestring;
begin
if readonly then
exit;
tmps := text;
factionstack.fragmentdeleted(selstart + 1,
copy(tmps, selstart + 1, sellength));
delete(tmps, selstart + 1, sellength);
text := tmps;
caretposition := selstart;
sellength := 0;
end;
procedure tsecustomedit.cuttoclipboard;
begin
if passwordkind = pknone then
copytoclipboard;
clearselection;
end;
procedure tsecustomedit.selectall;
begin
setcaretposition(length(text));
selstart := 0;
sellength := length(text);
invalidate;
end;
procedure tsecustomedit.doselectall(sender: tobject);
begin
selectall;
end;
procedure tsecustomedit.drawpasswordchar(symbolrect: trect; selected: boolean);
var
r : trect;
rgn : hrgn;
begin
{ !!! dont forget include clipping rountines
char symbol image must not extend out of editrect}
rgn := createrectrgn(symbolrect.left, symbolrect.top, symbolrect.right,
symbolrect.bottom);
try
selectcliprgn(canvas.handle, rgn);
canvas.font.assign(controlfont);
if selected then
canvas.font.color := clhighlighttext;
r := symbolrect;
inflaterect(r, -2, -3);
case fpasswordkind of
pkchar: drawtext(canvas, fpasswordchar, symbolrect, dt_left or
dt_noprefix);
pkrect: fillrect(canvas, r, canvas.font.color);
pkroundrect: fillroundrect(canvas, r, 2, canvas.font.color);
pkcircle:
begin
r := rect(0, 0, rectwidth(r), rectwidth(r));
rectcenter(r, symbolrect);
fillroundrect(canvas, r, rectwidth(r) div 2 + 1, canvas.font.color);
end;
pktriangle:
begin
r := rect(0, 0, rectwidth(r), rectwidth(r));
if not odd(rectwidth(r)) then
r.right := r.right + 1;
rectcenter(r, symbolrect);
canvas.brush.color := canvas.font.color;
canvas.polygon([
point(r.left + rectwidth(r) div 2 + 1, r.top),
point(r.right, r.bottom),
point(r.left, r.bottom)
]);
end;
end;
finally
selectcliprgn(canvas.handle, 0);
deleteobject(rgn);
end;
end;
function tsecustomedit.canautosize(var newwidth, newheight: integer): boolean;
begin
result := true;
canvas.font.assign(controlfont);
newheight := textheight(canvas, pq) + geteditrect.top * 2;
end;
procedure tsecustomedit.selectword;
begin
selstart := getprivwordbeging(caretposition);
;
sellength := getnextwordbeging(selstart) – selstart;
caretposition := selstart + sellength;
end;
procedure tsecustomedit.updatecarete;
begin
canvas.font.assign(controlfont);
createcaret(handle, 0, 0, canvas.textheight(pq));
caretposition := fcaretposition;
showcaret;
end;
procedure tsecustomedit.hidecaret;
begin
windows.hidecaret(handle);
end;
procedure tsecustomedit.showcaret;
begin
windows.showcaret(handle);
end;
function tsecustomedit.getpasswordcharwidth: integer;
begin
canvas.font.assign(controlfont);
case fpasswordkind of
pkchar: result := canvas.textwidth(fpasswordchar);
pkrect, pkroundrect, pkcircle, pktriangle: result := canvas.textwidth( w);
else
result := 10;
end;
if result = 0 then
result := 1;
end;
procedure tsecustomedit.change;
begin
inherited changed;
if enabled and handleallocated then
setcaretposition(caretposition);
if assigned(fonchange) then
fonchange(self);
end;
procedure tsecustomedit.wmimestartcomposition(var message: tmessage);
var
imc : himc;
logfont : tlogfont;
cf : tcompositionform;
begin
inherited;
imc := immgetcontext(handle);
if imc <> 0 then
begin
if assigned(font) then
begin
getobject(font.handle, sizeof(tlogfont), @logfont);
immsetcompositionfont(imc, @logfont);
end;
cf.dwstyle := cfs_rect;
cf.rcarea := geteditrect;
cf.ptcurrentpos := point(getcharx(fcaretposition), cf.rcarea.top);
immsetcompositionwindow(imc, @cf);
immreleasecontext(handle, imc);
end;
end;
procedure tsecustomedit.wmimecomposition(var msg: tmessage);
var
imc : himc;
buff : widestring;
i : integer;
begin
if msg.lparam and gcs_resultstr <> 0 then
begin
imc := immgetcontext(handle);
if imc <> 0 then
begin
try
{ get the result string }
setlength(buff, immgetcompositionstringw(imc, gcs_resultstr, nil, 0) div
sizeof(widechar));
immgetcompositionstringw(imc, gcs_resultstr, pwidechar(buff),
length(buff) * sizeof(widechar));
finally
immreleasecontext(handle, imc);
end;
{ insert char messages for each char in string }
for i := 1 to length(buff) do
insertchar(buff[i]);
msg.result := 0;
exit;
end;
end;
inherited;
end;
procedure tsecustomedit.wmgetdlgcode(var msg: twmgetdlgcode);
begin
inherited;
msg.result := dlgc_wantarrows or dlgc_wantchars;
end;
procedure tsecustomedit.wmcut(var message: tmessage);
begin
cuttoclipboard;
end;
procedure tsecustomedit.wmcopy(var message: tmessage);
begin
copytoclipboard;
end;
procedure tsecustomedit.wmpaste(var message: tmessage);
begin
pastefromclipboard;
end;
procedure tsecustomedit.wmcontexmenu(var message: tmessage);
var
lform : tcustomform;
begin
inherited;
if csdesigning in componentstate then
exit;
updatepopupmenuitems;
lform := getparentform(self);
if lform <> nil then
lform.sendcancelmode(nil);
fpopupmenu.popupcomponent := self;
with message do
fpopupmenu.popup(lparamlo, lparamhi);
end;
procedure tsecustomedit.wmlbuttondblclk(var message: twmlbuttondblclk);
begin
inherited;
flmouseselecting := false;
selectword;
end;
procedure tsecustomedit.cmfontchanged(var message: tmessage);
begin
inherited;
controlfont.assign(font);
adjustsize;
updatecarete;
end;
procedure tsecustomedit.setfont(value: tfont);
begin
inherited font := value;
controlfont.assign(value);
adjustsize;
end;
function tsecustomedit.gettext: widestring;
begin
result := ftext;
end;
procedure tsecustomedit.settext(const value: widestring);
var
tmps : widestring;
loldtext : widestring;
begin
if not validtext(value) then
exit;
tmps := value;
loldtext := text;
if (value <> ) and (charcase <> ecnormal) then
case charcase of
ecuppercase: ftext := ansiuppercase(tmps);
eclowercase: ftext := ansilowercase(tmps);
end
else
ftext := tmps;
invalidate;
if text <> loldtext then
change;
end;
procedure tsecustomedit.setcaretposition(const value: integer);
begin
if value < 0 then
fcaretposition := 0
else
if value > length(text) then
fcaretposition := length(text)
else
fcaretposition := value;
updatefirstvisiblechar;
if sellength <= 0 then
fselstart := value;
if focused then
setcaretpos(getcharx(fcaretposition), geteditrect.top);
end;
procedure tsecustomedit.setpasswordchar(const value: widechar);
begin
if fpasswordchar <> value then
begin
if value <> widechar(#0) then
fpasswordkind := pkchar;
fpasswordchar := value;
invalidate;
caretposition := caretposition; //update caret position
end;
end;
procedure tsecustomedit.setsellength(const value: integer);
begin
if fsellength <> value then
begin
fsellength := value;
invalidate;
end;
end;
procedure tsecustomedit.setselstart(const value: integer);
begin
if fselstart <> value then
begin
sellength := 0;
fselstart := value;
caretposition := fselstart;
invalidate;
end;
end;
procedure tsecustomedit.setautoselect(const value: boolean);
begin
if fautoselect <> value then
fautoselect := value;
end;
function tsecustomedit.getselstart: integer;
begin
if fsellength > 0 then
result := fselstart
else
if fsellength < 0 then
result := fselstart + fsellength
else
result := caretposition;
end;
function tsecustomedit.getselrect: trect;
begin
result := geteditrect;
result.left := getcharx(selstart);
result.right := getcharx(selstart + sellength);
intersectrect(result, result, geteditrect);
end;
function tsecustomedit.getsellength: integer;
begin
result := abs(fsellength);
end;
function tsecustomedit.getseltext: widestring;
begin
result := copy(text, selstart + 1, sellength);
end;
procedure tsecustomedit.setcharcase(const value: teditcharcase);
var
tmps : widestring;
begin
if fcharcase <> value then
begin
fcharcase := value;
if text <> then
begin
tmps := text;
case value of
ecuppercase: text := ansiuppercase(tmps);
eclowercase: text := ansilowercase(tmps);
end;
end;
end;
end;
procedure tsecustomedit.sethideselection(const value: boolean);
begin
if fhideselection <> value then
begin
fhideselection := value;
invalidate;
end;
end;
procedure tsecustomedit.setmaxlength(const value: integer);
begin
if fmaxlength <> value then
begin
fmaxlength := value;
end;
end;
procedure tsecustomedit.setcursor(const value: tcursor);
begin
if value = crdefault then
inherited cursor := cribeam
else
inherited cursor := value;
end;
function tsecustomedit.validtext(newtext: widestring): boolean;
begin
result := true;
end;
procedure tsecustomedit.settextalignment(const value: talignment);
begin
if ftextalignment <> value then
begin
ftextalignment := value;
invalidate;
end;
end;
procedure tsecustomedit.updatecareteposition;
begin
setcaretposition(caretposition);
end;
procedure tsecustomedit.inserttext(atext: widestring);
var
tmps : widestring;
begin
if readonly then
exit;
tmps := text;
factionstack.fragmentdeleted(selstart + 1, copy(tmps, selstart + 1,
sellength));
delete(tmps, selstart + 1, sellength);
factionstack.fragmentinserted(selstart + 1, length(atext), sellength <> 0);
insert(atext, tmps, selstart + 1);
if (maxlength <= 0) or (length(tmps) <= maxlength) then
begin
text := tmps;
caretposition := selstart + length(atext);
end;
sellength := 0;
end;
procedure tsecustomedit.insertchar(ch: widechar);
begin
if readonly then
exit;
inserttext(ch);
end;
procedure tsecustomedit.insertafter(position: integer; s: widestring;
selected: boolean);
var
tmps : widestring;
insertion : widestring;
begin
tmps := text;
insertion := s;
if maxlength > 0 then
insertion := copy(insertion, 1, maxlength – length(tmps));
insert(insertion, tmps, position + 1);
text := tmps;
if selected then
begin
selstart := position;
sellength := length(insertion);
caretposition := selstart + sellength;
end;
end;
procedure tsecustomedit.deletefrom(position, length: integer; movecaret:
boolean);
var
tmps : widestring;
begin
tmps := text;
delete(tmps, position, length);
text := tmps;
if movecaret then
begin
sellength := 0;
selstart := position – 1;
end;
end;
procedure tsecustomedit.doundo(sender: tobject);
begin
undo;
end;
procedure tsecustomedit.wmundo(var message: tmessage);
begin
undo;
end;
procedure tsecustomedit.undo;
begin
factionstack.rollbackaction;
end;
procedure tsecustomedit.setpasswordkind(const value: tpasswordkind);
begin
if fpasswordkind <> value then
begin
fpasswordkind := value;
invalidate;
end;
end;
procedure tsecustomedit.setpopupmenublendvalue(const value: integer);
begin
fpopupmenublendvalue := value;
end;
procedure tsecustomedit.setpopupmenudropshadow(const value: boolean);
begin
fpopupmenudropshadow := value;
end;
procedure tsecustomedit.setpopupmenushadowwidth(const value: integer);
begin
fpopupmenushadowwidth := value;
end;
procedure tsecustomedit.setpopupmenushowanimation(
const value: tseanimationrec);
begin
fpopupmenushowanimation := value;
end;
procedure tsecustomedit.setpopupmenushowanimationtime(
const value: integer);
begin
fpopupmenushowanimationtime := value;
end;
procedure tsecustomedit.cmtextchanged(var msg: tmessage);
begin
inherited;
ftext := inherited text;
sellength := 0;
invalidate;
end;
procedure tsecustomedit.setpopupmenublend(const value: boolean);
begin
fpopupmenublend := value;
end;
procedure tsecustomedit.clear;
begin
text := ;
end;
procedure tsecustomedit.borderchanged;
begin
inherited;
adjustsize;
end;
procedure tsecustomedit.setcontextmenuoptions(const value: tsepopupmenuoptions);
begin
fcontextmenuoptions.assign(value);
end;
procedure tsecustomedit.cmenabledchanged(var msg: tmessage);
begin
if handleallocated and not (csdesigning in componentstate) then
enablewindow(handle, enabled);
invalidate;
end;
总共用了我一个半小时的时间去追踪，真tmd。为什么双字节冲突这么明显的bug开发人员都不去解决？
