1

私が解決したい問題は、ユーザーが TDBEdit に入力しているときに、フィールドに残っている残りの文字をユーザーに表示することです。

現在、私は次の線に沿って何かをやっています

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

つまり、TDBEdit の OnChange イベントでラベルを更新すると、まったく問題なく動作します。ただし、いくつかの TDBEdit に対してこれを実行したいと考えており、右側の編集ボックス内に残りの長さを表示するカスタム コンポーネントを作成しようとしました。ただし、編集には干渉します。誰かが入力しているときに、フィールドの残りのスペースを示すヒントを表示できると考えていたのかもしれません。何か提案はありますか?

これが私のコンポーネントのコードです（誰かが改善を提案できる場合）。

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

すべての 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 に答える
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 に答える