kxedit.pas

Korea, a data table control 韩国数据表控件 必备

  ImeMode := imSHanguel;
  Font.Size := 10;
  Font.Name := '奔覆';
  Color := clWhite;
  ShowHint := True;

  FKeyPos:= 0;
  FKeyOption:= 0;

end;

destructor TKXCustomEdit.Destroy;
begin
  inherited Destroy;
end;

procedure TKXCustomEdit.DoEnter;
begin
  if (Length(Text)>0) and (Text[1]='-') then IsMinus := True
  else IsMinus := False;
  if SysLocale.FarEast and IsMasked then ImeMode := ImSAlpha;
  if FLinkStyle <> LSNormal then BoundsChanged;
  Color := FFocusColor;
  if FLabelCtl <> Nil then
    if FLabelCtlType = LCTFont then FLabelCtl.Font.Color := FLabelFcolor
    else FLabelCtl.Color := FLabelFcolor;
  inherited;
end;

procedure TKXCustomEdit.DoExit;
var
  t_Text : String;
begin
  if(FEditType in [ETInteger,ETCurrency,ETFloat,ETFloatCurrency, ETZnumber]) then
    try
      t_Text := FloatToStr(AsFloat);
    except
      Text := '0';
    end;

  Color := FUnFocusColor;
  if (FLinkStyle <> LsNormal) then BoundsChanged;
  if FLabelCtl <> Nil then
    if FLabelCtlType = LCTFont then FLabelCtl.Font.Color := FLabelEcolor
    else FLabelCtl.Color := FLabelEcolor;
  if FEditType = ETZnumber then
    if text = '' Then text := '0'
    else text := Format('%.'+IntToStr(Maxlength)+'d',[StrToInt(text)]);
  inherited DoExit;
end;

procedure TKXCustomEdit.Change;
begin
  if FAlignment <> TALeftJustify then begin
    if SendMessage(Handle,EM_GETLINECOUNT,1,0)>1 then begin
      SendMessage(Handle,WM_CHAR,8,$E0001);
      Exit;
    end;
  end;
  if not IsMasked and (FEditType <> ETString)and (FChangeCvt > 0) and
     EditCanModify then ConvertValue( Text );
  inherited;
end;

procedure TKXCustomEdit.ConvertValue( Str : string );
var Buff    : string;
    Pos,i,CurPos : integer;
    TmpValue : Extended;
begin
  if FChangeCvt > 0 then FChangeCvt := FChangeCvt-1;
  CurPos := SelStart;
  Pos := Length(Str);
  if Pos <= 0 then begin FValue:=0; Text := ''; Exit; end;
  Buff := '';
  i := 1;
  while i <= Pos do begin
    if(i = 1)and(Str[i] in ['-','+']) then begin
      if Str[i] = '-' then Buff := Buff+Str[i];
      inc(i);
    end else if Str[i] in ['0'..'9','.',',']then begin
      if Str[i] <> ',' then Buff := Buff+Str[i];
      inc(i);
    end else begin
      IsMinus:= False;
      Text := '0';
      SelStart := 1;
      FValue := 0;
      Exit;
    end;
  end;
  try
    if Buff = '-' then begin FValue := 0; Text := '0'; Exit; end;
    TmpValue := StrToFloat(Buff);
    if (FMinValue = 0) and (FMaxValue = 0) then FValue := TmpValue
    else if (TmpValue >= MinValue)and(TmpValue <= MaxValue) then FValue:= TmpValue
    else begin
      Application.MessageBox(PChar(Format('涝仿窍角 蔼篮 %n焊促 农绊 %n焊促 累酒具钦聪促.',
         [FMinValue,FMaxValue])),'[坷幅]',MB_OK);
    end;
    if FEditType = ETCurrency then begin
      Buff := FloatToCurrency(FValue);
      CurPos := CurPos+(Length(Buff)-Pos);
    end else if FEditType = ETFloatCurrency then begin
      Buff   := FloatToCurrency(FValue);
      CurPos := CurPos+(Length(Buff)-Pos);
    end else begin
      Pos := Length(Buff);
      Buff := FloatToStr(FValue);
      if Pos > Length(Buff) then CurPos := CurPos-1;
    end;
  except
    IsMinus := False;
    FValue := 0;
    Buff := '0';
    CurPos := 1;
  end;
  if Buff <> Text then begin
    Text := Buff;
    SelStart := CurPos;
  end;
