Question

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

目前我正在按照

的方式做点什么

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

即。更新TDBEdit的OnChange事件中的标签，完全正常。但是，我想为许多TDBEdits做这个，并尝试编写一个自定义组件，显示右侧编辑框中剩余的长度。但它干扰了编辑。我或许在想，当有人打字时我可以显示一个提示，表明该字段中的剩余空间 - 有任何建议吗？

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

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.

Answer 1

您可以通过设置编辑边距为小费文本留出空间来测试没有任何文本干扰的样子。快速测试：

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;

除此之外是个人意见，但我觉得这有点令人困惑。我要做的可能是在派生编辑上发布一个状态面板字段，如果在编辑控件的文本发生变化时分配它，则输出一些文本。

编辑：这是一个稍微扩展的版本，应该注意评论中提到的问题（如果使用长文本向左导航，编辑文本覆盖提示文本），并且仅在设置边距时设置边距控件有焦点。（不是从问题中复制完整代码，只修改了位。）

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;

Answer 2

作为您开始的基础，如果不想派生每个编辑组件，这里是从TCustomEdit派生的每个组件的一般方法。

将编辑组件的MaxLength设置为值＆gt; 0，此单位将在文本下方为您绘制一条细红线作为填充指示符。

该单位只需出现在您的项目中。

unit ControlInfoHandler;

interface

uses
  Vcl.Forms;

implementation

uses
  System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.StdCtrls;

type
  TControlInfoHandler = class( TComponent )
  private
    FCurrent :       TWinControl;
    FCurrentLength : Integer;
  protected
    procedure ActiveControlChange( Sender : TObject );
    procedure ApplicationIdle( Sender : TObject; var Done : Boolean );
    procedure Notification( AComponent : TComponent; Operation : TOperation ); override;
  end;

  THackedEdit = class( TCustomEdit )
  published
    property MaxLength;
  end;

var
  LControlInfoHandler : TControlInfoHandler;

  { TControlInfoHandler }

procedure TControlInfoHandler.ActiveControlChange( Sender : TObject );
begin
  FCurrent       := Screen.ActiveControl;
  FCurrentLength := 0;
  if Assigned( FCurrent )
  then
    FCurrent.FreeNotification( Self );
end;

procedure TControlInfoHandler.ApplicationIdle( Sender : TObject; var Done : Boolean );
var
  LEdit :   THackedEdit;
  LCanvas : TControlCanvas;
  LWidth :  Integer;
begin
  if not Assigned( FCurrent ) or not ( FCurrent is TCustomEdit )
  then
    Exit;

  LEdit := THackedEdit( FCurrent as TCustomEdit );

  if ( LEdit.MaxLength > 0 )
  then
    begin

      LCanvas         := TControlCanvas.Create;
      LCanvas.Control := LEdit;

      LCanvas.Pen.Style := psSolid;
      LCanvas.Pen.Width := 2;

      LWidth := LEdit.Width - 6;

      if FCurrentLength <> LEdit.GetTextLen
      then
        begin
          LCanvas.Pen.Color := LEdit.Color;
          LCanvas.MoveTo( 0, LEdit.Height - 4 );
          LCanvas.LineTo( LWidth, LEdit.Height - 4 );
        end;

      LCanvas.Pen.Color := clRed;
      LWidth            := LWidth * LEdit.GetTextLen div LEdit.MaxLength;

      LCanvas.MoveTo( 0, LEdit.Height - 4 );
      LCanvas.LineTo( LWidth, LEdit.Height - 4 );

      FCurrentLength := LEdit.GetTextLen;

    end;
end;

procedure TControlInfoHandler.Notification( AComponent : TComponent; Operation : TOperation );
begin
  inherited;
  if ( FCurrent = AComponent ) and ( Operation = opRemove )
  then
    FCurrent := nil;
end;

initialization

LControlInfoHandler          := TControlInfoHandler.Create( Application );
Screen.OnActiveControlChange := LControlInfoHandler.ActiveControlChange;
Application.OnIdle           := LControlInfoHandler.ApplicationIdle;

end.

使TDBEdit显示剩余的字符

2 个答案: