unitasinplaceeditbase.pas

仿速达界面控件

unit UnitASInplaceEditBase;

interface
uses
  UnitASEdit, UnitASUtils, Windows, Graphics, Messages,
  Controls, SysUtils, Dialogs, Classes;

type
  TCustomASInplaceEditBase = class(TCustomASEdit)
  private
    FOldValue: string;
    FCurrencySymbol: WideChar;
    FChineseCurrency: Boolean;
    FChinsesCurrencyCaret: TBitmap;
    procedure SetChineseCurrency(const Value: Boolean);
    function GetEditText: string;
    procedure SetEditText(const Value: string);
    procedure SetCurrencySymbol(const Value: WideChar);
    procedure WMImeStartComposition(var Message: TMessage); message
      WM_IME_STARTCOMPOSITION;
    procedure WMImeComposition(var Msg: TMessage); message WM_IME_COMPOSITION;

  protected
    
    function EditCanModify: Boolean; virtual;
    property ChineseCurrency: Boolean read FChineseCurrency write
      SetChineseCurrency;

    procedure PaintBuffer; override;
    procedure UpdateCarete; override;
    function GetCharX(A: integer): integer; override;
    function GetCoordinatePosition(x: integer): integer; override;
    procedure SetCaretPosition(const Value: integer); override;
    procedure KeyPress(var Key: Char); override;
    procedure SetSelStart(const Value: Integer); override;
    procedure SetSelLength(const Value: integer); override;
    procedure HasFocus; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    function CanAutoSize(var NewWidth: Integer;
      var NewHeight: Integer): Boolean; override;

  public

    property EditText: string read GetEditText write SetEditText;
    property CurrencySymbol: WideChar read FCurrencySymbol write
      SetCurrencySymbol;
    procedure Reset;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure InsertText(AText: WideString); override;
  published
  end;
implementation

uses ConvUtils, StrUtils;

{ TCustomASInplaceEditBase }

function TCustomASInplaceEditBase.CanAutoSize(var NewWidth,
  NewHeight: Integer): Boolean;
begin
  {
  if not FChineseCurrency then
  begin
    Result := inherited CanAutoSize(NewWidth,NewHeight);
    Exit;
  end;
  }
  Result := False;
end;

constructor TCustomASInplaceEditBase.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FChinsesCurrencyCaret := TBitmap.Create;
end;

destructor TCustomASInplaceEditBase.Destroy;
begin
  FChinsesCurrencyCaret.Free;
  inherited Destroy;
end;

function TCustomASInplaceEditBase.EditCanModify: Boolean;
begin
  Result := True;
end;

function TCustomASInplaceEditBase.GetCharX(A: integer): integer;
var
  I: Integer;
  AText: WideString;
  WholeWidth, CellWidth: Integer;
begin
  if not FChineseCurrency then
  begin
    Result := inherited GetCharX(A);
    Exit;
  end;

  WholeWidth := 0;
  AText := ChineseCurrencyText(EditText, FCurrencySymbol);

  CellWidth := CurrencyFrameCellWidth(Self.Canvas);
  for I := Length(AText) - 1 downto A do
  begin
    Inc(WholeWidth, CellWidth);
  end;
  Result := Self.Width - WholeWidth;
end;

function TCustomASInplaceEditBase.GetCoordinatePosition(
  x: integer): integer;
var
  Cw: Integer;
  Xp: Integer;
  AText: WideString;
  Pos: Integer;
begin
  if not FChineseCurrency then
  begin
    Result := inherited GetCoordinatePosition(x);
    Exit;
  end;
  Canvas.Font := Self.Font;
  Cw := CurrencyFrameCellWidth(Canvas);
  AText := ChineseCurrencyText(EditText, FCurrencySymbol);
  Pos := 0;
  Xp := Width;
  while Xp >= 0 do
  begin
    if X in [(Xp - Cw)..XP] then
    begin
      Break;
    end;
    Dec(XP, Cw);
    Inc(Pos);
  end;
  Result := Length(AText) - 1 - Pos;
end;

function TCustomASInplaceEditBase.GetEditText: string;
var
  CurrValue: Currency;
begin
  if not FChineseCurrency then
  begin
    Result := inherited Text;
    Exit;
  end;
  if not TryStrToCurr((inherited Text), CurrValue) then
    CurrValue := 0;
  inherited Text := FormatCurr('0.00', CurrValue);
  Result := inherited Text;
end;

procedure TCustomASInplaceEditBase.HasFocus;
var
  AText: WideString;
  Pos: Integer;
begin
  if not FChineseCurrency then
  begin
    inherited HasFocus;
    Exit;
  end;
  AText := ChineseCurrencyText(EditText, FCurrencySymbol);
  Pos := Length(Atext) - 1 - 2;
  UpdateCarete;
  CaretPosition := Pos;
end;

procedure TCustomASInplaceEditBase.InsertText(AText: WideString);
var
  TmpText: WideString;
begin
  inherited InsertText(AText);
  if FChineseCurrency then
  begin
    TmpText := ChineseCurrencyText(EditText, FCurrencySymbol);
    if CaretPosition >= Length(TmpText) - 1 - 1 then
      //输入整数数字的时候不允许光标跑到小数部分
    begin
      CaretPosition := Length(TmpText) - 1 - 2;
    end;
  end;
end;

procedure TCustomASInplaceEditBase.KeyDown(var Key: Word;
  Shift: TShiftState);
var
  AText:WideString;
