513 lines
13 KiB
ObjectPascal
513 lines
13 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
The contents of this file are subject to the Mozilla Public License
|
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
|
with the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is: JvMaskEdit.PAS, released on 2001-02-28.
|
|
|
|
The Initial Developer of the Original Code is Sébastien Buysse [sbuysse att buypin dott com]
|
|
Portions created by Sébastien Buysse are Copyright (C) 2001 Sébastien Buysse.
|
|
All Rights Reserved.
|
|
|
|
Contributor(s): Michael Beck [mbeck att bigfoot dott com],
|
|
Rob den Braasem [rbraasem att xs4all dott nl],
|
|
Oliver Giesen [ogware att gmx dott net],
|
|
Peter Thornqvist [peter3 at sourceforge dot net].
|
|
|
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
|
located at http://jvcl.sourceforge.net
|
|
|
|
Known Issues:
|
|
-----------------------------------------------------------------------------}
|
|
// $Id: JvMaskEdit.pas 10699 2006-06-10 17:49:41Z obones $
|
|
|
|
unit JvMaskEdit;
|
|
|
|
{$I jvcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
Windows, Messages,
|
|
SysUtils, Classes, Graphics, Controls, Mask, Forms, StdCtrls,
|
|
JvComponent, JvTypes, JvCaret, JvToolEdit, JvExMask;
|
|
|
|
type
|
|
TJvCustomMaskEdit = class(TJvCustomComboEdit)
|
|
private
|
|
FHotTrack: Boolean;
|
|
FCaret: TJvCaret;
|
|
FEntering: Boolean;
|
|
FLeaving: Boolean;
|
|
FProtectPassword: Boolean;
|
|
FLastNotifiedText: string;
|
|
FHasLastNotifiedText: Boolean;
|
|
FOnSetFocus: TJvFocusChangeEvent;
|
|
FOnKillFocus: TJvFocusChangeEvent;
|
|
FWordWrap: Boolean;
|
|
FMultiLine: Boolean;
|
|
FAlignment: TAlignment;
|
|
FOnAfterPaint: TNotifyEvent;
|
|
FScrollBars: TScrollStyle;
|
|
FCanvas: TControlCanvas;
|
|
procedure SetHotTrack(Value: Boolean);
|
|
procedure SetAlignment(const Value: TAlignment);
|
|
procedure SetMultiLine(const Value: Boolean);
|
|
procedure SetScrollBars(const Value: TScrollStyle);
|
|
procedure SetWordWrap(const Value: Boolean);
|
|
function GetCanvas: TCanvas;
|
|
{$IFDEF VCL}
|
|
procedure SetPasswordChar(const Value: Char);
|
|
function GetPasswordChar: Char;
|
|
function GetText: TCaption;
|
|
procedure SetText(const Value: TCaption);
|
|
{$ENDIF VCL}
|
|
protected
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
procedure CaretChanged(Sender: TObject); dynamic;
|
|
procedure FocusKilled(NextWnd: THandle); override;
|
|
procedure FocusSet(PrevWnd: THandle); override;
|
|
procedure DoKillFocus(const ANextControl: TWinControl); virtual;
|
|
procedure DoSetFocus(const APreviousControl: TWinControl); virtual;
|
|
{$IFDEF VisualCLX}
|
|
function GetText: TCaption; override;
|
|
procedure SetText(const Value: TCaption); override;
|
|
{$ENDIF VisualCLX}
|
|
procedure MouseEnter(Control: TControl); override;
|
|
procedure MouseLeave(Control: TControl); override;
|
|
procedure SetCaret(const Value: TJvCaret);
|
|
procedure NotifyIfChanged;
|
|
procedure Change; override;
|
|
// (rom) not CLX compatible
|
|
procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
|
|
public
|
|
{$IFDEF VCL}
|
|
procedure DefaultHandler(var Msg); override;
|
|
{$ENDIF VCL}
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
property Entering: Boolean read FEntering;
|
|
property Leaving: Boolean read FLeaving;
|
|
protected
|
|
property Text: TCaption read GetText write SetText;
|
|
{$IFDEF VCL}
|
|
property PasswordChar: Char read GetPasswordChar write SetPasswordChar default #0;
|
|
{$ENDIF VCL}
|
|
// set to True to disable read/write of PasswordChar and read of Text
|
|
property ProtectPassword: Boolean read FProtectPassword write FProtectPassword default False;
|
|
property HotTrack: Boolean read FHotTrack write SetHotTrack default False;
|
|
property Caret: TJvCaret read FCaret write SetCaret;
|
|
property ShowButton default False;
|
|
|
|
property OnSetFocus: TJvFocusChangeEvent read FOnSetFocus write FOnSetFocus;
|
|
property OnKillFocus: TJvFocusChangeEvent read FOnKillFocus write FOnKillFocus;
|
|
|
|
// From Globus
|
|
property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssNone;
|
|
property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
|
|
property MultiLine: Boolean read FMultiLine write SetMultiLine default False;
|
|
property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
|
|
property OnAfterPaint: TNotifyEvent read FOnAfterPaint write FOnAfterPaint;
|
|
public
|
|
property Canvas: TCanvas read GetCanvas;
|
|
end;
|
|
|
|
TJvMaskEdit = class(TJvCustomMaskEdit)
|
|
published
|
|
{$IFDEF COMPILER6_UP}
|
|
property BevelEdges;
|
|
property BevelInner;
|
|
property BevelKind default bkNone;
|
|
property BevelOuter;
|
|
{$ENDIF COMPILER6_UP}
|
|
property Caret;
|
|
property ClipboardCommands;
|
|
property DisabledTextColor;
|
|
property DisabledColor;
|
|
property HintColor;
|
|
property HotTrack;
|
|
property ProtectPassword;
|
|
property OnEnabledChanged;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnParentColorChange;
|
|
|
|
property Anchors;
|
|
property AutoSelect;
|
|
property AutoSize;
|
|
property BorderStyle;
|
|
property CharCase;
|
|
property Color;
|
|
property Constraints;
|
|
property DragMode;
|
|
property Enabled;
|
|
property EditMask;
|
|
property Font;
|
|
{$IFDEF VCL}
|
|
property Flat;
|
|
property GroupIndex;
|
|
property ImeMode;
|
|
property ImeName;
|
|
property ParentFlat;
|
|
{$ENDIF VCL}
|
|
property MaxLength;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
{$IFDEF VCL}
|
|
property PasswordChar;
|
|
{$ENDIF VCL}
|
|
property PopupMenu;
|
|
property ReadOnly;
|
|
property ShowHint;
|
|
property ShowButton;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Text;
|
|
property Visible;
|
|
|
|
property OnChange;
|
|
property OnClick;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
{$IFDEF VCL}
|
|
property OnSetFocus;
|
|
property OnKillFocus;
|
|
{$ENDIF VCL}
|
|
property OnStartDrag;
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
const
|
|
UnitVersioning: TUnitVersionInfo = (
|
|
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvMaskEdit.pas $';
|
|
Revision: '$Revision: 10699 $';
|
|
Date: '$Date: 2006-06-10 19:49:41 +0200 (sam., 10 juin 2006) $';
|
|
LogPath: 'JVCL\run'
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
implementation
|
|
|
|
|
|
procedure TJvCustomMaskEdit.CaretChanged(Sender: TObject);
|
|
begin
|
|
FCaret.CreateCaret;
|
|
end;
|
|
|
|
procedure TJvCustomMaskEdit.Change;
|
|
begin
|
|
FLastNotifiedText := Text;
|
|
FHasLastNotifiedText := True;
|
|
inherited Change;
|
|
end;
|
|
|
|
constructor TJvCustomMaskEdit.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
FCanvas := TControlCanvas.Create;
|
|
FCanvas.Control := Self; //...i can draw now! :)
|
|
|
|
FHotTrack := False;
|
|
FCaret := TJvCaret.Create(Self);
|
|
FCaret.OnChanged := CaretChanged;
|
|
FEntering := False;
|
|
FLeaving := False;
|
|
|
|
FScrollBars := ssNone;
|
|
FAlignment := taLeftJustify;
|
|
FMultiLine := False;
|
|
FWordWrap := False;
|
|
|
|
ControlState := ControlState + [csCreating];
|
|
try
|
|
ShowButton := False; { force update }
|
|
finally
|
|
ControlState := ControlState - [csCreating];
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF VCL}
|
|
procedure TJvCustomMaskEdit.DefaultHandler(var Msg);
|
|
begin
|
|
case TMessage(Msg).Msg of
|
|
WM_CUT, WM_PASTE, EM_SETPASSWORDCHAR, WM_GETTEXT, WM_GETTEXTLENGTH:
|
|
if not ProtectPassword then
|
|
inherited DefaultHandler(Msg);
|
|
else
|
|
inherited DefaultHandler(Msg);
|
|
end;
|
|
end;
|
|
{$ENDIF VCL}
|
|
|
|
destructor TJvCustomMaskEdit.Destroy;
|
|
begin
|
|
FCaret.OnChanged := nil;
|
|
FreeAndNil(FCaret);
|
|
FCanvas.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvCustomMaskEdit.FocusKilled(NextWnd: THandle);
|
|
begin
|
|
FLeaving := True;
|
|
try
|
|
FCaret.DestroyCaret;
|
|
inherited FocusKilled(NextWnd);
|
|
DoKillFocus(FindControl(NextWnd));
|
|
finally
|
|
FLeaving := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomMaskEdit.DoKillFocus(const ANextControl: TWinControl);
|
|
begin
|
|
NotifyIfChanged;
|
|
if Assigned(FOnKillFocus) then
|
|
FOnKillFocus(Self, ANextControl);
|
|
end;
|
|
|
|
procedure TJvCustomMaskEdit.FocusSet(PrevWnd: THandle);
|
|
begin
|
|
FEntering := True;
|
|
try
|
|
inherited FocusSet(PrevWnd);
|
|
FCaret.CreateCaret;
|
|
DoSetFocus(FindControl(PrevWnd));
|
|
finally
|
|
FEntering := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomMaskEdit.DoSetFocus(const APreviousControl: TWinControl);
|
|
begin
|
|
if Assigned(FOnSetFocus) then
|
|
FOnSetFocus(Self, APreviousControl);
|
|
end;
|
|
|
|
{$IFDEF VCL}
|
|
function TJvCustomMaskEdit.GetPasswordChar: Char;
|
|
begin
|
|
Result := inherited PasswordChar;
|
|
end;
|
|
{$ENDIF VCL}
|
|
|
|
function TJvCustomMaskEdit.GetText: TCaption;
|
|
var
|
|
Tmp: Boolean;
|
|
begin
|
|
Tmp := ProtectPassword;
|
|
try
|
|
ProtectPassword := False;
|
|
{$IFDEF VCL}
|
|
Result := inherited Text;
|
|
{$ENDIF VCL}
|
|
{$IFDEF VisualCLX}
|
|
Result := inherited GetText;
|
|
{$ENDIF VisualCLX}
|
|
finally
|
|
ProtectPassword := Tmp;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomMaskEdit.MouseEnter(Control: TControl);
|
|
begin
|
|
if csDesigning in ComponentState then
|
|
Exit;
|
|
if not MouseOver then
|
|
begin
|
|
if HotTrack then
|
|
{$IFDEF VCL}
|
|
Ctl3D := True;
|
|
{$ENDIF VCL}
|
|
{$IFDEF VisualCLX}
|
|
BorderStyle := bsSingle;
|
|
{$ENDIF VisualCLX}
|
|
inherited MouseEnter(Control);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomMaskEdit.MouseLeave(Control: TControl);
|
|
begin
|
|
if MouseOver then
|
|
begin
|
|
if FHotTrack then
|
|
{$IFDEF VCL}
|
|
Ctl3D := False;
|
|
{$ENDIF VCL}
|
|
{$IFDEF VisualCLX}
|
|
BorderStyle := bsSingle; // maybe bsNone
|
|
{$ENDIF VisualCLX}
|
|
inherited MouseLeave(Control);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomMaskEdit.NotifyIfChanged;
|
|
begin
|
|
if FHasLastNotifiedText and (FLastNotifiedText <> Text) then
|
|
Change;
|
|
end;
|
|
|
|
procedure TJvCustomMaskEdit.SetCaret(const Value: TJvCaret);
|
|
begin
|
|
FCaret.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvCustomMaskEdit.SetHotTrack(Value: Boolean);
|
|
begin
|
|
FHotTrack := Value;
|
|
if Value then
|
|
begin
|
|
{$IFDEF VCL}
|
|
Ctl3D := False;
|
|
{$ENDIF VCL}
|
|
{$IFDEF VisualCLX}
|
|
BorderStyle := bsSingle; // maybe bsNone
|
|
{$ENDIF VisualCLX}
|
|
end
|
|
else
|
|
begin
|
|
{$IFDEF VCL}
|
|
Ctl3D := True;
|
|
{$ENDIF VCL}
|
|
{$IFDEF VisualCLX}
|
|
BorderStyle := bsSingle;
|
|
{$ENDIF VisualCLX}
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF VCL}
|
|
procedure TJvCustomMaskEdit.SetPasswordChar(const Value: Char);
|
|
var
|
|
Tmp: Boolean;
|
|
begin
|
|
Tmp := ProtectPassword;
|
|
try
|
|
ProtectPassword := False;
|
|
inherited PasswordChar := Value;
|
|
finally
|
|
ProtectPassword := Tmp;
|
|
end;
|
|
end;
|
|
{$ENDIF VCL}
|
|
|
|
procedure TJvCustomMaskEdit.SetText(const Value: TCaption);
|
|
begin
|
|
{$IFDEF VCL}
|
|
inherited Text := Value;
|
|
{$ENDIF VCL}
|
|
{$IFDEF VisualCLX}
|
|
inherited SetText(Value);
|
|
{$ENDIF VisualCLX}
|
|
end;
|
|
|
|
procedure TJvCustomMaskEdit.SetAlignment(const Value: TAlignment);
|
|
begin
|
|
if FAlignment <> Value then
|
|
begin
|
|
FAlignment := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomMaskEdit.SetMultiLine(const Value: Boolean);
|
|
begin
|
|
if FMultiLine <> Value then
|
|
begin
|
|
FMultiLine := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomMaskEdit.SetScrollBars(const Value: TScrollStyle);
|
|
begin
|
|
if FScrollBars <> Value then
|
|
begin
|
|
FScrollBars := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomMaskEdit.SetWordWrap(const Value: Boolean);
|
|
begin
|
|
if FWordWrap <> Value then
|
|
begin
|
|
FWordWrap := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomMaskEdit.GetCanvas: TCanvas;
|
|
begin
|
|
Result := FCanvas;
|
|
end;
|
|
|
|
procedure TJvCustomMaskEdit.CreateParams(var Params: TCreateParams);
|
|
begin
|
|
inherited CreateParams(Params);
|
|
|
|
Params.Style := Params.Style or WS_CLIPCHILDREN;
|
|
|
|
if FMultiline then
|
|
Params.Style := Params.Style or ES_MULTILINE;
|
|
|
|
case FAlignment of
|
|
taLeftJustify:
|
|
Params.Style := Params.Style or ES_LEFT;
|
|
taRightJustify:
|
|
Params.Style := Params.Style or ES_RIGHT;
|
|
taCenter:
|
|
Params.Style := Params.Style or ES_CENTER;
|
|
end;
|
|
|
|
case FScrollBars of
|
|
ssHorizontal:
|
|
Params.Style := Params.Style or WS_HSCROLL;
|
|
ssVertical:
|
|
Params.Style := Params.Style or WS_VSCROLL;
|
|
ssBoth:
|
|
Params.Style := Params.Style or WS_HSCROLL or WS_VSCROLL;
|
|
end;
|
|
|
|
if FWordWrap then
|
|
Params.Style := Params.Style or ES_AUTOHSCROLL;
|
|
end;
|
|
|
|
procedure TJvCustomMaskEdit.WMPaint(var Msg: TWMPaint);
|
|
begin
|
|
inherited;
|
|
if Assigned(FOnAfterPaint) then
|
|
FOnAfterPaint(Self);
|
|
end;
|
|
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
initialization
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
|
|
finalization
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
end.
|