unitasedit.pas

仿速达界面控件

procedure TCustomASEdit.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 TCustomASEdit.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
        { 得到返回的字符串 }
        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;

      { 插入每一个字符 }
      for i := 1 to Length(Buff) do
        InsertChar(Buff[i]);

      Msg.Result := 0;
      Exit;
    end;
  end;

  inherited;
end;

procedure TCustomASEdit.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin
  inherited;
  Msg.Result := dlgc_WantArrows or DLGC_WANTCHARS;
end;

procedure TCustomASEdit.WMCut(var Message: TMessage);
begin
  CutToClipboard;
end;

procedure TCustomASEdit.WMCopy(var Message: TMessage);
begin
  CopyToClipboard;
end;

procedure TCustomASEdit.WMPaste(var Message: TMessage);
begin
  PasteFromClipboard;
end;

procedure TCustomASEdit.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  inherited;
  FLMouseSelecting := false;
  SelectWord;
end;

procedure TCustomASEdit.CMFontChanged(var Message: TMessage);
begin
  inherited;
  Self.Font.Assign(Font);
  AdjustSize;
  UpdateCarete;
end;

procedure TCustomASEdit.SetFont(Value: TFont);
begin
  inherited Font := Value;
  Self.Font.Assign(Value);
  AdjustSize;
end;

function TCustomASEdit.GetText: WideString;
begin
  Result := FText;
end;

procedure TCustomASEdit.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 TCustomASEdit.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 TCustomASEdit.SetPasswordChar(const Value: Char);
begin
  if FPasswordChar <> Value then
  begin
    FPasswordChar := Value;
    Invalidate;
    CaretPosition := CaretPosition;
  end;
end;

procedure TCustomASEdit.SetSelLength(const Value: integer);
begin
  if FSelLength <> Value then
  begin
    FSelLength := Value;
    Invalidate;
  end;
end;

procedure TCustomASEdit.SetSelStart(const Value: integer);
begin
  if FSelStart <> Value then
  begin
    SelLength := 0;
    FSelStart := Value;
    CaretPosition := FSelStart;
    Invalidate;
  end;
end;

procedure TCustomASEdit.SetAutoSelect(const Value: boolean);
begin
  if FAutoSelect <> Value then
    FAutoSelect := Value;
end;

function TCustomASEdit.GetSelStart: integer;
begin
  if FSelLength > 0 then
    Result := FSelStart
  else
    if FSelLength < 0 then
      Result := FSelStart + FSelLength
    else
      Result := CaretPosition;
end;

function TCustomASEdit.GetSelRect: TRect;
begin
  Result := GetEditRect;
  Result.Left := GetCharX(SelStart);
  Result.Right := GetCharX(SelStart + SelLength);
  //IntersectRect(Result, Result, GetEditRect);
end;

function TCustomASEdit.GetSelLength: integer;
begin
  Result := Abs(FSelLength);
end;

function TCustomASEdit.GetSelText: WideString;
begin
  Result := Copy(Text, SelStart + 1, SelLength);
end;

procedure TCustomASEdit.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 TCustomASEdit.SetHideSelection(const Value: Boolean);
begin
  if FHideSelection <> Value then
  begin
    FHideSelection := Value;
    Invalidate;
  end;
end;

procedure TCustomASEdit.SetMaxLength(const Value: Integer);
begin
  if FMaxLength <> Value then
  begin
    FMaxLength := Value;
  end;
end;

procedure TCustomASEdit.SetCursor(const Value: TCursor);
begin
  if (Value = crDefault) and (not FCustomCursor) then
    inherited Cursor := crIBeam
  else
    inherited Cursor := Value;
end;

function TCustomASEdit.ValidText(NewText: WideString): boolean;
begin
  Result := true;
end;

procedure TCustomASEdit.SetTextAlignment(const Value: TAlignment);
begin
  if FTextAlignment <> Value then
  begin
    FTextAlignment := Value;
    Invalidate;
  end;
end;

procedure TCustomASEdit.UpdateCaretePosition;
begin
  SetCaretPosition(CaretPosition);
end;

procedure TCustomASEdit.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 TCustomASEdit.InsertChar(Ch: WideChar);
begin
  if ReadOnly then
    Exit;

  InsertText(Ch);
end;

procedure TCustomASEdit.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 TCustomASEdit.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 TCustomASEdit.DoUndo(Sender: TObject);
begin
  UnDo;
end;

procedure TCustomASEdit.WMUnDo(var Message: TMessage);
begin
  UnDo;
end;

procedure TCustomASEdit.UnDo;
begin
  FActionStack.RollBackAction;
end;

procedure TCustomASEdit.CMTextChanged(var Msg: TMessage);
var
  ParentHandle      : HWND;
  ParenMessage      : TMessage;