end;

procedure TKXCustomEdit.BoundsChanged;
var
  R: TRect;
begin
  SetRect(R, 0, 0, ClientWidth - 2, ClientHeight+1);
  if FLinkStyle <> LsNormal then Dec(R.Right, FButtonWidth);
  SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
  SendMessage(Handle, EM_SCROLLCARET, 0, 0);
  if SysLocale.FarEast then SetImeCompositionWindow(Font, R.Left, R.Top);
  RePaint;
end;

procedure TKXCustomEdit.SetMinValue(Value : Extended);

begin
  if Value = FMinValue then Exit;
  if FEditType = ETInteger then begin
    if Value < MinLong then
       ShowMessage('Error : Integer MinValue > -2147483647')
    else if Value > MaxLong then
       ShowMessage('Error : Integer MinValue < 2147483647')
    else FMinValue := Value;
  end else FMinValue := Value;
end;

procedure TKXCustomEdit.SetMaxValue(Value : Extended);
begin
  if Value = FMaxValue then Exit;
  if FEditType = ETInteger then begin
    if Value < MinLong then
       ShowMessage('Error : Integer MaxValue > -2147483647')
    else if Value > MaxLong then
       ShowMessage('Error : Integer MaxValue < 2147483647')
    else FMaxValue := Value;
  end else FMaxValue := Value;
end;

procedure TKXCustomEdit.SetUnFocusColor(Value: TColor);
begin
  if Value = FUnFocusColor then Exit;
  FUnFocusColor := Value;
  if not Focused or (csDesigning in ComponentState) then Color := FUnFoCusColor;
end;

procedure TKXCustomEdit.SetEditType(Value: TEditTypes);
begin
  if Value = FEditType then Exit;
  FEditType := Value;
  if not IsMasked and (FEditType <> ETString) then begin
    ConvertValue( EditText );
  end;
  if FEditType = ETInteger then begin
    if FMinValue < MinLong then FMinValue := MinLong
    else if FMinValue > MaxLong then FMinValue := MaxLong;
    if FMaxValue < MinLong then FMaxValue := MinLong
    else if FMaxValue > MaxLong then FMaxValue := MaxLong;
  end;
  BoundsChanged;
end;

procedure TKXCustomEdit.SetLinkStyle(Value: TLinkStyle);
begin
  if Value = FLinkStyle then Exit;
  FLinkStyle := Value;
  BoundsChanged;
end;

procedure TKXCustomEdit.SetAlignment(Value : TAlignment);
begin
  if Value = FAlignment then Exit;
  FAlignment := Value;
  if HandleAllocated then ReCreateWnd;
end;

procedure TKXCustomEdit.SetInputChar(var Key: Char);
var APos : integer;
begin
  APos := SelStart;
  if Key = '-' then begin
    FChangeCvt := 1;
    if IsMinus then begin
      IsMinus := False;
      Text := Copy(Text,2,Length(Text));
      SelStart := APos-1;
    end else begin
      IsMinus := True;
      Text := '-'+Text;
      SelStart := APos+1;
      Perform(CM_TEXTCHANGED,0,0);
    end;
    Key := #0;
  end else if Key = '+' then begin
    if IsMinus then begin
      FChangeCvt := 1;
      IsMinus := False;
      Text := Copy(Text,2,Length(Text));
      SelStart := APos-1;
    end;
    Key := #0;
  end else if Key in ['0'..'9'] then begin
    if IsMinus and (SelStart=0) then SelStart := 1;
    if SelLength = 0 then FChangeCvt := 1
    else FChangeCvt := 3;
  end else if Key = #8 then begin
    if (APos=1) and IsMinus then IsMinus := False;
    if (Text<> '')and(Text[APos]=',')then SelStart := APos-1;
    FChangeCvt := 1;
  end else if Key = '.' then begin
    if(FEditType in [ETInteger,ETCurrency])or(Pos('.',Text)<>0)then Key := #0
    else if SelStart <> Length(Text) then FChangeCvt := 1;
  end else if Key in [^X,^C,^V] then begin
    if Key <> ^C then FChangeCvt := 1;
  end else Key := #0;
