分享
 
 
 

研究心得------->Seskin控件包中SeskinEdit汉字问题的解决办法

王朝delphi·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

公司采用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开发人员都不去解决?

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有