begin
  inherited;
  FText := inherited Text;
  //ShowMessage(IntToStr(Integer(ComponentState)));
  SelLength := 0;
  Invalidate;
  if not HandleAllocated then
    Exit;
  ParentHandle := GetParent(Handle);
  with TWMCommand(ParenMessage) do
  begin
    Msg := WM_COMMAND;
    NotifyCode := EN_CHANGE;
    Ctl := Self.Handle;
  end;
  Windows.SendMessage(ParentHandle, ParenMessage.Msg, ParenMessage.WParam,
    ParenMessage.LParam);
end;

procedure TCustomASEdit.Clear;
begin
  Text := '';
end;

procedure TCustomASEdit.BorderChanged;
begin
  inherited;
  AdjustSize;
end;

procedure TCustomASEdit.CMEnabledChanged(var Msg: TMessage);
begin
  if HandleAllocated and not (csDesigning in ComponentState) then
    EnableWindow(Handle, Enabled);
  Invalidate;
end;

{function TCustomASEdit.GetBorderRect: TRect;
begin
  //Result := ClientRect;//Rect(0, 0, ClientWidth, ClientHeight);
  Result := Rect(0, 0, Width, Height);
  InflateRect(Result, -BorderWidth, -BorderWidth);
end;
}

procedure TCustomASEdit.Paint;
var
  SavedDC           : HDC;
  DoubleBuffer      : TBitmap;
  R                 : TRect;
  SaveIndex         : integer;
begin
  if (Width <= 0) or (Height <= 0) then
    Exit;
  SavedDC := Canvas.Handle;

  DoubleBuffer := TBitmap.Create;
  DoubleBuffer.Width := ClientWidth;
  DoubleBuffer.Height := ClientHeight;
  Canvas.Lock;
  Canvas.Handle := DoubleBuffer.Canvas.Handle;
  try
    Canvas.Font.Assign(Self.Font);

    PaintBuffer;

    //DoubleBuffer.Canvas .Draw(SavedDC, 0, 0);
    //Canvas.Handle := SavedDC;

  finally
    Canvas.Handle := SavedDC;
    Canvas.CopyRect(ClientRect, DoubleBuffer.Canvas, ClientRect);
    Canvas.Unlock;
    DoubleBuffer.Free;
  end;
end;
{
procedure TCustomASEdit.PaintBorder;
begin

end;
}

function TCustomASEdit.GetModified: Boolean;
begin
  if HandleAllocated then
    Result := SendMessage(Handle, EM_GETMODIFY, 0, 0) <> 0
  else
    Result := FModified;
end;

procedure TCustomASEdit.SetModified(const Value: Boolean);
begin
  if HandleAllocated then
    SendMessage(Handle, EM_SETMODIFY, Byte(Value), 0)
  else
    FModified := Value;
end;

procedure TCustomASEdit.EMGETMODIFY(var Msg: TMessage);
begin
  inherited;
  Msg.Result := Byte(FModified);
end;

procedure TCustomASEdit.EMSETMODIFY(var Msg: TMessage);
begin
  inherited;
  FModified := Boolean(Msg.WParam);
end;

procedure TCustomASEdit.EMGETSEL(var Message: TMessage);
var
  DW                : PDWORD;
begin
  Message.Result := 1;
  DW := PDWORD(Message.WParam);         //指针
  DW^ := SelStart;
  DW := PDWORD(Message.LParam);         //指针
  DW^ := SelStart + SelLength;
end;

procedure TCustomASEdit.EMSETSEL(var Message: TMessage);
begin
  Message.Result := 1;
  SelStart := Message.WParam;           //整数
  SelLength := Message.LParam - SelStart; //整数
end;

procedure TCustomASEdit.CMEnter(var Message: TCMEnter);
begin
  HasFocus;
end;

procedure TCustomASEdit.CMExit(var Message: TCMExit);
begin
  KillFocus;
end;

procedure TCustomASEdit.WMSetFocus(var Message: TWMSetFocus);
begin
  HasFocus;
end;

procedure TCustomASEdit.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    if (Ctl3D = False) then
    begin
      Style := Style or (ES_AUTOHSCROLL or ES_AUTOVSCROLL); // or
      //  BorderStyles[FBorderStyle];
    end
    else
    begin
      Style := Style or (ES_AUTOHSCROLL or ES_AUTOVSCROLL) or
        BorderStyles[FBorderStyle];
    end;
    if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
    begin
      Style := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
  end;
end;

procedure TCustomASEdit.SetBorderStyle(const Value: TBorderStyle);
begin
  if HandleAllocated then
  begin
    if FBorderStyle <> Value then
    begin
      FBorderStyle := Value;
      RecreateWnd;
    end;
  end;
end;

procedure TCustomASEdit.CMCtl3DChanged(var Message: TMessage);
begin
  if NewStyleControls and (FBorderStyle = bsSingle) then
  begin
    RecreateWnd;
  end;
  inherited;
end;

end.