end;

procedure TKXCustomEdit.SetDeleteKey(var Key : Word; Shift : TShiftState);
var APos : integer;
begin
  if  (FEditType <> ETString) and
      (((Key = VK_DELETE) and ([ssShift, ssCtrl] * Shift = [])) or
      (Key = VK_BACK)) and EditCanModify then
  begin
    if Key = VK_DELETE then begin
      APos := SelStart;
      if(SelLength = 0)and(APos < Length(Text))and
        (Text[APos+1] = ',')then SelStart := APos+1;
    end;
    if (SelStart = 0) and IsMinus then IsMinus := False;
    FChangeCvt := 1;
  end;
end;

procedure TKXCustomEdit.EditButtonClick;
begin
  if Assigned(FOnButtonClick) then begin
    BoundsChanged;
    FOnButtonClick(Self);
  end;
end;

procedure TKXCustomEdit.WMPaint(var Message: TWMPaint);
begin
  PaintHandler(Message);
end;

procedure TKXCustomEdit.WMSetCursor(var Msg: TWMSetCursor);
var
  P: TPoint;
begin
  GetCursorPos(P);
  if (FLinkStyle <> LSNormal)and
     PtInRect(Rect(Width-FButtonWidth-4,0,ClientWidth,ClientHeight),
     ScreenToClient(P)) then
  begin
    Windows.SetCursor(LoadCursor(0, IDC_Arrow));
  end else inherited;
end;

procedure TKXCustomEdit.CMRecreateWnd(var Message: TMessage);
begin
  inherited;
  BoundsChanged;
end;

procedure TKXCustomEdit.CMEnter(var Message: TCMEnter);
begin
  inherited;
  if AutoSelect and not (csLButtonDown in ControlState) then SelectAll;
end;

procedure TKXCustomEdit.KeyDown(var Key: Word; Shift: TShiftState);
var
  Msg: TMsg;
  MyForm: TCustomForm;
begin
  SetDeleteKey(Key,Shift);
  if(FLinkStyle = LSEllipsis)and(FButtonShortCut = ShortCut(Key,Shift))
  then begin
    PeekMessage(Msg, Handle, WM_CHAR, WM_CHAR, PM_REMOVE);
    EditButtonClick;
    Key := 0;
  end else if FAllowArrow and (Key = VK_DOWN) then begin
    MyForm := GetParentForm(Self);
    if (FFocusCtl) and (fFocusNext <> Nil) then FFocusNext.SetFocus
    else SendMessage(MyForm.Handle, WM_NEXTDLGCTL, 0, 0);
    Key := 0;
  end else if FAllowArrow and (Key = VK_UP) then begin
    MyForm := GetParentForm(Self);
    if (FFocusCtl) and (FFocusPrior <> Nil) then FFocusPrior.SetFocus
    else SendMessage(MyForm.Handle, WM_NEXTDLGCTL, 1, 0);
    Key := 0;
  end else if FAllowEnter and (Key = VK_RETURN)and(Shift=[]) then begin
    MyForm := GetParentForm(Self);
    if (FFocusCtl) and (fFocusNext <> Nil) then FFocusNext.SetFocus
    else SendMessage(MyForm.Handle, WM_NEXTDLGCTL, 0, 0);
    inherited KeyDown(Key,Shift);
  end else inherited;
end;

procedure TKXCustomEdit.KeyPress(var Key: Char);
begin
  if not IsMasked and EditCanModify then begin
    if FEditType <> ETString then SetInputChar(Key);
  end;
  if (Key = Char(VK_RETURN)) or (Key = Char(VK_ESCAPE)) then
  begin
    GetParentForm(Self).Perform(CM_DIALOGKEY, Byte(Key), 0);
    if Key = Char(VK_RETURN) then begin
      inherited KeyPress(Key);
      Key := #0;
      Exit;
    end;
  end;
  inherited KeyPress(Key);
end;

procedure TKXCustomEdit.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  WasPressed: Boolean;
begin
  WasPressed := FPressed;
  StopTracking;
  if (Button = mbLeft)and(FLinkStyle = LSEllipsis)and WasPressed then
    EditButtonClick;
  inherited;
end;

procedure TKXCustomEdit.TrackButton(X,Y: Integer);
var
  NewState: Boolean;
  R: TRect;
begin
  SetRect(R, ClientWidth - fButtonWidth, 0, ClientWidth, ClientHeight);
  NewState := PtInRect(R, Point(X, Y));
  if FPressed <> NewState then begin
    FPressed := NewState;
    InvalidateRect(Handle, @R, False);
  end;
end;

procedure TKXCustomEdit.PaintWindow(DC: HDC);
var
  R: TRect;
  Flags: Integer;
  W,H: Integer;
begin
  if FLinkStyle <> LSNormal then
  begin
    if Ctl3D then
      SetRect(R,ClientWidth - FButtonWidth, 0,ClientWidth, ClientHeight)
    else
      SetRect(R,ClientWidth - FButtonWidth - 1, 1,ClientWidth-1, ClientHeight-1);
    Flags := 0;
    if FPressed then Flags := BF_FLAT;
    DrawEdge(DC, R, EDGE_RAISED, BF_RECT or BF_MIDDLE or Flags);
    Flags := ((R.Right - R.Left) shr 1) - 1 + Ord(FPressed);
    W := FButtonWidth shr 3;
    if W = 0 then W := 1;
    H := (R.Bottom-R.Top) shr 1 -1;
    PatBlt(DC, R.Left + Flags, R.Top + H, W, W, BLACKNESS);
    PatBlt(DC, R.Left + Flags - (W * 2), R.Top + H, W, W, BLACKNESS);
    PatBlt(DC, R.Left + Flags + (W * 2), R.Top + H, W, W, BLACKNESS);
    ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
  end;
  inherited PaintWindow(DC);
end;

procedure TKXCustomEdit.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbLeft) and (FLinkStyle <> LSNormal) and
     PtInRect(Rect(Width - FButtonWidth, 0, Width, Height), Point(X,Y)) then
  begin
    MouseCapture := True;
    FTracking := True;
    TrackButton(X, Y);
  end;
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TKXCustomEdit.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if FTracking then TrackButton(X, Y);
  inherited MouseMove(Shift, X, Y);
end;

procedure TKXCustomEdit.StopTracking;
begin
  if FTracking then begin
    TrackButton(-1, -1);
    FTracking := False;
    MouseCapture := False;
  end;
end;

procedure TKXCustomEdit.CreateParams(var Params: TCreateParams);
const
  Alignments: array[TAlignment] of Longint = (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or ES_MULTILINE or
                  WS_CLIPCHILDREN or Alignments[FAlignment];
end;

procedure TKXCustomEdit.WndProc(var Message: TMessage);
var HIMC       : HWnd;
    Sentence   : DWORD;
    Conversion : DWORD;
begin
  case Message.Msg of
    WM_IME_KEYDOWN :
      if SysLocale.FarEast and IsMasked then begin
        HIMC := ImmGetContext(Handle);
        if ImmGetConversionStatus(HIMC, Conversion, Sentence) then begin
          Conversion := Conversion and $FFFFFFFE;
          ImmSetConversionStatus(HIMC, Conversion, Sentence);
        end;
        ImmReleaseContext(Handle,HIMc);
        Exit;
      end;