mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-05 03:48:07 +02:00
1316 lines
40 KiB
ObjectPascal
1316 lines
40 KiB
ObjectPascal
{
|
|
***************************************************************************
|
|
groupededit.pas
|
|
---------------
|
|
|
|
Provied a base class where a TCustomMaskedit (derived) control is
|
|
grouped inside a TCustomControl with a TControl derived class.
|
|
|
|
The objective of this baseclass is to forward all relevant methods and
|
|
properties of TCustomMaskEdit.
|
|
Grouping the controls inside a TCustomControl is done, so that the
|
|
resulting control will properly align and anchor.
|
|
|
|
Initial implementation 2016 by Bart Broersma
|
|
|
|
|
|
Component Library Extended dialogs Controls
|
|
|
|
|
|
***************************************************************************
|
|
|
|
*****************************************************************************
|
|
* *
|
|
* This file is part of the Lazarus Component Library (LCL) *
|
|
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
|
|
* for details about the copyright. *
|
|
* *
|
|
* This program is distributed in the hope that it will be useful, *
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
|
* *
|
|
*****************************************************************************
|
|
|
|
|
|
}
|
|
unit GroupedEdit;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
//{$I lcl_defines.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, Types,
|
|
LResources, LCLStrConsts, LCLType, LMessages, Graphics, Controls, Forms,
|
|
Dialogs, StdCtrls, Buttons, Menus, MaskEdit;
|
|
|
|
type
|
|
|
|
{ TGEEdit }
|
|
|
|
TGEEdit = class(TCustomMaskedit)
|
|
public
|
|
function PerformTab(ForwardTab: boolean): boolean; override;
|
|
end;
|
|
|
|
TGEEditClass = class of TGEEdit;
|
|
|
|
{ TCustomAbstractGroupedEdit }
|
|
|
|
TCustomAbstractGroupedEdit = class(TCustomControl)
|
|
private
|
|
FAutoSizeHeightIsEditHeight: Boolean;
|
|
FBuddy: TControl;
|
|
FDirectInput: Boolean;
|
|
FEdit: TGEEdit;
|
|
FFocusOnBuddyClick: Boolean;
|
|
FInitialColor: TColor;
|
|
FIsReadOnly: Boolean;
|
|
FLayout: TLeftRight;
|
|
FSpacing: Integer;
|
|
//Forwarded events from FBuddy
|
|
FOnBuddyClick: TNotifyEvent;
|
|
//Forwarded events from FEdit
|
|
FOnEditClick: TNotifyEvent;
|
|
FOnEditChange: TNotifyEvent;
|
|
FOnEditContextPopup:TContextPopupEvent;
|
|
FOnEditDblClick: TNotifyEvent;
|
|
FOnEditDragDrop: TDragDropEvent;
|
|
FOnEditDragOver: TDragOverEvent;
|
|
FOnEditEditingDone: TNotifyEvent;
|
|
FOnEditEndDrag: TEndDragEvent;
|
|
FOnEditExit: TNotifyEvent;
|
|
FOnEditKeyDown: TKeyEvent;
|
|
FOnEditKeyPress: TKeyPressEvent;
|
|
FOnEditEnter: TNotifyEvent;
|
|
FOnEditKeyUp: TKeyEvent;
|
|
FOnEditMouseDown: TMouseEvent;
|
|
FOnEditMouseUp: TMouseEvent;
|
|
FOnEditMouseEnter: TNotifyEvent;
|
|
FOnEditMouseLeave: TNotifyEvent;
|
|
FOnEditMouseMove: TMouseMoveEvent;
|
|
FOnEditMouseWheel: TMouseWheelEvent;
|
|
FOnEditMouseWheelUp: TMouseWheelUpDownEvent;
|
|
FOnEditMouseWheelDown: TMouseWheelUpDownEvent;
|
|
FOnEditStartDrag: TStartDragEvent;
|
|
FOnEditUtf8KeyPress: TUtf8KeyPressEvent;
|
|
|
|
function GetAlignment: TAlignment;
|
|
function GetAutoSelect: Boolean;
|
|
function GetAutoSelected: Boolean;
|
|
function GetCanUndo: Boolean;
|
|
function GetCaretPos: TPoint;
|
|
function GetCharCase: TEditCharCase;
|
|
function GetColor: TColor;
|
|
function GetDirectInput: Boolean;
|
|
function GetEchoMode: TEchoMode;
|
|
function GetEditMask: String;
|
|
function GetEditText: string;
|
|
function GetHideSelection: Boolean;
|
|
function GetIsMasked: Boolean;
|
|
function GetMaxLength: Integer;
|
|
function GetModified: Boolean;
|
|
function GetNumbersOnly: Boolean;
|
|
function GetParentColor: Boolean;
|
|
function GetPasswordChar: char;
|
|
function GetReadOnly: Boolean;
|
|
function GetSelLength: Integer;
|
|
function GetSelStart: Integer;
|
|
function GetSelText: String;
|
|
function GetTabStop: Boolean;
|
|
function GetTextHint: TTranslateString;
|
|
|
|
procedure InternalOnBuddyClick(Sender: TObject);
|
|
procedure InternalOnEditClick(Sender: TObject);
|
|
procedure InternalOnEditDblClick(Sender: TObject);
|
|
procedure InternalOnEditChange(Sender: TObject);
|
|
procedure InternalOnEditContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
|
|
procedure InternalOnEditDragDrop(Sender, Source: TObject; X,Y: Integer);
|
|
procedure InternalOnEditDragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean);
|
|
procedure InternalOnEditEditingDone(Sender: TObject);
|
|
procedure InternalOnEditEnter(Sender: TObject);
|
|
procedure InternalOnEditExit(Sender: TObject);
|
|
procedure InternalOnEditEndDrag(Sender, Target: TObject; X,Y: Integer);
|
|
procedure InternalOnEditKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
|
|
procedure InternalOnEditKeyPress(Sender: TObject; var Key: char);
|
|
procedure InternalOnEditKeyUp(Sender: TObject; var Key: word; Shift: TShiftState);
|
|
procedure InternalOnEditMouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
procedure InternalOnEditMouseUp(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
procedure InternalOnEditMouseEnter(Sender: TObject);
|
|
procedure InternalOnEditMouseLeave(Sender: TObject);
|
|
procedure InternalOnEditMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
|
|
procedure InternalOnEditMouseWheel(Sender: TObject; Shift: TShiftState;
|
|
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
|
|
procedure InternalOnEditMouseWheelUp(Sender: TObject;
|
|
Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
|
|
procedure InternalOnEditMouseWheelDown(Sender: TObject;
|
|
Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
|
|
procedure InternalOnEditUtf8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
|
|
procedure InternalOnEditStartDrag(Sender: TObject; var DragObject: TDragObject);
|
|
|
|
procedure SetAlignment(AValue: TAlignment);
|
|
procedure SetAutoSelect(AValue: Boolean);
|
|
procedure SetAutoSelected(AValue: Boolean);
|
|
procedure SetCaretPos(AValue: TPoint);
|
|
procedure SetCharCase(AValue: TEditCharCase);
|
|
procedure SetEchoMode(AValue: TEchoMode);
|
|
procedure SetEditMask(AValue: String);
|
|
procedure SetEditText(AValue: string);
|
|
procedure SetHideSelection(AValue: Boolean);
|
|
procedure SetLayout(AValue: TLeftRight);
|
|
procedure SetMaxLength(AValue: Integer);
|
|
procedure SetModified(AValue: Boolean);
|
|
procedure SetNumbersOnly(AValue: Boolean);
|
|
procedure SetParentColor(AValue: Boolean);
|
|
procedure SetPasswordChar(AValue: char);
|
|
procedure SetPopupMenu(AValue: TPopupMenu);
|
|
procedure SetReadOnly(AValue: Boolean);
|
|
procedure SetSelLength(AValue: Integer);
|
|
procedure SetSelStart(AValue: Integer);
|
|
procedure SetSelText(AValue: String);
|
|
procedure SetSpacing(const Value: integer);
|
|
procedure SetTabStop(AValue: Boolean);
|
|
procedure SetTextHint(AValue: TTranslateString);
|
|
protected
|
|
class procedure WSRegisterClass; override;
|
|
procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
|
|
WithThemeSpace: Boolean); override;
|
|
function CreateBuddy: TControl; virtual;
|
|
function CreateEditor: TGEEdit; virtual;
|
|
|
|
procedure FocusAndMaybeSelectAll;
|
|
function GetEditorClassType: TGEEditClass; virtual;
|
|
function GetBuddyClassType: TControlClass; virtual; abstract;
|
|
class function GetControlClassDefaultSize: TSize; override;
|
|
procedure SetDirectInput(AValue: Boolean); virtual;
|
|
function RealGetText: TCaption; override;
|
|
procedure RealSetText(const AValue: TCaption); override;
|
|
|
|
function GetEditPopupMenu: TPopupMenu;
|
|
function GetBuddyCaption: TCaption;
|
|
function GetBuddyCursor: TCursor;
|
|
function GetBuddyHint: TTranslateString;
|
|
function GetBuddyWidth: Integer;
|
|
function GetBuddyVisible: Boolean;
|
|
procedure SetBuddyCaption(AValue: TCaption);
|
|
procedure SetBuddyCursor(AValue: TCursor);
|
|
procedure SetBuddyHint(AValue: TTranslateString);
|
|
procedure SetBuddyWidth(AValue: Integer);
|
|
procedure SetBuddyVisible(AValue: Boolean);
|
|
|
|
procedure BuddyClick; virtual;
|
|
|
|
procedure DoEnter; override;
|
|
|
|
procedure EditChange; virtual;
|
|
procedure EditClick; virtual;
|
|
procedure EditContextPopup(MousePos: TPoint; var Handled: Boolean); virtual;
|
|
procedure EditDblClick; virtual;
|
|
procedure EditDragDrop(Source: TObject; X,Y: Integer); virtual;
|
|
procedure EditDragOver(Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean); virtual;
|
|
procedure EditEditingDone; virtual;
|
|
procedure EditEndDrag(Target: TObject; X,Y: Integer); virtual;
|
|
procedure EditEnter; virtual;
|
|
procedure EditExit; virtual;
|
|
procedure EditKeyDown(var Key: word; Shift: TShiftState); virtual;
|
|
procedure EditKeyPress( var Key: char); virtual;
|
|
procedure EditKeyUp(var Key: word; Shift: TShiftState); virtual;
|
|
procedure EditMouseDown(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer); virtual;
|
|
procedure EditMouseUp(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer); virtual;
|
|
procedure EditMouseEnter; virtual;
|
|
procedure EditMouseLeave; virtual;
|
|
procedure EditMouseMove(Shift: TShiftState; X, Y: Integer); virtual;
|
|
procedure EditMouseWheel(Shift: TShiftState;
|
|
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
|
|
procedure EditMouseWheelUp(Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); virtual;
|
|
procedure EditMouseWheelDown(Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); virtual;
|
|
procedure EditUtf8KeyPress(var UTF8Key: TUTF8Char); virtual;
|
|
procedure EditStartDrag(var DragObject: TDragObject); virtual;
|
|
|
|
procedure UpdateSpacing;
|
|
procedure CheckCursor;
|
|
procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED;
|
|
function EditCanModify: Boolean; virtual;
|
|
procedure GetSel(out _SelStart: Integer; out _SelStop: Integer);
|
|
function GetSpacing: Integer; virtual;
|
|
procedure SetSel(const _SelStart: Integer; _SelStop: Integer);
|
|
procedure Loaded; override;
|
|
procedure Reset; virtual;
|
|
procedure SetAutoSize(AValue: Boolean); override;
|
|
procedure SetColor(AValue: TColor); reintroduce;
|
|
procedure SetCursor(AValue: TCursor); override;
|
|
procedure ShouldAutoAdjust(var AWidth, AHeight: Boolean); override;
|
|
|
|
property AutoSelect: Boolean read GetAutoSelect write SetAutoSelect default True;
|
|
property AutoSelected: Boolean read GetAutoSelected write SetAutoSelected;
|
|
property Buddy: TControl read FBuddy;
|
|
property BuddyCaption: TCaption read GetBuddyCaption write SetBuddyCaption;
|
|
property BuddyCursor: TCursor read GetBuddyCursor write SetBuddyCursor default crDefault;
|
|
property BuddyHint: TTranslateString read GetBuddyHint write SetBuddyHint;
|
|
property BuddyWidth: Integer read GetBuddyWidth write SetBuddyWidth;
|
|
property DirectInput : Boolean read GetDirectInput write SetDirectInput default True;
|
|
property BaseEditor: TGEEdit read FEdit;
|
|
property EditMask: String read GetEditMask write SetEditMask;
|
|
property EditText: string read GetEditText write SetEditText;
|
|
property FocusOnBuddyClick: Boolean read FFocusOnBuddyClick write FFocusOnBuddyClick default False;
|
|
property IsMasked: Boolean read GetIsMasked;
|
|
property Layout: TLeftRight read FLayout write SetLayout default taLeftJustify;
|
|
property Spacing: Integer read GetSpacing write SetSpacing default 0;
|
|
|
|
//Derived classes should implement there own (readonly) Edit property, so that it will have the correct classtype
|
|
//Derived classes should implement a (readonly) property that returns the buddy with the correct classtype (e.g. TSpeedButton)
|
|
|
|
property OnBuddyClick: TNotifyEvent read FOnBuddyClick write FOnBuddyClick;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure SetFocus; override;
|
|
function Focused: Boolean; override;
|
|
procedure Clear;
|
|
procedure ClearSelection; virtual;
|
|
procedure CopyToClipboard; virtual;
|
|
procedure CutToClipboard; virtual;
|
|
procedure PasteFromClipboard; virtual;
|
|
procedure SelectAll;
|
|
procedure Undo; virtual;
|
|
procedure ValidateEdit; virtual;
|
|
|
|
property Autosize default True;
|
|
property AutoSizeHeightIsEditHeight: Boolean read FAutoSizeHeightIsEditHeight write FAutoSizeHeightIsEditHeight default True;
|
|
property Alignment: TAlignment read GetAlignment write SetAlignment default taLeftJustify;
|
|
property CanUndo: Boolean read GetCanUndo;
|
|
property CaretPos: TPoint read GetCaretPos write SetCaretPos;
|
|
property CharCase: TEditCharCase read GetCharCase write SetCharCase default ecNormal;
|
|
property Color: TColor read GetColor write SetColor stored True default {$ifdef UseCLDefault}clDefault{$else}clWindow{$endif};
|
|
property ParentColor: Boolean read GetParentColor write SetParentColor default False;
|
|
property EchoMode: TEchoMode read GetEchoMode write SetEchoMode default emNormal;
|
|
property HideSelection: Boolean read GetHideSelection write SetHideSelection default False;
|
|
property MaxLength: Integer read GetMaxLength write SetMaxLength;
|
|
property Modified: Boolean read GetModified write SetModified;
|
|
property NumbersOnly: Boolean read GetNumbersOnly write SetNumbersOnly default False;
|
|
property PasswordChar: char read GetPasswordChar write SetPasswordChar;
|
|
property PopupMenu: TPopupMenu read GetEditPopupMenu write SetPopupMenu;
|
|
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
|
|
property SelLength: Integer read GetSelLength write SetSelLength;
|
|
property SelStart: Integer read GetSelStart write SetSelStart;
|
|
property SelText: String read GetSelText write SetSelText;
|
|
property TabStop: Boolean read GetTabStop write SetTabStop default True;
|
|
property Text;
|
|
property TextHint: TTranslateString read GetTextHint write SetTextHint;
|
|
|
|
property OnChange: TNotifyEvent read FOnEditChange write FOnEditChange;
|
|
property OnClick: TNotifyEvent read FOnEditClick write FOnEditClick;
|
|
property OnContextPopup: TContextPopupEvent read FOnEditContextPopup write FOnEditContextPopup;
|
|
property OnDblClick: TNotifyEvent read FOnEditDblClick write FOnEditDblClick;
|
|
property OnDragDrop: TDragDropEvent read FOnEditDragDrop write FOnEditDragDrop;
|
|
property OnDragOver: TDragOverEvent read FOnEditDragOver write FOnEditDragOver;
|
|
property OnEditingDone: TNotifyEvent read FOnEditEditingDone write FOnEditEditingDone;
|
|
property OnEndDrag: TEndDragEvent read FOnEditEndDrag write FOnEditEndDrag;
|
|
property OnEnter: TNotifyEvent read FOnEditEnter write FOnEditEnter;
|
|
property OnExit: TNotifyEvent read FOnEditExit write FOnEditExit;
|
|
property OnMouseDown: TMouseEvent read FOnEditMouseDown write FOnEditMouseDown;
|
|
property OnKeyPress: TKeyPressEvent read FOnEditKeyPress write FOnEditKeyPress;
|
|
property OnKeyDown: TKeyEvent read FOnEditKeyDown write FOnEditKeyDown;
|
|
property OnKeyUp: TKeyEvent read FOnEditKeyUp write FOnEditKeyUp;
|
|
property OnMouseEnter: TNotifyEvent read FOnEditMouseEnter write FOnEditMouseEnter;
|
|
property OnMouseLeave: TNotifyEvent read FOnEditMouseLeave write FOnEditMouseLeave;
|
|
property OnMouseMove: TMouseMoveEvent read FOnEditMouseMove write FOnEditMouseMove;
|
|
property OnMouseWheel: TMouseWheelEvent read FOnEditMouseWheel write FOnEditMouseWheel;
|
|
property OnMouseWheelUp: TMouseWheelUpDownEvent read FOnEditMouseWheelUp write FOnEditMouseWheelUp;
|
|
property OnMouseWheelDown: TMouseWheelUpDownEvent read FOnEditMouseWheelDown write FOnEditMouseWheelDown;
|
|
property OnMouseUp: TMouseEvent read FOnEditMouseUp write FOnEditMouseUp;
|
|
property OnStartDrag: TStartDragEvent read FOnEditStartDrag write FOnEditStartDrag;
|
|
property OnUtf8KeyPress: TUtf8KeyPressEvent read FOnEditUtf8KeyPress write FOnEditUtf8KeyPress;
|
|
|
|
end;
|
|
|
|
{ TAbstractGroupedEdit }
|
|
|
|
TAbstractGroupedEdit = class(TCustomAbstractGroupedEdit)
|
|
public
|
|
property AutoSelected;
|
|
published
|
|
property NumbersOnly;
|
|
property Action;
|
|
property AutoSelect;
|
|
property AutoSizeHeightIsEditHeight;
|
|
property AutoSize default True;
|
|
property Align;
|
|
property Alignment;
|
|
property Anchors;
|
|
property BiDiMode;
|
|
property BorderSpacing;
|
|
property BorderStyle default bsNone;
|
|
property BuddyCaption;
|
|
property BuddyCursor;
|
|
property BuddyHint;
|
|
property BuddyWidth;
|
|
property CharCase;
|
|
property Color;
|
|
property Constraints;
|
|
property Cursor;
|
|
property DirectInput;
|
|
property EchoMode;
|
|
property Enabled;
|
|
property FocusOnBuddyClick;
|
|
property Font;
|
|
// property HideSelection;
|
|
property Hint;
|
|
property Layout;
|
|
property MaxLength;
|
|
property ParentBiDiMode;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PasswordChar;
|
|
property PopupMenu;
|
|
property ReadOnly;
|
|
property ShowHint;
|
|
property Spacing;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Text;
|
|
property TextHint;
|
|
property Visible;
|
|
{events }
|
|
//property OnBuddyClick;
|
|
property OnChange;
|
|
property OnClick;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnContextPopup;
|
|
property OnEditingDone;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnStartDrag;
|
|
property OnUTF8KeyPress;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
|
|
{ TGEEdit }
|
|
|
|
|
|
function TGEEdit.PerformTab(ForwardTab: boolean): boolean;
|
|
begin
|
|
//if not Forward then inherited PerFormTab will set focus to the owning
|
|
//TCustomAbstractGroupedEdit, which immediately transfers the focus back to the TGEEdit
|
|
//so let TCustomAbstractGroupedEdit do the Performtab in this case
|
|
if ForwardTab then
|
|
Result := inherited PerformTab(ForwardTab)
|
|
else
|
|
begin
|
|
if Owner is TCustomAbstractGroupedEdit then
|
|
Result := TCustomAbstractGroupedEdit(Owner).PerformTab(ForwardTab)
|
|
else
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
{ TCustomAbstractGroupedEdit }
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnBuddyClick(Sender: TObject);
|
|
begin
|
|
BuddyClick;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnEditChange(Sender: TObject);
|
|
begin
|
|
if not (csLoading in ComponentState) then
|
|
EditChange;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnEditContextPopup(
|
|
Sender: TObject; MousePos: TPoint; var Handled: Boolean);
|
|
begin
|
|
EditContextPopup(MousePos, Handled);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnEditClick(Sender: TObject);
|
|
begin
|
|
EditClick;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnEditDblClick(Sender: TObject);
|
|
begin
|
|
EditDblClick;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnEditDragDrop(Sender, Source: TObject; X, Y: Integer);
|
|
begin
|
|
EditDragDrop(Source, X, Y);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnEditDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
|
|
begin
|
|
EditDragOver(Source, X, Y, State, Accept);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnEditEditingDone(Sender: TObject);
|
|
begin
|
|
EditEditingDone;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnEditEndDrag(Sender, Target: TObject; X, Y: Integer);
|
|
begin
|
|
EditEndDrag(Target, X, Y);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnEditEnter(Sender: TObject);
|
|
begin
|
|
EditEnter;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnEditExit(Sender: TObject);
|
|
begin
|
|
EditExit;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnEditKeyDown(Sender: TObject; var Key: word;
|
|
Shift: TShiftState);
|
|
begin
|
|
EditKeyDown(Key, Shift);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnEditKeyPress(Sender: TObject; var Key: char);
|
|
begin
|
|
EditKeyPress(Key);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnEditKeyUp(Sender: TObject; var Key: word;
|
|
Shift: TShiftState);
|
|
begin
|
|
EditKeyUp(Key, Shift);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnEditMouseDown(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
EditMouseDown(Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnEditMouseUp(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
EditMouseUp(Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnEditMouseEnter(Sender: TObject);
|
|
begin
|
|
EditMouseEnter;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnEditMouseLeave(Sender: TObject);
|
|
begin
|
|
EditMouseLeave;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnEditMouseMove(Sender: TObject;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
EditMouseMove(Shift, X, Y);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnEditMouseWheel(Sender: TObject;
|
|
Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
|
|
var Handled: Boolean);
|
|
begin
|
|
EditMouseWheel(Shift, WheelDelta, MousePos, Handled);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnEditMouseWheelUp(Sender: TObject;
|
|
Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
|
|
begin
|
|
EditMouseWheelUp(Shift, MousePos, Handled);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnEditMouseWheelDown(Sender: TObject;
|
|
Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
|
|
begin
|
|
EditMouseWheelDown(Shift, MousePos, Handled);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnEditUtf8KeyPress(Sender: TObject;
|
|
var UTF8Key: TUTF8Char);
|
|
begin
|
|
EditUtf8KeyPress(UTF8Key);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.InternalOnEditStartDrag(Sender: TObject; var DragObject: TDragObject);
|
|
begin
|
|
EditStartDrag(DragObject);
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetCanUndo: Boolean;
|
|
begin
|
|
Result := FEdit.CanUndo;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetCaretPos: TPoint;
|
|
begin
|
|
Result := FEdit.CaretPos;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetEditPopupMenu: TPopupMenu;
|
|
begin
|
|
Result := FEdit.PopupMenu;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.CalculatePreferredSize(var PreferredWidth,
|
|
PreferredHeight: integer; WithThemeSpace: Boolean);
|
|
var
|
|
EditPreferredHeight: integer;
|
|
begin
|
|
EditPreferredHeight := 0;
|
|
inherited CalculatePreferredSize(PreferredWidth, PreferredHeight, WithThemeSpace);
|
|
FEdit.CalculatePreferredSize(PreferredWidth, EditPreferredHeight, WithThemeSpace);
|
|
|
|
if FAutoSizeHeightIsEditHeight then
|
|
PreferredHeight := EditPreferredHeight;
|
|
PreferredWidth := 0;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetReadOnly: Boolean;
|
|
begin
|
|
Result := FIsReadOnly;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetSelLength: Integer;
|
|
begin
|
|
Result := FEdit.SelLength;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetSelStart: Integer;
|
|
begin
|
|
Result := FEdit.SelStart;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetSelText: String;
|
|
begin
|
|
Result := FEdit.SelText;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetSpacing: Integer;
|
|
begin
|
|
Result := FSpacing;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetTabStop: Boolean;
|
|
begin
|
|
Result := FEdit.TabStop;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.RealGetText: TCaption;
|
|
begin
|
|
Result := FEdit.Text;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetTextHint: TTranslateString;
|
|
begin
|
|
Result := FEdit.TextHint;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.FocusAndMaybeSelectAll;
|
|
begin
|
|
FEdit.SetFocus;
|
|
if AutoSelect then
|
|
FEdit.SelectAll
|
|
else
|
|
FEdit.SelStart := MaxInt;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetAlignment: TAlignment;
|
|
begin
|
|
Result := FEdit.Alignment;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetAutoSelect: Boolean;
|
|
begin
|
|
Result := FEdit.AutoSelect;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetAutoSelected: Boolean;
|
|
begin
|
|
Result := FEdit.AutoSelected;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetBuddyCaption: TCaption;
|
|
begin
|
|
Result := FBuddy.Caption;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetBuddyCursor: TCursor;
|
|
begin
|
|
Result := FBuddy.Cursor;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetBuddyHint: TTranslateString;
|
|
begin
|
|
Result := FBuddy.Hint;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetBuddyWidth: Integer;
|
|
begin
|
|
Result := FBuddy.Width;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetBuddyVisible: Boolean;
|
|
begin
|
|
Result := FBuddy.Visible;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetBuddyHint(AValue: TTranslateString);
|
|
begin
|
|
FBuddy.Hint := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetBuddyWidth(AValue: Integer);
|
|
begin
|
|
FBuddy.Width := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetBuddyVisible(AValue: Boolean);
|
|
begin
|
|
FBuddy.Visible := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetCaretPos(AValue: TPoint);
|
|
begin
|
|
FEdit.CaretPos := AValue;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetCharCase: TEditCharCase;
|
|
begin
|
|
Result := FEdit.CharCase;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetDirectInput: Boolean;
|
|
begin
|
|
Result := FDirectInput;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetEchoMode: TEchoMode;
|
|
begin
|
|
Result := FEdit.EchoMode;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetEditMask: String;
|
|
begin
|
|
Result := FEdit.EditMask
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetEditText: string;
|
|
begin
|
|
Result := FEdit.EditText;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetColor: TColor;
|
|
begin
|
|
Result := FEdit.Color;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetHideSelection: Boolean;
|
|
begin
|
|
Result := FEdit.HideSelection;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetIsMasked: Boolean;
|
|
begin
|
|
Result := FEdit.IsMasked;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetMaxLength: Integer;
|
|
begin
|
|
Result := FEdit.MaxLength;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetModified: Boolean;
|
|
begin
|
|
Result := FEdit.Modified;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetNumbersOnly: Boolean;
|
|
begin
|
|
Result := FEdit.NumbersOnly;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetParentColor: Boolean;
|
|
begin
|
|
Result := FEdit.ParentColor;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetPasswordChar: char;
|
|
begin
|
|
Result := FEdit.PasswordChar;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetAlignment(AValue: TAlignment);
|
|
begin
|
|
FEdit.Alignment := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetAutoSelect(AValue: Boolean);
|
|
begin
|
|
FEdit.AutoSelect := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetAutoSelected(AValue: Boolean);
|
|
begin
|
|
FEdit.AutoSelected := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetAutoSize(AValue: Boolean);
|
|
begin
|
|
if AutoSize = AValue then
|
|
Exit;
|
|
inherited SetAutosize(AValue);
|
|
//FButton.AutoSize := AValue;
|
|
FEdit.AutoSize := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetBuddyCaption(AValue: TCaption);
|
|
begin
|
|
FBuddy.Caption := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetBuddyCursor(AValue: TCursor);
|
|
begin
|
|
FBuddy.Cursor := AValue;
|
|
end;
|
|
|
|
class function TCustomAbstractGroupedEdit.GetControlClassDefaultSize: TSize;
|
|
begin
|
|
Result.CX := 80 + 23; //as TCustomEdit + TCustomSpeedButton
|
|
Result.CY := 23; //as TCustomEdit
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetCharCase(AValue: TEditCharCase);
|
|
begin
|
|
FEdit.CharCase := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetDirectInput(AValue: Boolean);
|
|
begin
|
|
FDirectInput := AValue;
|
|
FEdit.ReadOnly := ((not FDirectInput) or (FIsReadOnly));
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetEchoMode(AValue: TEchoMode);
|
|
begin
|
|
FEdit.EchoMode := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetEditMask(AValue: String);
|
|
begin
|
|
FEdit.EditMask := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetEditText(AValue: string);
|
|
begin
|
|
FEdit.EditText := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetColor(AValue: TColor);
|
|
begin
|
|
if (csLoading in ComponentState) then
|
|
FInitialColor := AValue
|
|
else
|
|
FEdit.Color := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetCursor(AValue: TCursor);
|
|
begin
|
|
if Cursor = AValue then
|
|
Exit;
|
|
inherited SetCursor(AValue);
|
|
FEdit.Cursor := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.ShouldAutoAdjust(var AWidth,
|
|
AHeight: Boolean);
|
|
begin
|
|
AWidth := True;
|
|
AHeight := not AutoSize;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetFocus;
|
|
begin
|
|
FEdit.SetFocus;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetHideSelection(AValue: Boolean);
|
|
begin
|
|
FEdit.HideSelection := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetLayout(AValue: TLeftRight);
|
|
begin
|
|
if (FLayout = AValue) then
|
|
Exit;
|
|
FLayout := AValue;
|
|
DisableAlign;
|
|
UpdateSpacing;
|
|
case FLayout of
|
|
taLeftJustify : FBuddy.Align := alRight;
|
|
taRightJustify: FBuddy.Align := alLeft;
|
|
end;
|
|
EnableAlign;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetMaxLength(AValue: Integer);
|
|
begin
|
|
FEdit.MaxLength := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetModified(AValue: Boolean);
|
|
begin
|
|
FEdit.Modified := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetNumbersOnly(AValue: Boolean);
|
|
begin
|
|
FEdit.NumbersOnly := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetParentColor(AValue: Boolean);
|
|
begin
|
|
FEdit.ParentColor := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetPasswordChar(AValue: char);
|
|
begin
|
|
FEdit.PasswordChar := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetPopupMenu(AValue: TPopupMenu);
|
|
var
|
|
OldPopupMenu: TPopupMenu;
|
|
begin
|
|
OldPopupMenu := FEdit.PopupMenu;
|
|
FEdit.PopupMenu := AValue;
|
|
//users can assign a different popupmenu to the buddy if so desired, if that is the case, don't touch it
|
|
if (FBuddy.PopupMenu = OldPopupMenu) then
|
|
FBuddy.PopupMenu := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.RealSetText(const AValue: TCaption);
|
|
begin
|
|
FEdit.Text := AValue;
|
|
end;
|
|
|
|
|
|
procedure TCustomAbstractGroupedEdit.BuddyClick;
|
|
begin
|
|
//debugln(['TCustomAbstractGroupedEdit.BuddyClick: Assigned(FOnBuddyClick)=',Assigned(FOnBuddyClick)]);
|
|
if ReadOnly then
|
|
Exit;
|
|
if Assigned(FOnBuddyClick) then
|
|
FOnBuddyClick(Self);
|
|
//derived controls that override BuddyClick typically run a dialog after calling inherited,
|
|
//in that case selecting the text now does not make sense at all (and looks silly)
|
|
//it's up to the derived control to implement this focus and select if wanted
|
|
if TMethod(@Self.BuddyClick).Code = Pointer(@TCustomAbstractGroupedEdit.BuddyClick) then
|
|
begin
|
|
if FocusOnBuddyClick then FocusAndMaybeSelectAll;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.DoEnter;
|
|
begin
|
|
inherited DoEnter;
|
|
if not (csDesigning in ComponentState) then
|
|
FEdit.SetFocus;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.EditChange;
|
|
begin
|
|
if Assigned(FOnEditChange) then FOnEditChange(Self);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.EditClick;
|
|
begin
|
|
if Assigned(FOnEditClick) then FOnEditClick(Self);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.EditContextPopup(MousePos: TPoint; var Handled: Boolean);
|
|
begin
|
|
if Assigned(FOnEditContextPopup) then FOnEditContextPopup(Self, MousePos, Handled);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.EditDblClick;
|
|
begin
|
|
if Assigned(FOnEditDblClick) then FOnEditDblClick(Self);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.EditDragDrop(Source: TObject; X, Y: Integer);
|
|
begin
|
|
if Assigned(FOnEditDragDrop) then FOnEditDragDrop(Self, Source, X, Y);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.EditDragOver(Source: TObject; X, Y: Integer;
|
|
State: TDragState; var Accept: Boolean);
|
|
begin
|
|
Accept:=Assigned(FOnEditDragOver);
|
|
if Accept then
|
|
FOnEditDragOver(Self, Source, X, Y, State, Accept);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.EditEditingDone;
|
|
begin
|
|
if Assigned(FOnEditEditingDone) then FOnEditEditingDone(Self);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.EditEndDrag(Target: TObject; X, Y: Integer);
|
|
begin
|
|
if Assigned(FOnEditEndDrag) then FOnEditEndDrag(Self, Target, X, Y);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.EditEnter;
|
|
begin
|
|
if Assigned(FOnEditEnter) then FOnEditEnter(Self);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.EditExit;
|
|
begin
|
|
if Assigned(FOnEditExit) then FOnEditExit(Self);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.EditKeyDown(var Key: word; Shift: TShiftState);
|
|
begin
|
|
if Assigned(FOnEditKeyDown) then FOnEditKeyDown(Self, Key, Shift);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.EditKeyPress(var Key: char);
|
|
begin
|
|
if Assigned(FOnEditKeyPress) then FOnEditKeyPress(Self, Key);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.EditKeyUp(var Key: word; Shift: TShiftState);
|
|
begin
|
|
if Assigned(FOnEditKeyUp) then FOnEditKeyUp(Self, Key, Shift);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.EditMouseDown(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
if Assigned(FOnEditMouseDown) then FOnEditMouseDown(Self, Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.EditMouseUp(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
if Assigned(FOnEditMouseUp) then FOnEditMouseUp(Self, Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.EditMouseEnter;
|
|
begin
|
|
if Assigned(FOnEditMouseEnter) then FOnEditMouseEnter(Self);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.EditMouseLeave;
|
|
begin
|
|
if Assigned(FOnEditMouseLeave) then FOnEditMouseLeave(Self);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.EditMouseMove(Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
if Assigned(FOnEditMouseMove) then FOnEditMouseMove(Self, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.EditMouseWheel(Shift: TShiftState;
|
|
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
|
|
begin
|
|
if Assigned(FOnEditMouseWheel) then FOnEditMouseWheel(Self, Shift, WheelDelta, MousePos, Handled);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.EditMouseWheelUp(Shift: TShiftState;
|
|
MousePos: TPoint; var Handled: Boolean);
|
|
begin
|
|
if Assigned(FOnEditMouseWheelUp) then FOnEditMouseWheelUp(Self, Shift, MousePos, Handled);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.EditMouseWheelDown(Shift: TShiftState;
|
|
MousePos: TPoint; var Handled: Boolean);
|
|
begin
|
|
if Assigned(FOnEditMouseWheelDown) then FOnEditMouseWheelDown(Self, Shift, MousePos, Handled);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.EditUtf8KeyPress(var UTF8Key: TUTF8Char);
|
|
begin
|
|
if Assigned(FOnEditUtf8KeyPress) then FOnEditUtf8KeyPress(Self, Utf8Key);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.EditStartDrag(var DragObject: TDragObject);
|
|
begin
|
|
if Assigned(FOnEditStartDrag) then FOnEditStartDrag(Self, DragObject);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.CheckCursor;
|
|
begin
|
|
FEdit.CheckCursor;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.CMParentColorChanged(var Message: TLMessage);
|
|
begin
|
|
if inherited ParentColor then
|
|
begin
|
|
inherited SetColor(Parent.Color);
|
|
inherited ParentColor := True;
|
|
end;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.EditCanModify: Boolean;
|
|
begin
|
|
Result := FEdit.EditCanModify;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.GetSel(out _SelStart: Integer; out _SelStop: Integer);
|
|
begin
|
|
FEdit.GetSel(_SelStart, _SelStop);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetSel(const _SelStart: Integer; _SelStop: Integer);
|
|
begin
|
|
FEdit.SetSel(_SelStart, _SelStop);
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
{
|
|
inherited Loaded sends a CM_PARENTFONTCHANGED message, which then
|
|
also sets FEdit's color, which is undesired.
|
|
}
|
|
UpdateSpacing;
|
|
if GetColor <> FInitialColor then SetColor(FInitialColor);
|
|
end;
|
|
|
|
|
|
procedure TCustomAbstractGroupedEdit.Reset;
|
|
begin
|
|
FEdit.Reset;
|
|
end;
|
|
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetReadOnly(AValue: Boolean);
|
|
begin
|
|
FIsReadOnly := AValue;
|
|
FEdit.ReadOnly := AValue or (not DirectInput);
|
|
FBuddy.Enabled := not FIsReadOnly and Enabled;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetSelLength(AValue: Integer);
|
|
begin
|
|
FEdit.SelLength := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetSelStart(AValue: Integer);
|
|
begin
|
|
FEdit.SelStart := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetSelText(AValue: String);
|
|
begin
|
|
FEdit.SelText := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetSpacing(const Value: integer);
|
|
begin
|
|
if (Value = FSpacing) then Exit;
|
|
FSpacing := Value;
|
|
if not (csLoading in ComponentState) then UpdateSpacing;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetTabStop(AValue: Boolean);
|
|
begin
|
|
FEdit.TabStop := AValue;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SetTextHint(AValue: TTranslateString);
|
|
begin
|
|
FEdit.TextHint := AValue;
|
|
end;
|
|
|
|
class procedure TCustomAbstractGroupedEdit.WSRegisterClass;
|
|
begin
|
|
inherited WSRegisterClass;
|
|
RegisterPropertyToSkip(TCustomAbstractGroupedEdit, 'TextHintFontColor','Used in a previous version of Lazarus','');
|
|
RegisterPropertyToSkip(TCustomAbstractGroupedEdit, 'TextHintFontStyle','Used in a previous version of Lazarus','');
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.UpdateSpacing;
|
|
begin
|
|
if (FBuddy=nil) or not FBuddy.Visible then
|
|
begin
|
|
FEdit.BorderSpacing.Right := 0;
|
|
FEdit.BorderSpacing.Left := 0;
|
|
end
|
|
else
|
|
if (FLayout = taLeftJustify) then
|
|
begin
|
|
FEdit.BorderSpacing.Right := FSpacing;
|
|
FEdit.BorderSpacing.Left := 0;
|
|
end
|
|
else
|
|
begin
|
|
FEdit.BorderSpacing.Right := 0;
|
|
FEdit.BorderSpacing.Left := FSpacing;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TCustomAbstractGroupedEdit.CreateBuddy: TControl;
|
|
begin
|
|
Result := GetBuddyClassType.Create(Self);
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.CreateEditor: TGEEdit;
|
|
begin
|
|
Result := GetEditorClassType.Create(Self);
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.GetEditorClassType: TGEEditClass;
|
|
begin
|
|
Result := TGEEdit;
|
|
end;
|
|
|
|
constructor TCustomAbstractGroupedEdit.Create(AOwner: TComponent);
|
|
var
|
|
B: TBitmap;
|
|
begin
|
|
AutoSizeHeightIsEditHeight := True;
|
|
FEdit := CreateEditor;
|
|
FBuddy := CreateBuddy;
|
|
inherited Create(AOwner);
|
|
ControlStyle := ControlStyle + [csNoFocus];
|
|
FEdit.ParentColor := False;
|
|
FInitialColor := {$ifdef UseCLDefault}clDefault{$else}clWindow{$endif};
|
|
BorderStyle := bsNone;
|
|
FLayout := taLeftjustify;
|
|
FDirectInput := True;
|
|
FIsReadOnly := False;
|
|
TabStop := True;
|
|
inherited TabStop := False;
|
|
FocusOnBuddyClick := False;
|
|
FSpacing := 0;
|
|
SetInitialBounds(0, 0, GetControlClassDefaultSize.CX, GetControlClassDefaultSize.CY);
|
|
|
|
FBuddy.Align := alRight;
|
|
FBuddy.OnClick := @InternalOnBuddyClick;
|
|
FBuddy.Parent := Self;
|
|
|
|
with FEdit do
|
|
begin
|
|
Align := alClient;
|
|
ParentColor := False;
|
|
ParentFont := True;
|
|
|
|
AutoSelect := True;
|
|
Alignment := taLeftJustify;
|
|
ReadOnly := False;
|
|
|
|
OnChange := @InternalOnEditChange;
|
|
OnClick := @InternalOnEditClick;
|
|
OnContextPopup := @InternalOnEditContextPopup;
|
|
OnDblClick := @InternalOnEditDblClick;
|
|
OnDragDrop := @InternalOnEditDragDrop;
|
|
OnDragOver := @InternalOnEditDragOver;
|
|
OnEditingDone := @InternalOnEditEditingDone;
|
|
OnEndDrag := @InternalOnEditEndDrag;
|
|
OnExit := @InternalOnEditExit;
|
|
OnEnter := @InternalOnEditEnter;
|
|
OnKeyDown := @InternalOnEditKeyDown;
|
|
OnKeyPress := @InternalOnEditKeyPress;
|
|
OnKeyUp := @InternalOnEditKeyUp;
|
|
OnMouseDown := @InternalOnEditMouseDown;
|
|
OnMouseUp := @InternalOnEditMouseUp;
|
|
OnMouseEnter := @InternalOnEditMouseEnter;
|
|
OnMouseLeave := @InternalOnEditMouseLeave;
|
|
OnMouseMove := @InternalOnEditMouseMove;
|
|
OnMouseWheel := @InternalOnEditMouseWheel;
|
|
OnMouseWheelUp := @InternalOnEditMouseWheelUp;
|
|
OnMouseWheelDown := @InternalOnEditMouseWheelDown;
|
|
OnStartDrag := @InternalOnEditStartDrag;
|
|
OnUtf8KeyPress := @InternalOnEditUtf8KeyPress;
|
|
end;
|
|
FEdit.Parent := Self;
|
|
AutoSize := True;
|
|
Color := {$ifdef UseCLDefault}clDefault{$else}clWindow{$endif};
|
|
inherited ParentColor := True; //don't want to see the container if Parent's color changes
|
|
end;
|
|
|
|
destructor TCustomAbstractGroupedEdit.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TCustomAbstractGroupedEdit.Focused: Boolean;
|
|
begin
|
|
Result := FEdit.Focused;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.Clear;
|
|
begin
|
|
FEdit.Clear;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.ClearSelection;
|
|
begin
|
|
FEdit.ClearSelection;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.CopyToClipboard;
|
|
begin
|
|
FEdit.CopyToClipboard;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.CutToClipboard;
|
|
begin
|
|
FEdit.CutToClipBoard;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.PasteFromClipboard;
|
|
begin
|
|
FEdit.PasteFromClipBoard;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.SelectAll;
|
|
begin
|
|
FEdit.SelectAll;
|
|
end;
|
|
|
|
|
|
procedure TCustomAbstractGroupedEdit.Undo;
|
|
begin
|
|
FEdit.Undo;
|
|
end;
|
|
|
|
procedure TCustomAbstractGroupedEdit.ValidateEdit;
|
|
begin
|
|
FEdit.ValidateEdit;
|
|
end;
|
|
|
|
end.
|