公司采用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
{ !!! Don't 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开发人员都不去解决？
本文地址：http://com.8s8s.com/it/it5331.htm