1

我要解决的问题是在用户输入 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.
4

2 回答 2

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;
于 2012-11-16T01:41:36.207 回答
1

作为您开始的基础，如果不想派生每个 Edit-Component，这里是从 TCustomEdit 派生的每个组件的通用方法。

将 Edit-Component 的 MaxLength 设置为 Value > 0，这个 Unit 将在文本下方绘制一条细红线作为填充指示器。

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

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.
于 2012-11-16T11:40:16.633 回答