begin
  if not FChineseCurrency then //如果不是中国样式货币风格就用原来的风格画出来
  begin
    inherited KeyDown(Key, Shift);
    Exit;
  end;
  AText:=ChineseCurrencyText(EditText,FCurrencySymbol);  
  case Key of //不能让这连个按键删除小数点否则变化就大了
    VK_DELETE:
      begin
        if CaretPosition <> Length(Atext) - 1 - 2 then
          inherited KeyDown(Key, Shift);
      end;
    VK_BACK:
      begin
        if CaretPosition >= Length(Atext) - 1 - 1 then
          inherited KeyDown(Key, Shift);
      end;
  else
    inherited KeyDown(Key, Shift);
  end;
end;

procedure TCustomASInplaceEditBase.KeyPress(var Key: Char);
var
  CurrValue: Currency;
  AText: WideString;
  TmpEditText: string;
begin
  if not FChineseCurrency then //如果不是中国样式货币风格就用原来的风格画出来
  begin
    inherited KeyPress(Key);
    Exit;
  end;

  AText := ChineseCurrencyText(EditText, FCurrencySymbol);
  if not TryStrToCurr(Text, CurrValue) then
    CurrValue := 0;
  case Key of
    '-':
      begin
        CurrValue := -1 * CurrValue;
        Text := CurrToStr(CurrValue);
      end;
    '.':
      begin
        if CaretPosition <= Length(Atext) - 1 - 2 then
        begin
          CaretPosition := Length(Atext) - 1 - 1;
        end
        else
        begin
          CaretPosition := Length(Atext) - 1 - 2;
        end;
        UpdateCarete;
      end;
    '0'..'9':
      begin
        if CaretPosition >= Length(Atext) - 1 - 1 then
          //在小数点位置，因为不让他编辑小数点，所以转移到小数后第一位
        begin
          TmpEditText := EditText;
          TmpEditText[CaretPosition + 1] := Key;
          EditText := TmpEditText;
          CaretPosition := CaretPosition + 1;
          Invalidate;
        end
        else
        begin
          inherited KeyPress(Key);
        end;
      end;
  end;
end;

procedure TCustomASInplaceEditBase.PaintBuffer;
var
  V: Currency;
begin
  if not FChineseCurrency then //如果不是中国样式货币风格就用原来的风格画出来
  begin
    inherited PaintBuffer;
    Exit;
  end;
  if not TryStrToCurr(Text, V) then
    V := 0;
  DrawCurrencyFrame(Canvas, Self.ClientRect, V, FCurrencySymbol, True);
end;

procedure TCustomASInplaceEditBase.Reset;
begin
  if Modified then
  begin
    EditText := FOldValue;
    Modified := False;
  end;
end;

procedure TCustomASInplaceEditBase.SetCaretPosition(
  const Value: integer);
var
  AText: WideString;
  TmpValue: Integer;
  LenValue: Integer;
begin
  AText := ChineseCurrencyText(EditText, FCurrencySymbol);
  LenValue := Length(AText);
  if not FChineseCurrency then
  begin
    inherited SetCaretPosition(Value);
  end
  else
  begin
    if Value < 0 then
      inherited SetCaretPosition(0)
    else
      if Value > LenValue - 1 then
        inherited SetCaretPosition(LenValue - 1)
      else
        inherited SetCaretPosition(Value);

    UpdateFirstVisibleChar;

    if Focused then
      SetCaretPos(GetCharX(CaretPosition), GetEditRect.Bottom);
  end;
end;

procedure TCustomASInplaceEditBase.SetChineseCurrency(
  const Value: Boolean);
var
  AText: WideString;
begin
  if FChineseCurrency <> Value then
  begin
    FChineseCurrency := Value;
    EditText := EditText;
    AText := ChineseCurrencyText(EditText, FCurrencySymbol);
    DestroyCaret;
    UpdateCarete;
    CaretPosition := Length(AText) - 1 - 2;
    CustomCursor := FChineseCurrency;
    if FChineseCurrency then
      Cursor := crDefault
    else
      Cursor := crIBeam;

    Invalidate;
  end;
end;

procedure TCustomASInplaceEditBase.SetCurrencySymbol(
  const Value: WideChar);
begin
  if FCurrencySymbol <> Value then
  begin
    FCurrencySymbol := Value;
    Invalidate;
  end;
end;

procedure TCustomASInplaceEditBase.SetEditText(const Value: string);
var
  CurrValue: Currency;
begin
  if (not FChineseCurrency) then
  begin
    if (GetEditText <> Value) then
    begin
      SetTextBuf(PChar(Value));
    end;
    Exit;
  end;
  if not TryStrToCurr(Value, CurrValue) then
    CurrValue := 0;
  SetTextBuf(PChar(FormatCurr('0.00', CurrValue)));
end;

procedure TCustomASInplaceEditBase.SetSelLength(const Value: integer);
begin
  if not FChineseCurrency then
  begin
    inherited SetSelLength(Value);
    Exit;
  end;
  inherited SetSelLength(0);
end;

procedure TCustomASInplaceEditBase.SetSelStart(const Value: Integer);
begin
  if not FChineseCurrency then
  begin
    inherited SetSelStart(Value);
    Exit;
  end;
end;

procedure TCustomASInplaceEditBase.UpdateCarete;
begin
  if not FChineseCurrency then
  begin
    inherited UpdateCarete;
    Exit;
  end;
  EditText := EditText;
  Canvas.Font.Assign(Self.Font);
  CreateCaret(Handle, 0, CurrencyFrameCellWidth(Canvas), 2);
  CaretPosition := CaretPosition;
  ShowCaret;
end;

procedure TCustomASInplaceEditBase.WMImeComposition(var Msg: TMessage);
begin
  //什么也不干
end;

procedure TCustomASInplaceEditBase.WMImeStartComposition(
  var Message: TMessage);
begin
  //什么也不干
end;

end.