Question

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.

Currently I’m doing something along the lines of

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

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.

Answer 1

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;