使TDBEdit显示剩余的字符 [英] Make a TDBEdit show the characters remaining

问题描述

我要解决的问题是向用户显示在TDBEdit中键入时字段中剩余的剩余字符。

The problem I'm wanting to solve is to display to the user the remaining characters left in a field as they are typing into a TDBEdit.

当前，我m按照

lCharRemaining.Caption := Field.Size - length(dbedit.text);

即更新TDBEdit的OnChange事件中的标签，效果很好。但是，我想对许多TDBEdit进行此操作，并尝试编写一个自定义组件，该组件将在右侧的编辑框中显示剩余的长度。但是，它会干扰编辑。我也许以为我可以在有人键入时显示提示，指出字段中的剩余空间-有任何建议吗？

i.e. updating a label in the OnChange event for the TDBEdit, which works perfectly fine. However I'm wanting to do this for a number of TDBEdits and tried to write a custom component that would display the length remaining within the edit box on the right. It however interferes with editing. I was perhaps thinking that I could display a hint while someone was typing indicating the remaining space in the field - any suggestions?

这是我组件的代码（如果有人可以提出改进建议。

Here is the code for my component (if someone can suggest improvements).

unit DBEditWithLenghtCountdown;

interface

uses
  SysUtils, Classes, Controls, StdCtrls, Mask, DBCtrls, messages, Graphics;

type
  TDBEditWithLenghtCountdown = class(TDBEdit)
  private
    { Private declarations }
    FCanvas: TCanvas;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  protected
    { Protected declarations }
    property Canvas: TCanvas read FCanvas;
    procedure WndProc(var Message: TMessage); override;
  public
    { Public declarations }
    function CharactersRemaining : integer;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
  end;

procedure Register;

implementation

uses
  db, Types;

procedure Register;
begin
  RegisterComponents('Samples', [TDBEditWithLenghtCountdown]);
end;

{ TDBEditWithLenghtCountdown }

function TDBEditWithLenghtCountdown.CharactersRemaining: integer;
begin
  result := -1;
  if Assigned(Field)then
  begin
    result := Field.Size - Length(Text);
  end;
end;

constructor TDBEditWithLenghtCountdown.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;
end;

destructor TDBEditWithLenghtCountdown.Destroy;
begin
  FCanvas.Free;
  inherited;
end;

procedure TDBEditWithLenghtCountdown.WMPaint(var Message: TWMPaint);
var
  R: TRect;
  Remaining : string;
  WidthOfText: Integer;
  x: Integer;
begin
  inherited;
  if not focused then
    exit;


  Remaining := IntToStr(CharactersRemaining);
  R := ClientRect;
  Inc(R.Left, 1);
  Inc(R.Top, 1);
  Canvas.Brush.Assign(Self.Brush);
  Canvas.Brush.Style := bsClear;
  Canvas.Font.Assign(Self.Font);
  Canvas.Font.Color := clRed;

  WidthOfText := Canvas.TextWidth(Remaining);
  x := R.right - WidthOfText - 4;
  Canvas.TextOut(x,2, Remaining);
end;

procedure TDBEditWithLenghtCountdown.WndProc(var Message: TMessage);
begin
  inherited WndProc(Message);
  with Message do
    case Msg of
      CM_MOUSEENTER, CM_MOUSELEAVE, WM_LBUTTONUP, WM_LBUTTONDOWN,
      WM_KEYDOWN, WM_KEYUP,
      WM_SETFOCUS, WM_KILLFOCUS,
      CM_FONTCHANGED, CM_TEXTCHANGED:
      begin
        Invalidate;
      end;
   end; // case
end;

end.

推荐答案

您可以测试不显示任何文字的样子通过设置编辑边距为提示文本留出空间来进行干预。快速测试：

You can test how it would look like without any text interference by setting the edit margins to leave space for the tip text. A quick test:

type
  TDBEditWithLenghtCountdown = class(TDBEdit)
    ..
  protected
    procedure CreateWnd; override;
    property Canvas: TCanvas read FCanvas;
    ..


procedure TDBEditWithLenghtCountdown.CreateWnd;
var
  MaxWidth, Margins: Integer;
begin
  inherited;
  MaxWidth := Canvas.TextWidth('WW');
  Margins := Perform(EM_GETMARGINS, 0, 0);
  Margins := MakeLong(HiWord(Margins), LoWord(Margins) + MaxWidth);
  Perform(EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, Margins);
end;

除了个人观点外，我觉得有些困惑。我可能要做的是在派生的编辑上发布一个状态面板字段，并在编辑控件的文本更改时为其分配一些文本。

Beyond this is personal opinion but I find this a bit confusing. What I would do is probably publish a status panel field on the derived edit, and output some text to it if it is assigned when the text of the edit control changes.

编辑：这是一个扩展版本，应解决注释中提到的问题（如果向左导航带有长文本，编辑文本将覆盖提示文本），并且仅在控件具有焦点。 （不是完整的代码重复出现的问题，只有修改的位。）

edit: Here's a somewhat extended version that should take care of the issue mentioned in the comment (if navigate left with a long text, edit text overwrites tip text), and also sets margins only if the control has focus. (Not full code duplicated from the question, only modified bits.)

type
  TDBEditWithLenghtCountdown = class(TDBEdit)
  private
    FCanvas: TCanvas;
    FTipWidth: Integer;
    FDefMargins: Integer;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  protected
    ..


procedure TDBEditWithLenghtCountdown.WMPaint(var Message: TWMPaint);
var
  PaintStruct: TPaintStruct;
  EndPaint: Boolean;
  Rgn: HRGN;
  R, TipR: TRect;
  Remaining : string;
begin
  if not Focused then
    inherited
  else begin
    EndPaint := Message.Dc = 0;
    if Message.DC = 0 then
      Message.DC := BeginPaint(Handle, PaintStruct);

    R := ClientRect;
    TipR := R;
    TipR.Left := TipR.Right - FTipWidth;
    Remaining := IntToStr(CharactersRemaining);
    Canvas.Handle := Message.DC;
    SetBkColor(Canvas.Handle, ColorToRGB(Color));
    Canvas.Font := Font;
    Canvas.Font.Color :=  clRed;
    Canvas.TextRect(TipR, Remaining, [tfSingleLine, tfCenter, tfVerticalCenter]);

    R.Right := TipR.Left;
    Rgn := CreateRectRgn(R.Left, R.Top, R.Right, R.Bottom);
    SelectClipRgn(Canvas.Handle, Rgn);
    DeleteObject(Rgn);
    inherited;
    if EndPaint then
      windows.EndPaint(Handle, PaintStruct);
  end;
end;

procedure TDBEditWithLenghtCountdown.WndProc(var Message: TMessage);
const
  TipMargin = 3;
begin
  inherited WndProc(Message);
  with Message do
    case Msg of
      CM_MOUSEENTER, CM_MOUSELEAVE, WM_LBUTTONUP, WM_LBUTTONDOWN,
      WM_KEYDOWN, WM_KEYUP,
      CM_TEXTCHANGED: Invalidate;
      WM_CREATE: FDefMargins := Perform(EM_GETMARGINS, 0, 0);
      CM_FONTCHANGED:
        begin
          Canvas.Handle := 0;
          Canvas.Font := Font;
          FTipWidth := Canvas.TextWidth('67') + 2 * TipMargin;
        end;
      WM_SETFOCUS:
        Perform(EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN,
            MakeLong(HiWord(FDefMargins), LoWord(FDefMargins) + FTipWidth));
      WM_KILLFOCUS:
        Perform(EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, FDefMargins);
    end;
end;

这篇关于使TDBEdit显示剩余的字符的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！