CSDN博客

img wr960204

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

发表于2003/7/7 12:42:00  1320人阅读

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

相关博文

我的热门文章

img
取 消
img