{----------------------------------------------------------------------------- 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: JvNewEdit.PAS, released on 2002-mm-dd. 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. This unit is a merging of the original TJvEdit, TJvExEdit, TJvCaretEdit,TJvAlignedEdit, TJvSingleLineMemo. Merging done 2002-06-05 by Peter Thornqvist [peter3 at sourceforge dot net] MERGE NOTES: * TJvCustomEdit has been removed from JvComponent and put here instead. * The HotTrack property only works if BorderStyle := bsSingle and BevelKind := bvNone * Added ClipboardCommands Contributor(s): Anthony Steele [asteele att iafrica dott com] Peter Below [100113 dott 1101 att compuserve dott com] Rob den Braasem [rbraasem att xs4all dott nl] (GroupIndex property - using several TJvEdits with the same GroupIndex will clear the text from the other edits when something is typed into one of them. To disable GroupIndex, set it to -1) André Snepvangers [asn att xs4all dott nl] ( clx compatible version ) 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: JvEdit.pas 11246 2007-03-31 06:31:15Z marquardt $ unit JvEdit; {$I jvcl.inc} interface uses {$IFDEF UNITVERSIONING} JclUnitVersioning, {$ENDIF UNITVERSIONING} {$IFDEF CLR} Types, {$ENDIF CLR} Windows, Messages, {$IFDEF VisualCLX} Qt, {$ENDIF VisualCLX} Classes, Graphics, Controls, Menus, JvCaret, JvMaxPixel, JvTypes, JvExStdCtrls, JvDataSourceIntf; {$IFDEF VisualCLX} const clGrayText = clDisabledText; // Since when is clGrayText = clLight = clWhite? {$ENDIF VisualCLX} type TJvCustomEdit = class; TJvCustomEditDataConnector = class(TJvFieldDataConnector) private FEdit: TJvCustomEdit; protected procedure RecordChanged; override; procedure UpdateData; override; property Control: TJvCustomEdit read FEdit; public constructor Create(AEdit: TJvCustomEdit); end; TJvCustomEdit = class(TJvExCustomEdit) private {$IFDEF VisualCLX} FFlat: Boolean; {$ENDIF VisualCLX} FMaxPixel: TJvMaxPixel; FGroupIndex: Integer; FAlignment: TAlignment; FCaret: TJvCaret; FHotTrack: Boolean; FDisabledColor: TColor; FDisabledTextColor: TColor; FProtectPassword: Boolean; FStreamedSelLength: Integer; FStreamedSelStart: Integer; FUseFixedPopup: Boolean; FAutoHint: Boolean; {$IFDEF VisualCLX} FPasswordChar: Char; FNullPixmap: QPixmapH; {$ENDIF VisualCLX} FEmptyValue: string; FIsEmptyValue: Boolean; FEmptyFontColor: TColor; FOldFontColor: TColor; FIsLoaded: Boolean; {$IFDEF JVCLThemesEnabled} FThemedPassword: Boolean; FThemedFont: TFont; {$ENDIF JVCLThemesEnabled} FDataConnector: TJvFieldDataConnector; function GetPasswordChar: Char; function IsPasswordCharStored: Boolean; procedure SetAlignment(Value: TAlignment); procedure SetCaret(const Value: TJvCaret); procedure SetDisabledColor(const Value: TColor); virtual; procedure SetDisabledTextColor(const Value: TColor); virtual; procedure SetPasswordChar(Value: Char); procedure SetHotTrack(const Value: Boolean); {$IFDEF VCL} procedure WMPaint(var Msg: TWMPaint); message WM_PAINT; procedure CMHintShow(var Msg: TMessage); message CM_HINTSHOW; function IsFlatStored: Boolean; procedure ReadCtl3D(Reader: TReader); procedure ReadParentCtl3D(Reader: TReader); function GetParentFlat: Boolean; procedure SetParentFlat(const Value: Boolean); {$ENDIF VCL} procedure SetEmptyValue(const Value: string); procedure SetGroupIndex(Value: Integer); function GetFlat: Boolean; {$IFDEF JVCLThemesEnabled} procedure SetThemedPassword(const Value: Boolean); procedure WMSetFont(var Msg: TWMSetFont); message WM_SETFONT; function GetThemedFontHandle: HFONT; {$ENDIF JVCLThemesEnabled} procedure SetDataConnector(const Value: TJvFieldDataConnector); protected function CreateDataConnector: TJvFieldDataConnector; virtual; procedure WMCut(var Msg: TMessage); message WM_CUT; procedure WMPaste(var Msg: TMessage); message WM_PASTE; procedure WMClear(var Msg: TMessage); message WM_CLEAR; procedure WMUndo(var Msg: TMessage); message WM_UNDO; { (rb) renamed from UpdateEdit } procedure UpdateGroup; virtual; procedure SetClipboardCommands(const Value: TJvClipboardCommands); override; procedure CaretChanged(Sender: TObject); dynamic; procedure Change; override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyPress(var Key: Char); override; procedure MaxPixelChanged(Sender: TObject); procedure SetSelLength(Value: Integer); override; procedure SetSelStart(Value: Integer); override; function GetPopupMenu: TPopupMenu; override; {$IFDEF VCL} function GetText: TCaption; virtual; procedure SetText(const Value: TCaption); {$IFDEF CLR} reintroduce; {$ENDIF} virtual; procedure CreateHandle; override; procedure DestroyWnd; override; {$ENDIF VCL} {$IFDEF VisualCLX} function GetText: TCaption; override; {$ENDIF VisualCLX} procedure DoEnter; override; procedure DoExit; override; procedure DoEmptyValueEnter; virtual; procedure DoEmptyValueExit; virtual; {$IFDEF VisualCLX} procedure InitWidget; override; procedure Paint; override; // procedure TextChanged; override; function HintShow(var HintInfo: THintInfo): Boolean; override; {$ENDIF VisualCLX} procedure FocusSet(PrevWnd: THandle); override; procedure FocusKilled(NextWnd: THandle); override; function DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean; override; procedure EnabledChanged; override; procedure SetFlat(Value: Boolean); virtual; procedure MouseEnter(AControl: TControl); override; procedure MouseLeave(AControl: TControl); override; procedure Loaded; override; {$IFDEF VCL} procedure CreateParams(var Params: TCreateParams); override; {$ENDIF VCL} procedure DefineProperties(Filer: TFiler); override; public function IsEmpty: Boolean; constructor Create(AOwner: TComponent); override; destructor Destroy; override; {$IFDEF VCL} procedure DefaultHandler(var Msg); override; {$ENDIF VCL} protected property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify; property AutoHint: Boolean read FAutoHint write FAutoHint default False; property Caret: TJvCaret read FCaret write SetCaret; property EmptyValue: string read FEmptyValue write SetEmptyValue; property EmptyFontColor: TColor read FEmptyFontColor write FEmptyFontColor default clGrayText; property HotTrack: Boolean read FHotTrack write SetHotTrack default False; property PasswordChar: Char read GetPasswordChar write SetPasswordChar stored IsPasswordCharStored; {$IFDEF JVCLThemesEnabled} property ThemedPassword: Boolean read FThemedPassword write SetThemedPassword default False; {$ENDIF JVCLThemesEnabled} // set to True to disable read/write of PasswordChar and read of Text property ProtectPassword: Boolean read FProtectPassword write FProtectPassword default False; property DisabledTextColor: TColor read FDisabledTextColor write SetDisabledTextColor default clGrayText; property DisabledColor: TColor read FDisabledColor write SetDisabledColor default clWindow; {$IFDEF VCL} property Text: TCaption read GetText write SetText; property ParentFlat: Boolean read GetParentFlat write SetParentFlat default True; {$ENDIF VCL} property UseFixedPopup: Boolean read FUseFixedPopup write FUseFixedPopup default True; property HintColor; property MaxPixel: TJvMaxPixel read FMaxPixel write FMaxPixel; property GroupIndex: Integer read FGroupIndex write SetGroupIndex default -1; property OnParentColorChange; property Flat: Boolean read GetFlat write SetFlat {$IFDEF VisualCLX} default False; {$ENDIF VisualCLX}{$IFDEF VCL} stored IsFlatStored; {$ENDIF VCL} property DataConnector: TJvFieldDataConnector read FDataConnector write SetDataConnector; end; TJvEdit = class(TJvCustomEdit) published {$IFDEF VCL} {$IFDEF COMPILER6_UP} property BevelEdges; property BevelInner; property BevelKind default bkNone; property BevelOuter; {$ENDIF COMPILER6_UP} property BiDiMode; property DragCursor; property DragKind; property EmptyValue; // p3: clx not implemented yet property EmptyFontColor; // p3: clx not implemented yet property Flat; property ImeMode; property ImeName; property OEMConvert; property ParentBiDiMode; property ParentFlat; property UseFixedPopup; // asn: clx not implemented yet {$ENDIF VCL} property Caret; property DisabledTextColor; property DisabledColor; property HotTrack; property PasswordChar; property PopupMenu; property ProtectPassword; {$IFDEF VisualCLX} property EchoMode; property InputKeys; {$ENDIF VisualCLX} property Align; property Alignment; property ClipboardCommands; property HintColor; property GroupIndex; property MaxPixel; property Modified; { (rb) why published/stored? } {$IFDEF JVCLThemesEnabled} property ThemedPassword; {$ENDIF JVCLThemesEnabled} // property SelStart; (p3) why published? // property SelText; // property SelLength; (p3) why published? property OnMouseEnter; property OnMouseLeave; property OnParentColorChange; property Anchors; property AutoSelect; property AutoSize; property AutoHint; property BorderStyle; property CharCase; property Color; property Constraints; property DragMode; property Enabled; property Font; property HideSelection; property MaxLength; property ParentColor; property ParentFont; property ParentShowHint; property ReadOnly; property ShowHint; property TabOrder; property TabStop; property Text; property Visible; property OnChange; property OnClick; property OnContextPopup; property OnDblClick; property OnDragDrop; property OnDragOver; {$IFDEF VCL} property OnEndDock; property OnStartDock; {$ENDIF VCL} property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnStartDrag; property DataConnector; end; {$IFDEF UNITVERSIONING} const UnitVersioning: TUnitVersionInfo = ( RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvEdit.pas $'; Revision: '$Revision: 11246 $'; Date: '$Date: 2007-03-31 08:31:15 +0200 (sam., 31 mars 2007) $'; LogPath: 'JVCL\run' ); {$ENDIF UNITVERSIONING} implementation uses SysUtils, Math, Forms, {$IFDEF VCL} JvFixedEditPopup, {$ENDIF VCL} JvToolEdit; //=== Local procedures ======================================================= // (rom) StrFillChar replaced by StringOfChar function TextFitsInCtrl(Control: TControl; const Text: string): Boolean; var C: TControlCanvas; Size: TSize; begin C := TControlCanvas.Create; try C.Control := Control; {$IFDEF VisualCLX} C.StartPaint; {$ENDIF VisualCLX} Result := {$IFDEF CLR} not GetTextExtentPoint32(C.Handle, Text, Length(Text), Size) or {$ELSE} not GetTextExtentPoint32(C.Handle, PChar(Text), Length(Text), Size) or {$ENDIF CLR} { (rb) ClientWidth is too big, should be EM_GETRECT, don't know the Clx variant } (Control.ClientWidth > Size.cx); {$IFDEF VisualCLX} C.StopPaint; {$ENDIF VisualCLX} finally C.Free; end; end; //=== { TJvCustomEditDataConnector } ========================================= constructor TJvCustomEditDataConnector.Create(AEdit: TJvCustomEdit); begin inherited Create; FEdit := AEdit; end; procedure TJvCustomEditDataConnector.RecordChanged; begin if Field.IsValid then begin FEdit.ReadOnly := not Field.CanModify; FEdit.Text := Field.AsString; end else begin FEdit.Text := ''; FEdit.ReadOnly := False; end; end; procedure TJvCustomEditDataConnector.UpdateData; begin Field.AsString := FEdit.Text; FEdit.Text := Field.AsString; // update to stored value end; //=== { TJvCustomEdit } ====================================================== constructor TJvCustomEdit.Create(AOwner: TComponent); begin inherited Create(AOwner); FDataConnector := CreateDataConnector; {$IFDEF VisualCLX} FNullPixmap := QPixmap_create(1, 1, 1, QPixmapOptimization_DefaultOptim); {$ENDIF VisualCLX} FAlignment := taLeftJustify; // ControlStyle := ControlStyle + [csAcceptsControls]; ClipboardCommands := [caCopy..caUndo]; FDisabledColor := clWindow; FDisabledTextColor := clGrayText; FHotTrack := False; FCaret := TJvCaret.Create(Self); FCaret.OnChanged := CaretChanged; FStreamedSelLength := 0; FStreamedSelStart := 0; FUseFixedPopup := True; // asn: clx not implemented yet FMaxPixel := TJvMaxPixel.Create(Self); FMaxPixel.OnChanged := MaxPixelChanged; FGroupIndex := -1; FEmptyFontColor := clGrayText; end; destructor TJvCustomEdit.Destroy; begin FreeAndNil(FDataConnector); FMaxPixel.Free; FCaret.Free; {$IFDEF JVCLThemesEnabled} FThemedFont.Free; {$ENDIF JVCLThemesEnabled} {$IFDEF VisualCLX} QPixmap_destroy(FNullPixmap); {$ENDIF VisualCLX} inherited Destroy; end; function TJvCustomEdit.CreateDataConnector: TJvFieldDataConnector; begin Result := TJvCustomEditDataConnector.Create(Self); end; procedure TJvCustomEdit.CaretChanged(Sender: TObject); begin FCaret.CreateCaret; end; procedure TJvCustomEdit.Change; var St: string; Sel: Integer; begin inherited Change; if not HasParent then Exit; St := Text; FMaxPixel.Test(St, Font); if St <> Text then begin Sel := SelStart; Text := St; SelStart := Min(Sel, Length(Text)); end; if not (csLoading in ComponentState) then DataConnector.Modify; end; {$IFDEF VCL} procedure TJvCustomEdit.CMHintShow(var Msg: TMessage); {$IFDEF CLR} var Info: THintInfo; {$ENDIF CLR} begin if AutoHint and not TextFitsInCtrl(Self, Self.Text) then {$IFDEF CLR} with TCMHintShow.Create(Msg) do begin Info := HintInfo; Info.HintPos := Self.ClientToScreen(Point(-2, Height - 2)); Info.HintStr := Self.Text; HintInfo := Info; end {$ELSE} with TCMHintShow(Msg) do begin HintInfo.HintPos := Self.ClientToScreen(Point(-2, Height - 2)); HintInfo.HintStr := Self.Text; Result := 0; end {$ENDIF CLR} else inherited; end; {$ENDIF VCL} {$IFDEF VisualCLX} function TJvCustomEdit.HintShow(var HintInfo: THintInfo): Boolean; begin if AutoHint and not TextFitsInCtrl(Self, Self.Text) then begin HintInfo.HintPos := Self.ClientToScreen(Point(-2, Height - 2)); HintInfo.HintStr := Self.Text; end; Result := inherited HintShow(HintInfo); end; {$ENDIF VisualCLX} {$IFDEF VCL} procedure TJvCustomEdit.CreateHandle; begin inherited CreateHandle; if Focused then DoEmptyValueEnter else DoEmptyValueExit; end; {$ENDIF VCL} {$IFDEF VisualCLX} procedure TJvCustomEdit.InitWidget; begin inherited InitWidget; if Focused then DoEmptyValueEnter else DoEmptyValueExit; end; {$ENDIF VisualCLX} {$IFDEF VCL} procedure TJvCustomEdit.CreateParams(var Params: TCreateParams); const {$IFDEF JVCLThemesEnabled} Passwords: array [Boolean] of DWORD = (0, ES_PASSWORD); {$ENDIF JVCLThemesEnabled} Styles: array [TAlignment] of DWORD = (ES_LEFT, ES_RIGHT, ES_CENTER); begin inherited CreateParams(Params); Params.Style := Params.Style or Styles[FAlignment]; {$IFDEF JVCLThemesEnabled} Params.Style := Params.Style or Passwords[ThemedPassword]; {$ENDIF JVCLThemesEnabled} if (FAlignment <> taLeftJustify) and (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and (Win32MajorVersion = 4) and (Win32MinorVersion = 0) then Params.Style := Params.Style or ES_MULTILINE; // needed for Win95 end; procedure TJvCustomEdit.DefaultHandler(var Msg); begin if ProtectPassword then with TMessage(Msg) do case Msg of WM_CUT, WM_COPY, WM_GETTEXT, WM_GETTEXTLENGTH, EM_SETPASSWORDCHAR: Result := 0; else inherited DefaultHandler(Msg); end else inherited DefaultHandler(Msg); end; procedure TJvCustomEdit.DestroyWnd; var Tmp: Boolean; begin Tmp := ProtectPassword; try // TWinControl.DestroyWnd sends WM_GETTEXTLENGTH & WM_GETTEXT messages, // thus we have to temporarily set ProtectPassword to False. ProtectPassword := False; inherited DestroyWnd; finally ProtectPassword := Tmp; end; end; {$ENDIF VCL} procedure TJvCustomEdit.WMClear(var Msg: TMessage); begin if not ReadOnly then inherited; end; procedure TJvCustomEdit.WMCut(var Msg: TMessage); begin if not ReadOnly then inherited; end; procedure TJvCustomEdit.WMPaste(var Msg: TMessage); begin if not ReadOnly then begin inherited; UpdateGroup; end; end; procedure TJvCustomEdit.DoEmptyValueEnter; begin if (csDesigning in ComponentState) or not FIsLoaded or (EmptyValue = '') then Exit; if EmptyValue <> '' then begin if (inherited Text) = EmptyValue then begin inherited Text := ''; FIsEmptyValue := False; if not (csDesigning in ComponentState) then Font.Color := FOldFontColor; end; end else if not (csDesigning in ComponentState) then Font.Color := FOldFontColor; end; procedure TJvCustomEdit.DoEmptyValueExit; begin if (csDesigning in ComponentState) or not FIsLoaded or (EmptyValue = '') then Exit; if EmptyValue <> '' then begin if Text = '' then begin Text := EmptyValue; FIsEmptyValue := True; if not (csDesigning in ComponentState) then begin FOldFontColor := Font.Color; Font.Color := FEmptyFontColor; end; end; end else if not (csDesigning in ComponentState) then Font.Color := FOldFontColor; end; procedure TJvCustomEdit.DoEnter; begin inherited DoEnter; DoEmptyValueEnter; end; procedure TJvCustomEdit.DoExit; begin try DataConnector.UpdateRecord; except SetFocus; raise; end; inherited DoExit; DoEmptyValueExit; end; procedure TJvCustomEdit.FocusKilled(NextWnd: THandle); begin FCaret.DestroyCaret; inherited FocusKilled(NextWnd); end; function TJvCustomEdit.DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean; var R: TRect; begin if Enabled then Result := inherited DoEraseBackground(Canvas, Param) else begin Canvas.Brush.Color := FDisabledColor; Canvas.Brush.Style := bsSolid; R := ClientRect; Canvas.FillRect(R); Result := True; {$IFDEF VisualCLX} // paint Border if BorderStyle = bsSingle then QGraphics.DrawEdge(Canvas, R, esLowered, esLowered, ebRect); {$ENDIF VisualCLX} end; end; procedure TJvCustomEdit.FocusSet(PrevWnd: THandle); begin inherited FocusSet(PrevWnd); FCaret.CreateCaret; end; procedure TJvCustomEdit.WMUndo(var Msg: TMessage); begin if not ReadOnly then inherited; end; procedure TJvCustomEdit.EnabledChanged; begin inherited EnabledChanged; Invalidate; end; function TJvCustomEdit.GetFlat: Boolean; begin {$IFDEF VCL} Result := not Ctl3D; {$ENDIF VCL} {$IFDEF VisualCLX} Result := FFlat; {$ENDIF VisualClx} end; {$IFDEF VCL} function TJvCustomEdit.GetParentFlat: Boolean; begin Result := ParentCtl3D; end; procedure TJvCustomEdit.SetParentFlat(const Value: Boolean); begin ParentCtl3D := Value; end; {$ENDIF VCL} function TJvCustomEdit.GetPasswordChar: Char; begin {$IFDEF VCL} if HandleAllocated then Result := Char(SendMessage(Handle, EM_GETPASSWORDCHAR, 0, 0)) else Result := inherited PasswordChar; {$ENDIF VCL} {$IFDEF VisualCLX} Result := FPasswordChar; {$ENDIF VisualCLX} end; function TJvCustomEdit.GetPopupMenu: TPopupMenu; begin Result := inherited GetPopupMenu; {$IFDEF VCL} // user has not assigned his own popup menu, so use fixed default if (Result = nil) and UseFixedPopup then Result := FixedDefaultEditPopUp(Self); {$ENDIF VCL} end; // (ahuser) ProtectPassword has no function under CLX function TJvCustomEdit.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; if (Result = EmptyValue) and (EmptyValue <> '') then Result := ''; end; {$IFDEF JVCLThemesEnabled} function TJvCustomEdit.GetThemedFontHandle: HFONT; var AFont: TLogFont; begin GetObject(GetStockObject(DEFAULT_GUI_FONT), SizeOf(AFont), @AFont); AFont.lfHeight := Self.Font.Height; Result := CreateFontIndirect(AFont); end; {$ENDIF JVCLThemesEnabled} function TJvCustomEdit.IsEmpty: Boolean; begin Result := (Length(Text) = 0); end; {$IFDEF VCL} function TJvCustomEdit.IsFlatStored: Boolean; begin { Same as IsCtl3DStored } Result := not ParentCtl3D; end; {$ENDIF VCL} function TJvCustomEdit.IsPasswordCharStored: Boolean; begin Result := (PasswordChar <> #0) {$IFDEF JVCLThemesEnabled} and not ThemedPassword {$ENDIF}; end; procedure TJvCustomEdit.KeyDown(var Key: Word; Shift: TShiftState); begin UpdateGroup; inherited KeyDown(Key, Shift); end; procedure TJvCustomEdit.KeyPress(var Key: Char); begin inherited KeyPress(Key); if Key = #27 then begin if DataConnector.Active and DataConnector.Field.CanModify then begin DataConnector.Reset; SelectAll; Key := #0; end; end; end; procedure TJvCustomEdit.Loaded; begin inherited Loaded; { (rb) I think that csLoading flag can be used instead of FIsLoaded. FIsLoaded is set a bit later to true than csLoading but that does not matter AFAICS } FIsLoaded := True; FOldFontColor := Font.Color; SelStart := FStreamedSelStart; SelLength := FStreamedSelLength; DataConnector.Reset; end; {$IFDEF VCL} procedure TJvCustomEdit.ReadCtl3D(Reader: TReader); begin Flat := not Reader.ReadBoolean; end; procedure TJvCustomEdit.ReadParentCtl3D(Reader: TReader); begin ParentFlat := Reader.ReadBoolean; end; {$ENDIF VCL} procedure TJvCustomEdit.DefineProperties(Filer: TFiler); begin inherited DefineProperties(Filer); {$IFDEF VCL} Filer.DefineProperty('Ctl3D', ReadCtl3D, nil, False); Filer.DefineProperty('ParentCtl3D', ReadParentCtl3D, nil, False); {$ENDIF VCL} end; procedure TJvCustomEdit.MaxPixelChanged(Sender: TObject); var St: string; begin St := Text; FMaxPixel.Test(St, Font); if St <> Text then begin Text := St; SelStart := Min(SelStart, Length(Text)); end; end; procedure TJvCustomEdit.MouseEnter(AControl: TControl); var I, J: Integer; begin if csDesigning in ComponentState then Exit; if not MouseOver then begin if FHotTrack then begin I := SelStart; J := SelLength; Flat := False; SelStart := I; SelLength := J; end; // UpdateAutoHint; inherited MouseEnter(AControl); end; end; procedure TJvCustomEdit.MouseLeave(AControl: TControl); var I, J: Integer; begin if MouseOver then begin if FHotTrack then begin I := SelStart; J := SelLength; Flat := True; SelStart := I; SelLength := J; end; inherited MouseLeave(AControl); end; end; {$IFDEF VisualCLX} procedure TJvCustomEdit.Paint; var S: TCaption; begin if csDestroying in ComponentState then Exit; if Enabled then inherited Paint else begin if PasswordChar = #0 then S := Text else S := StringOfChar(PasswordChar, Length(Text)); if not PaintEdit(Self, S, FAlignment, False, {0,} FDisabledTextColor, Focused, Flat, Canvas) then inherited Paint; end; end; {$ENDIF VisualCLX} procedure TJvCustomEdit.SetAlignment(Value: TAlignment); begin if FAlignment <> Value then begin FAlignment := Value; {$IFDEF VCL} RecreateWnd; {$ENDIF VCL} {$IFDEF VisualCLX} inherited Alignment := FAlignment; Invalidate; {$ENDIF VisualCLX} end; end; procedure TJvCustomEdit.SetCaret(const Value: TJvCaret); begin FCaret.Assign(Value); end; procedure TJvCustomEdit.SetClipboardCommands(const Value: TJvClipboardCommands); begin if ClipboardCommands <> Value then begin inherited SetClipboardCommands(Value); ReadOnly := ClipboardCommands <= [caCopy]; end; end; procedure TJvCustomEdit.SetDisabledColor(const Value: TColor); begin if FDisabledColor <> Value then begin FDisabledColor := Value; if not Enabled then Invalidate; end; end; procedure TJvCustomEdit.SetDisabledTextColor(const Value: TColor); begin if FDisabledTextColor <> Value then begin FDisabledTextColor := Value; if not Enabled then Invalidate; end; end; procedure TJvCustomEdit.SetEmptyValue(const Value: string); begin FEmptyValue := Value; if HandleAllocated then if Focused then DoEmptyValueEnter else DoEmptyValueExit; end; procedure TJvCustomEdit.SetFlat(Value: Boolean); begin {$IFDEF VCL} Ctl3D := not Value; {$ENDIF VCL} {$IFDEF VisualCLX} if Value <> FFlat then begin FFlat := Value; if FFlat then BorderStyle := bsNone else BorderStyle := bsSingle; Invalidate; end; {$ENDIF VisualCLX} end; procedure TJvCustomEdit.SetGroupIndex(Value: Integer); begin if Value <> FGroupIndex then begin FGroupIndex := Value; UpdateGroup; end; end; procedure TJvCustomEdit.SetHotTrack(const Value: Boolean); begin FHotTrack := Value; Flat := FHotTrack; end; procedure TJvCustomEdit.SetPasswordChar(Value: Char); var Tmp: Boolean; begin Tmp := ProtectPassword; try ProtectPassword := False; {$IFDEF VCL} if HandleAllocated then inherited PasswordChar := Char(SendMessage(Handle, EM_GETPASSWORDCHAR, 0, 0)); inherited PasswordChar := Value; {$ENDIF VCL} {$IFDEF VisualCLX} FPasswordChar := Value; Invalidate; {$ENDIF VisualCLX} finally ProtectPassword := Tmp; end; end; procedure TJvCustomEdit.SetSelLength(Value: Integer); begin if csReading in ComponentState then FStreamedSelLength := Value else inherited SetSelLength(Value); end; procedure TJvCustomEdit.SetSelStart(Value: Integer); begin if csReading in ComponentState then FStreamedSelStart := Value else inherited SetSelStart(Value); end; {$IFDEF VCL} // (ahuser) ProtectPassword has no function under CLX procedure TJvCustomEdit.SetText(const Value: TCaption); begin if (csLoading in ComponentState) or not FIsLoaded then begin inherited Text := Value; Exit; end; FIsEmptyValue := (Value = '') and (EmptyValue <> ''); if not FIsEmptyValue then begin Font.Color := FOldFontColor; inherited Text := Value; end else begin Font.Color := FEmptyFontColor; inherited Text := EmptyValue; end; end; {$ENDIF VCL} {$IFDEF JVCLThemesEnabled} procedure TJvCustomEdit.SetThemedPassword(const Value: Boolean); begin if FThemedPassword <> Value then begin FThemedPassword := Value; if not FThemedPassword then FreeAndNil(FThemedFont); PasswordChar := #0; RecreateWnd; end; end; {$ENDIF JVCLThemesEnabled} procedure TJvCustomEdit.UpdateGroup; var I: Integer; begin if (FGroupIndex <> -1) and (Owner <> nil) then for I := 0 to Owner.ComponentCount - 1 do if (Owner.Components[I] is TJvCustomEdit) and (Owner.Components[I] <> Self) and (TJvCustomEdit(Owner.Components[I]).GroupIndex = Self.GroupIndex) then TJvCustomEdit(Owner.Components[I]).Clear; end; {$IFDEF VCL} procedure TJvCustomEdit.WMPaint(var Msg: TWMPaint); var Canvas: TControlCanvas; S: TCaption; begin if csDestroying in ComponentState then Exit; { PaintEdit does not work well when the edit is themed (and ThemedPassword=true), as a workaround check if the disabled colors are set to the default so the edit can paint itself (We must check both colors, although only DisabledTextColor is passed on to PaintEdit; PaintEdit triggers a DoEraseBackground call) } if Enabled or ((ColorToRGB(DisabledTextColor) = ColorToRGB(clGrayText)) and (ColorToRGB(DisabledColor) = ColorToRGB(clWindow))) then inherited else begin if PasswordChar = #0 then S := Text else S := StringOfChar(PasswordChar, Length(Text)); Canvas := nil; try if not PaintEdit(Self, S, FAlignment, False, {0,} FDisabledTextColor, Focused, Canvas, Msg) then inherited; finally Canvas.Free; end; end; end; {$ENDIF VCL} {$IFDEF JVCLThemesEnabled} procedure TJvCustomEdit.WMSetFont(var Msg: TWMSetFont); begin if ThemedPassword then begin // Retrieves MS Shell Dlg. // Other way is to use Screen.IconFont if FThemedFont = nil then FThemedFont := TFont.Create; FThemedFont.Handle := GetThemedFontHandle; Msg.Font := FThemedFont.Handle; end; inherited; end; {$ENDIF JVCLThemesEnabled} procedure TJvCustomEdit.SetDataConnector(const Value: TJvFieldDataConnector); begin FDataConnector.Assign(Value); end; {$IFDEF UNITVERSIONING} initialization RegisterUnitVersion(HInstance, UnitVersioning); finalization UnregisterUnitVersion(HInstance); {$ENDIF UNITVERSIONING} end.