抓狂小白的程式筆記

(* ---------------------------------------------------------------------------------------------- *)
// XBPassWordEdit_Unit
// Author: Kamilia

// 元件用途: 實現Edit部分文字屏蔽
// 用法
//   PWMarkerPos 屏蔽開始位置
//   PWMarkerLen 屏蔽長度

// 初版: 2019/11/18
(* ---------------------------------------------------------------------------------------------- *)
unit XBPassWordEdit_Unit;

interface

uses
  {$IFDEF VER150}
  SysUtils, Classes, Controls, StdCtrls, Messages, Graphics, Types, Windows;
  {$ELSE}
  System.SysUtils, System.Classes, Vcl.Controls, Vcl.StdCtrls, Winapi.Messages,
  Vcl.Graphics, System.Types, Winapi.Windows;
  {$ENDIF}
type
  TXBPassWordEdit = class(TCustomEdit)
  private
    FPWMarkerPos: Integer;
    FPWMarkerLen: Integer;
    procedure SetPWMarkerLen(const Value: Integer);
    procedure SetPWMarkerPos(const Value: Integer);
    procedure Change; override;
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
    procedure DrawPassWord(Canvas: TCanvas; PWPos, PWLen: Integer);
  protected
    property PWMarkerPos: Integer read FPWMarkerPos write SetPWMarkerPos default 0;
    property PWMarkerLen: Integer read FPWMarkerLen write SetPWMarkerLen default 0;
    procedure doEnter; override;
    procedure doExit; override;
  public
  published
  end;

  TXBPWEdit = class(TXBPassWordEdit)
  published
    property Align;
    property Anchors;
    property AutoSelect;
    property AutoSize;
    property BevelEdges;
    property BevelInner;
    property BevelKind default bkNone;
    property BevelOuter;
    property BevelWidth;
    property BiDiMode;
    property BorderStyle;
    property CharCase;
    property Color;
    property Constraints;
    property Ctl3D;
    property DoubleBuffered;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    property ImeMode;
    property ImeName;
    property MaxLength;
    property OEMConvert;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PasswordChar;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
    property OnChange;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;

    property PWMarkerPos;
    property PWMarkerLen;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Standard', [TXBPWEdit]);
end;

{ TXBPassWordEdit }

(* ---------------------------------------------------------------------------------------------- *)
// Change 文字改變觸發事件
(* ---------------------------------------------------------------------------------------------- *)
procedure TXBPassWordEdit.Change;
begin
  inherited Change;
  if PWMarkerLen > 0 then
    Invalidate;
end;

(* ---------------------------------------------------------------------------------------------- *)
// doEnter 進入元件觸發事件
(* ---------------------------------------------------------------------------------------------- *)
procedure TXBPassWordEdit.doEnter;
begin
  inherited;
  if PWMarkerLen > 0 then
    Invalidate;
end;

(* ---------------------------------------------------------------------------------------------- *)
// doExit 離開元件觸發事件
(* ---------------------------------------------------------------------------------------------- *)
procedure TXBPassWordEdit.doExit;
begin
  inherited;
  if PWMarkerLen > 0 then
    Invalidate;
end;

(* ---------------------------------------------------------------------------------------------- *)
// DrawPassWord 自訂繪製
(* ---------------------------------------------------------------------------------------------- *)
procedure TXBPassWordEdit.DrawPassWord(Canvas: TCanvas; PWPos, PWLen: Integer);
var
  Rect: TRect;
  function GetMarkText: string;
    function GetMask(len: integer): string;
    begin
      Result := '';
      while Length(Result) < len do
        Result := Result + '*';
    end;
  var l: Integer;
  begin
    l := Length(Text);
    if l < PWPos then
      Result := Text
    else if (l >= PWPos) and (l < PWPos + PWLen) then
      Result := Copy(Text, 1, PWPos-1) + GetMask(l - PWPos + 1)
    else
      Result := Copy(Text, 1, PWPos-1) + GetMask(PWLen) + Copy(Text, PWPos + PWLen, Length(Text));
  end;
begin
  Rect := GetClientRect;

  Canvas.Brush.Color := self.Color;
  Canvas.FillRect(Rect);

  Canvas.Font.Assign(Font);

  Canvas.TextOut(
    Rect.Left + 1,
    Rect.Top + 1,
    GetMarkText
  );
end;

(* ---------------------------------------------------------------------------------------------- *)
// SetPWMarkerLen 設定屏蔽長度
(* ---------------------------------------------------------------------------------------------- *)
procedure TXBPassWordEdit.SetPWMarkerLen(const Value: Integer);
begin
  FPWMarkerLen := Value;
  Invalidate;
end;

(* ---------------------------------------------------------------------------------------------- *)
// SetPWMarkerPos 設定屏蔽開始位置
(* ---------------------------------------------------------------------------------------------- *)
procedure TXBPassWordEdit.SetPWMarkerPos(const Value: Integer);
begin
  FPWMarkerPos := Value;
  Invalidate;
end;

(* ---------------------------------------------------------------------------------------------- *)
// WMPaint 收到繪製訊息
(* ---------------------------------------------------------------------------------------------- *)
procedure TXBPassWordEdit.WMPaint(var Msg: TWMPaint);
var
  DC: HDC;
  Canvas: TCanvas;
begin
  inherited;
  if PWMarkerLen > 0 then
  begin
    DC := GetDC(Handle);
    Canvas := TCanvas.Create;
    try
      Canvas.Handle := DC;
      DrawPassWord(Canvas, PWMarkerPos, PWMarkerLen);
    finally
      Canvas.Free;
      ReleaseDC(Handle, DC);
    end;
  end;
end;

end.