mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-04 07:59:43 +01:00
1207 lines
30 KiB
ObjectPascal
1207 lines
30 KiB
ObjectPascal
{
|
|
/***************************************************************************
|
|
editbtn.pas
|
|
-----------
|
|
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 EditBtn;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, LCLProc, LResources, LCLStrConsts, LCLType, LMessages,
|
|
Graphics, Controls, Forms, FileUtil, Dialogs, StdCtrls, Buttons, Calendar,
|
|
ExtDlgs, CalendarPopup, MaskEdit;
|
|
|
|
const
|
|
NullDate: TDateTime = 0;
|
|
|
|
type
|
|
{ TCustomEditButton }
|
|
|
|
TCustomEditButton = class(TCustomMaskEdit)
|
|
private
|
|
FButton: TSpeedButton;
|
|
FButtonNeedsFocus: Boolean;
|
|
FDirectInput: Boolean;
|
|
FIsReadOnly: boolean;
|
|
FOnButtonClick : TNotifyEvent;
|
|
function GetButtonHint: TTranslateString;
|
|
function GetButtonWidth: Integer;
|
|
function GetDirectInput: Boolean;
|
|
function GetFlat: Boolean;
|
|
procedure CheckButtonVisible;
|
|
procedure SetButtonHint(const AValue: TTranslateString);
|
|
procedure SetButtonNeedsFocus(const AValue: Boolean);
|
|
procedure SetButtonWidth(const AValue: Integer);
|
|
procedure SetDirectInput(const AValue: Boolean);
|
|
procedure SetFlat(const AValue: Boolean);
|
|
procedure SetGlyph(Pic: TBitmap);
|
|
function GetGlyph : TBitmap;
|
|
procedure SetNumGlyphs(ANumber: Integer);
|
|
function GetNumGlyphs:Integer;
|
|
function GetMinHeight: Integer;
|
|
procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
|
|
procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
|
|
protected
|
|
function GetReadOnly: Boolean; override;
|
|
function GetDefaultGlyph: TBitmap; virtual;
|
|
function GetDefaultGlyphName: String; virtual;
|
|
procedure SetParent(AParent: TWinControl); override;
|
|
procedure SetReadOnly(AValue: Boolean); override;
|
|
procedure DoPositionButton; virtual;
|
|
procedure DoButtonClick (Sender: TObject); virtual;
|
|
procedure Loaded; override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure CMVisibleChanged(var Msg: TLMessage); message CM_VISIBLECHANGED;
|
|
procedure CMEnabledChanged(var Msg: TLMessage); message CM_ENABLEDCHANGED;
|
|
// New properties.
|
|
property ButtonWidth : Integer read GetButtonWidth write SetButtonWidth;
|
|
property DirectInput : Boolean read GetDirectInput write SetDirectInput default True;
|
|
property Glyph : TBitmap read GetGlyph write SetGlyph;
|
|
property NumGlyphs : Integer read GetNumGlyphs write SetNumGlyphs;
|
|
property OnButtonClick : TNotifyEvent read FOnButtonClick write FOnButtonClick;
|
|
property Button: TSpeedButton read FButton;
|
|
property ButtonHint: TTranslateString read GetButtonHint write SetButtonHint;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
property Flat: Boolean read GetFlat write SetFlat default False;
|
|
property ButtonOnlyWhenFocused: Boolean read FButtonNeedsFocus write SetButtonNeedsFocus default False;
|
|
end;
|
|
|
|
|
|
{ TEditButton }
|
|
|
|
TEditButton = class(TCustomEditButton)
|
|
Public
|
|
property Button;
|
|
published
|
|
property AutoSize;
|
|
property AutoSelect;
|
|
property Align;
|
|
property Anchors;
|
|
property BorderSpacing;
|
|
property BorderStyle;
|
|
property ButtonOnlyWhenFocused;
|
|
property ButtonWidth;
|
|
property ButtonHint;
|
|
property CharCase;
|
|
property Color;
|
|
property DirectInput;
|
|
property DragCursor;
|
|
property DragMode;
|
|
property EchoMode;
|
|
property Enabled;
|
|
property Flat;
|
|
property Font;
|
|
property Glyph;
|
|
property MaxLength;
|
|
property NumGlyphs;
|
|
property OnButtonClick;
|
|
property OnChange;
|
|
property OnClick;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEditingDone;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnStartDrag;
|
|
property OnUTF8KeyPress;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PasswordChar;
|
|
property PopupMenu;
|
|
property ReadOnly;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Text;
|
|
property Visible;
|
|
end;
|
|
|
|
|
|
{ TFileNameEdit }
|
|
|
|
TAcceptFileNameEvent = procedure (Sender : TObject; Var Value : String) of Object;
|
|
TDialogKind = (dkOpen,dkSave,dkPictureOpen,dkPictureSave);
|
|
|
|
TFileNameEdit = class(TCustomEditButton)
|
|
private
|
|
FDialogOptions: TOpenOptions;
|
|
FFileName : String;
|
|
FDialogFiles : TStrings;
|
|
FDialogKind: TDialogKind;
|
|
FDialogTitle: String;
|
|
FFilter: String;
|
|
FFilterIndex: Integer;
|
|
FHideDirectories: Boolean;
|
|
FInitialDir: String;
|
|
FOnAcceptFN: TAcceptFileNameEvent;
|
|
FFileNameChangeLock: Integer;
|
|
procedure SetFileName(const AValue: String);
|
|
protected
|
|
function GetDefaultGlyph: TBitmap; override;
|
|
function GetDefaultGlyphName: String; override;
|
|
function CreateDialog(AKind : TDialogKind) : TCommonDialog; virtual;
|
|
procedure SaveDialogResult(AKind : TDialogKind; D : TCommonDialog); virtual;
|
|
procedure DoButtonClick (Sender: TObject); override;
|
|
procedure RunDialog; virtual;
|
|
procedure TextChanged; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
property DialogFiles: TStrings read FDialogFiles;
|
|
published
|
|
// TFileName properties.
|
|
property FileName: String read FFileName write SetFileName;
|
|
property InitialDir: String read FInitialDir write FInitialDir;
|
|
property OnAcceptFileName: TAcceptFileNameEvent read FOnAcceptFN write FonAcceptFN;
|
|
property DialogKind: TDialogKind read FDialogKind write FDialogKind default dkOpen;
|
|
property DialogTitle: String read FDialogTitle write FDialogTitle;
|
|
property DialogOptions: TOpenOptions read FDialogOptions write FDialogOptions;
|
|
property Filter: String read FFilter write FFilter;
|
|
property FilterIndex: Integer read FFilterIndex write FFIlterIndex;
|
|
property HideDirectories: Boolean read FHideDirectories write FHideDirectories;
|
|
// TEditButton properties.
|
|
property ButtonWidth;
|
|
property DirectInput;
|
|
property ButtonOnlyWhenFocused;
|
|
// property Glyph;
|
|
property NumGlyphs;
|
|
property Flat;
|
|
// Other properties
|
|
property Align;
|
|
property Alignment;
|
|
property Anchors;
|
|
property AutoSelect;
|
|
property BorderSpacing;
|
|
property BorderStyle;
|
|
property AutoSize;
|
|
property Color;
|
|
property DragCursor;
|
|
property DragMode;
|
|
property Enabled;
|
|
property Font;
|
|
property MaxLength;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ReadOnly;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Visible;
|
|
property OnChange;
|
|
property OnClick;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEditingDone;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnStartDrag;
|
|
property OnUTF8KeyPress;
|
|
end;
|
|
|
|
|
|
{ TDirectoryEdit }
|
|
|
|
TDirectoryEdit = class(TCustomEditButton)
|
|
private
|
|
FDialogTitle: String;
|
|
FRootDir: String;
|
|
FOnAcceptDir: TAcceptFileNameEvent;
|
|
FShowHidden: Boolean;
|
|
function GetDirectory: String;
|
|
procedure SetDirectory(const AValue: String);
|
|
protected
|
|
function GetDefaultGlyph: TBitmap; override;
|
|
function GetDefaultGlyphName: String; override;
|
|
function CreateDialog: TCommonDialog; virtual;
|
|
function GetDialogResult(D : TCommonDialog) : String; virtual;
|
|
procedure DoButtonClick (Sender: TObject); override;
|
|
procedure RunDialog; virtual;
|
|
public
|
|
published
|
|
// TDirectory properties.
|
|
property Directory: String read GetDirectory write SetDirectory;
|
|
property RootDir: String read FRootDir write FRootDir;
|
|
property OnAcceptDirectory: TAcceptFileNameEvent read FOnAcceptDir write FonAcceptDir;
|
|
property DialogTitle: String read FDialogTitle write FDialogTitle;
|
|
property ShowHidden: Boolean read FShowHidden write FShowHidden;
|
|
// TEditButton properties.
|
|
property ButtonWidth;
|
|
property DirectInput;
|
|
property ButtonOnlyWhenFocused;
|
|
// property Glyph;
|
|
property NumGlyphs;
|
|
property Flat;
|
|
// Other properties
|
|
property Align;
|
|
property Anchors;
|
|
property AutoSize;
|
|
property AutoSelect;
|
|
property BorderSpacing;
|
|
property BorderStyle;
|
|
property Color;
|
|
property DragCursor;
|
|
property DragMode;
|
|
property Enabled;
|
|
property Font;
|
|
property MaxLength;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ReadOnly;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Visible;
|
|
property OnChange;
|
|
property OnClick;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEditingDone;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnStartDrag;
|
|
property OnUTF8KeyPress;
|
|
end;
|
|
|
|
|
|
{ TDateEdit }
|
|
|
|
TAcceptDateEvent = procedure (Sender : TObject; var ADate : TDateTime;
|
|
var AcceptDate: Boolean) of object;
|
|
TCustomDateEvent = procedure (Sender : TObject; var ADate : string) of object;
|
|
TDateOrder = (doNone,doMDY,doDMY,doYMd);
|
|
|
|
{ TDateEdit }
|
|
|
|
TDateEdit = class(TCustomEditButton)
|
|
private
|
|
FDateOrder: TDateOrder;
|
|
FDefaultToday: Boolean;
|
|
FDialogTitle: TCaption;
|
|
FDisplaySettings: TDisplaySettings;
|
|
FOnAcceptDate: TAcceptDateEvent;
|
|
FOnCustomDate: TCustomDateEvent;
|
|
FOKCaption: TCaption;
|
|
FCancelCaption: TCaption;
|
|
FDateFormat: string;
|
|
function GetDate: TDateTime;
|
|
function IsStoreTitle: boolean;
|
|
procedure SetDate(Value: TDateTime);
|
|
procedure CalendarPopupReturnDate(Sender: TObject; const ADate: TDateTime);
|
|
procedure SetDateOrder(const AValue: TDateOrder);
|
|
protected
|
|
function GetDefaultGlyph: TBitmap; override;
|
|
function GetDefaultGlyphName: String; override;
|
|
procedure DoButtonClick(Sender: TObject); override;
|
|
procedure DblClick; override;
|
|
procedure SetDateMask; virtual;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure DateFormatChanged; virtual;
|
|
function GetDateFormat: string;
|
|
property Date: TDateTime read GetDate write SetDate;
|
|
property Button;
|
|
published
|
|
property DialogTitle: TCaption read FDialogTitle write FDialogTitle stored IsStoreTitle;
|
|
property CalendarDisplaySettings: TDisplaySettings read FDisplaySettings write FDisplaySettings;
|
|
property OnAcceptDate: TAcceptDateEvent read FOnAcceptDAte write FOnAcceptDate;
|
|
property OnCustomDate: TCustomDateEvent read FOnCustomDate write FOnCustomDate;
|
|
property OKCaption: TCaption read FOKCaption write FOKCaption;
|
|
property CancelCaption: TCaption read FCancelCaption write FCancelCaption;
|
|
property ReadOnly;
|
|
property DefaultToday: Boolean read FDefaultToday write FDefaultToday default False;
|
|
Property DateOrder : TDateOrder Read FDateOrder Write SetDateOrder;
|
|
property ButtonOnlyWhenFocused;
|
|
property ButtonWidth;
|
|
property Action;
|
|
property Align;
|
|
property Anchors;
|
|
property AutoSize;
|
|
property AutoSelect;
|
|
property BorderSpacing;
|
|
property BorderStyle;
|
|
property Color;
|
|
property Constraints;
|
|
property CharCase;
|
|
property DirectInput;
|
|
property Glyph;
|
|
property NumGlyphs;
|
|
property DragMode;
|
|
property EchoMode;
|
|
property Enabled;
|
|
property Font;
|
|
property MaxLength;
|
|
property OnChange;
|
|
property OnChangeBounds;
|
|
property OnClick;
|
|
property OnEditingDone;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnResize;
|
|
property OnUTF8KeyPress;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PasswordChar;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property TabStop;
|
|
property TabOrder;
|
|
property Visible;
|
|
end;
|
|
|
|
|
|
{ TCalcEdit }
|
|
|
|
TAcceptValueEvent = procedure(Sender: TObject; var AValue: Double; var Action: Boolean) of object;
|
|
TCalcEdit = class(TCustomEditButton)
|
|
private
|
|
FDialogTitle: String;
|
|
FLayout: TCalculatorLayout;
|
|
FOnAcceptValue: TAcceptValueEvent;
|
|
function GetAsFloat: Double;
|
|
function GetAsInteger: Integer;
|
|
procedure SetAsFloat(const AValue: Double);
|
|
procedure SetAsInteger(const AValue: Integer);
|
|
function TitleStored: boolean;
|
|
protected
|
|
FCalcDialog : TForm;
|
|
function GetDefaultGlyph: TBitmap; override;
|
|
function GetDefaultGlyphName: String; override;
|
|
procedure DoButtonClick (Sender: TObject); override;
|
|
procedure RunDialog; virtual;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
published
|
|
// CalcEdit properties
|
|
property CalculatorLayout : TCalculatorLayout read FLayout write Flayout;
|
|
property AsFloat : Double read GetAsFloat write SetAsFloat;
|
|
property AsInteger : Integer read GetAsInteger write SetAsInteger;
|
|
property OnAcceptValue : TAcceptValueEvent read FOnAcceptValue write FOnAcceptValue;
|
|
property DialogTitle : String read FDialogTitle write FDialogTitle Stored TitleStored;
|
|
// TEditButton properties.
|
|
property ButtonWidth;
|
|
property DirectInput;
|
|
property ButtonOnlyWhenFocused;
|
|
// property Glyph;
|
|
property NumGlyphs;
|
|
property Flat;
|
|
// Other properties
|
|
property Align;
|
|
property Anchors;
|
|
property BorderSpacing;
|
|
property BorderStyle;
|
|
property AutoSize;
|
|
property AutoSelect;
|
|
property Color;
|
|
property DragCursor;
|
|
property DragMode;
|
|
property Enabled;
|
|
property Font;
|
|
property MaxLength;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ReadOnly;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Visible;
|
|
property OnChange;
|
|
property OnClick;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEditingDone;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnStartDrag;
|
|
property OnUTF8KeyPress;
|
|
end;
|
|
|
|
var
|
|
FileOpenGlyph: TBitmap;
|
|
DateGlyph: TBitmap;
|
|
CalcGlyph: TBitmap;
|
|
|
|
const
|
|
ResBtnFileOpen = 'btnselfile';
|
|
ResBtnSelDir = 'btnseldir';
|
|
ResBtnCalendar = 'btncalendar';
|
|
ResBtnCalculator = 'btncalculator';
|
|
|
|
procedure Register;
|
|
|
|
implementation
|
|
|
|
|
|
{ TEditBtn }
|
|
|
|
constructor TCustomEditButton.Create(AOwner: TComponent);
|
|
var
|
|
B: TBitmap;
|
|
begin
|
|
inherited Create(AOwner);
|
|
FDirectInput := True;
|
|
FButton := TSpeedButton.Create(Self);
|
|
FButton.Width := Self.Height;
|
|
FButton.Height := Self.Height;
|
|
FButton.FreeNotification(Self);
|
|
CheckButtonVisible;
|
|
FButton.OnClick := @DoButtonClick;
|
|
FButton.Cursor := crArrow;
|
|
FButton.ControlStyle := FButton.ControlStyle + [csNoDesignSelectable];
|
|
B := GetDefaultGlyph;
|
|
if B = nil
|
|
then FButton.LoadGlyphFromLazarusResource(GetDefaultGlyphName)
|
|
else FButton.Glyph := B;
|
|
ControlStyle := ControlStyle - [csSetCaption];
|
|
end;
|
|
|
|
destructor TCustomEditButton.Destroy;
|
|
begin
|
|
FreeAndNil(FButton);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TCustomEditButton.SetGlyph(Pic: TBitmap);
|
|
Begin
|
|
FButton.Glyph:=Pic;
|
|
end;
|
|
|
|
function TCustomEditButton.GetButtonWidth: Integer;
|
|
begin
|
|
Result:=FButton.Width;
|
|
end;
|
|
|
|
function TCustomEditButton.GetDefaultGlyph: TBitmap;
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
|
|
function TCustomEditButton.GetDefaultGlyphName: String;
|
|
begin
|
|
Result := '';
|
|
end;
|
|
|
|
function TCustomEditButton.GetButtonHint: TTranslateString;
|
|
begin
|
|
Result:=FButton.Hint;
|
|
end;
|
|
|
|
function TCustomEditButton.GetDirectInput: Boolean;
|
|
begin
|
|
Result := FDirectInput;
|
|
end;
|
|
|
|
function TCustomEditButton.GetFlat: Boolean;
|
|
begin
|
|
if Assigned(FButton) then
|
|
Result := FButton.Flat
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
procedure TCustomEditButton.CheckButtonVisible;
|
|
begin
|
|
If Assigned(FButton) then
|
|
FButton.Visible:=(csdesigning in ComponentState) or
|
|
(Visible and (Focused or not FButtonNeedsFocus));
|
|
end;
|
|
|
|
procedure TCustomEditButton.SetButtonHint(const AValue: TTranslateString);
|
|
begin
|
|
FButton.Hint:=AValue;
|
|
end;
|
|
|
|
procedure TCustomEditButton.SetButtonNeedsFocus(const AValue: Boolean);
|
|
begin
|
|
if FButtonNeedsFocus<>AValue then
|
|
begin
|
|
FButtonNeedsFocus:=AValue;
|
|
CheckButtonVisible;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomEditButton.SetButtonWidth(const AValue: Integer);
|
|
begin
|
|
FButton.Width:=AValue;
|
|
end;
|
|
|
|
procedure TCustomEditButton.SetDirectInput(const AValue: Boolean);
|
|
begin
|
|
FDirectInput := AValue;
|
|
inherited SetReadOnly((not FDirectInput) or (FIsReadOnly))
|
|
end;
|
|
|
|
procedure TCustomEditButton.SetFlat(const AValue: Boolean);
|
|
begin
|
|
if Assigned(FButton) then
|
|
FButton.Flat:=AValue;
|
|
end;
|
|
|
|
function TCustomEditButton.GetGlyph : TBitmap;
|
|
begin
|
|
Result:=FButton.Glyph;
|
|
end;
|
|
|
|
procedure TCustomEditButton.SetNumGlyphs(ANumber: Integer);
|
|
begin
|
|
FButton.NumGlyphs:=ANumber;
|
|
end;
|
|
|
|
function TCustomEditButton.GetNumGlyphs:Integer;
|
|
begin
|
|
Result:=FButton.NumGlyphs;
|
|
end;
|
|
|
|
procedure TCustomEditButton.Notification(AComponent: TComponent; Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (AComponent = FButton) and (Operation = opRemove) then
|
|
FButton := nil;
|
|
end;
|
|
|
|
procedure TCustomEditButton.CMVisibleChanged(var Msg: TLMessage);
|
|
begin
|
|
inherited CMVisibleChanged(Msg);
|
|
|
|
CheckButtonVisible;
|
|
end;
|
|
|
|
procedure TCustomEditButton.CMEnabledChanged(var Msg: TLMessage);
|
|
begin
|
|
inherited CMEnabledChanged(Msg);
|
|
|
|
if (FButton<>nil) and (not ReadOnly) then
|
|
FButton.Enabled:=Enabled;
|
|
end;
|
|
|
|
function TCustomEditButton.GetMinHeight: Integer;
|
|
begin
|
|
Result:=23;
|
|
end;
|
|
|
|
procedure TCustomEditButton.DoButtonClick (Sender: TObject);
|
|
begin
|
|
If not ReadOnly then
|
|
if Assigned(FOnButtonClick) then
|
|
FOnButtonClick(Self);
|
|
end;
|
|
|
|
procedure TCustomEditButton.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
CheckButtonVisible;
|
|
DoPositionButton;
|
|
end;
|
|
|
|
procedure TCustomEditButton.WMKillFocus(var Message: TLMKillFocus);
|
|
begin
|
|
if FButtonNeedsFocus then
|
|
FButton.Visible:=False;
|
|
inherited;
|
|
end;
|
|
|
|
function TCustomEditButton.GetReadOnly: Boolean;
|
|
begin
|
|
Result := FIsReadOnly;
|
|
end;
|
|
|
|
procedure TCustomEditButton.SetParent(AParent: TWinControl);
|
|
begin
|
|
inherited SetParent(AParent);
|
|
if FButton <> nil then
|
|
begin
|
|
DoPositionButton;
|
|
CheckButtonVisible;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomEditButton.SetReadOnly(AValue: Boolean);
|
|
begin
|
|
FIsReadOnly := AValue;
|
|
if Assigned(FButton) then
|
|
FButton.Enabled := not FIsReadOnly and Enabled;
|
|
inherited SetReadOnly(FIsReadOnly or (not DirectInput));
|
|
end;
|
|
|
|
procedure TCustomEditButton.DoPositionButton;
|
|
begin
|
|
if FButton = nil then exit;
|
|
FButton.Parent := Parent;
|
|
FButton.Visible := Visible;
|
|
FButton.AnchorToCompanion(akLeft,0,Self);
|
|
end;
|
|
|
|
procedure TCustomEditButton.WMSetFocus(var Message: TLMSetFocus);
|
|
begin
|
|
FButton.Visible:=True;
|
|
inherited;
|
|
end;
|
|
|
|
{ TFileNameEdit }
|
|
|
|
constructor TFileNameEdit.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FDialogFiles := TStringList.Create;
|
|
FDialogKind := dkOpen;
|
|
end;
|
|
|
|
destructor TFileNameEdit.Destroy;
|
|
begin
|
|
FreeAndNil(FDialogFiles);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TFileNameEdit.SetFileName(const AValue: String);
|
|
begin
|
|
if FFileNameChangeLock > 0 then
|
|
Exit;
|
|
FFileName := AValue;
|
|
Inc(FFileNameChangeLock);
|
|
try
|
|
if FHideDirectories then
|
|
inherited RealSetText(ExtractFileName(AValue))
|
|
else
|
|
inherited RealSetText(AValue)
|
|
finally
|
|
Dec(FFileNameChangeLock);
|
|
end;
|
|
end;
|
|
|
|
function TFileNameEdit.CreateDialog(AKind: TDialogKind): TCommonDialog;
|
|
var
|
|
O: TOpenDialog;
|
|
S: TSaveDialog;
|
|
begin
|
|
Case AKind of
|
|
dkopen, dkPictureOpen:
|
|
begin
|
|
O:=TOpenDialog.Create(Self);
|
|
O.FileName:=FileName;
|
|
O.Options:=DialogOptions;
|
|
O.InitialDir:=InitialDir;
|
|
O.Filter:=Filter;
|
|
O.FilterIndex:=FilterIndex;
|
|
Result:=O;
|
|
end;
|
|
dkSave, dkPictureSave:
|
|
begin
|
|
S:=TSaveDialog.Create(Self);
|
|
S.Filter:=Filter;
|
|
S.FilterIndex:=FilterIndex;
|
|
Result:=S;
|
|
end;
|
|
end;
|
|
// Set some common things.
|
|
Result.Title := DialogTitle;
|
|
end;
|
|
|
|
procedure TFileNameEdit.SaveDialogResult(AKind: TDialogKind; D: TCommonDialog);
|
|
var
|
|
FN: String;
|
|
begin
|
|
case AKind of
|
|
dkOpen,dkPictureOpen :
|
|
begin
|
|
FN:=TOpenDialog(D).FileName;
|
|
if (FN<>'') then
|
|
begin
|
|
if Assigned(FOnAcceptFN) then
|
|
FOnAcceptFN(Self,Fn);
|
|
end;
|
|
if (FN<>'') then
|
|
begin
|
|
// set FDialogFiles first since assigning of FileName trigger events
|
|
FDialogFiles.Text:=TOpenDialog(D).Files.Text;
|
|
FileName:=FN;
|
|
end;
|
|
end;
|
|
dkSave,dkPictureSave :
|
|
begin
|
|
FileName:=TSaveDialog(D).FileName;
|
|
FDialogFiles.Clear;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TFileNameEdit.DoButtonClick(Sender: TObject);
|
|
begin
|
|
inherited DoButtonClick(Sender);
|
|
RunDialog;
|
|
end;
|
|
|
|
function TFileNameEdit.GetDefaultGlyph: TBitmap;
|
|
begin
|
|
Result := FileOpenGlyph;
|
|
end;
|
|
|
|
function TFileNameEdit.GetDefaultGlyphName: String;
|
|
begin
|
|
Result := ResBtnFileOpen;
|
|
end;
|
|
|
|
procedure TFileNameEdit.RunDialog;
|
|
var
|
|
D : TCommonDialog;
|
|
begin
|
|
D:=CreateDialog(DialogKind);
|
|
try
|
|
if D.Execute then
|
|
SaveDialogResult(DialogKind,D);
|
|
finally
|
|
D.Free;
|
|
end
|
|
end;
|
|
|
|
procedure TFileNameEdit.TextChanged;
|
|
begin
|
|
inherited TextChanged;
|
|
if FFileNameChangeLock > 0 then
|
|
Exit;
|
|
Inc(FFileNameChangeLock);
|
|
try
|
|
if FHideDirectories and (ExtractFilePath(Text) = '') then
|
|
FFileName := ExtractFilePath(FFileName) + Text
|
|
else
|
|
FFileName := Text;
|
|
finally
|
|
Dec(FFileNameChangeLock);
|
|
end;
|
|
end;
|
|
|
|
{ TDirectoryEdit }
|
|
|
|
procedure TDirectoryEdit.SetDirectory(const AValue: String);
|
|
begin
|
|
if (Text<>AValue) then
|
|
Text:=AValue;
|
|
end;
|
|
|
|
function TDirectoryEdit.CreateDialog: TCommonDialog;
|
|
begin
|
|
Result:=TSelectDirectoryDialog.Create(Self);
|
|
if DirPathExists(Directory) then
|
|
begin
|
|
TSelectDirectoryDialog(Result).InitialDir:=Directory;
|
|
TSelectDirectoryDialog(Result).FileName:='';
|
|
end
|
|
else
|
|
begin
|
|
TSelectDirectoryDialog(Result).InitialDir:=RootDir;
|
|
TSelectDirectoryDialog(Result).FileName:=Directory;
|
|
end;
|
|
// Set some common things.
|
|
Result.Title := DialogTitle;
|
|
end;
|
|
|
|
function TDirectoryEdit.GetDialogResult(D: TCommonDialog) : String;
|
|
begin
|
|
Result:=TSelectDirectoryDialog(D).FileName;
|
|
end;
|
|
|
|
|
|
procedure TDirectoryEdit.DoButtonClick(Sender: TObject);
|
|
begin
|
|
inherited DoButtonClick(Sender);
|
|
RunDialog;
|
|
end;
|
|
|
|
function TDirectoryEdit.GetDefaultGlyph: TBitmap;
|
|
begin
|
|
Result := FileOpenGlyph;
|
|
end;
|
|
|
|
function TDirectoryEdit.GetDefaultGlyphName: String;
|
|
begin
|
|
Result := ResBtnSelDir;
|
|
end;
|
|
|
|
procedure TDirectoryEdit.RunDialog;
|
|
var
|
|
D: String;
|
|
Dlg: TCommonDialog;
|
|
B: Boolean;
|
|
begin
|
|
Dlg:=CreateDialog;
|
|
try
|
|
B:=Dlg.Execute;
|
|
if B then
|
|
D:=GetDialogResult(Dlg);
|
|
finally
|
|
Dlg.Free;
|
|
end;
|
|
if B then
|
|
begin
|
|
if Assigned(FOnAcceptDir) then
|
|
begin
|
|
FOnAcceptdir(Self,D);
|
|
if (D<>'') then
|
|
Directory:=D;
|
|
end
|
|
else
|
|
Directory:=D;
|
|
end;
|
|
end;
|
|
|
|
function TDirectoryEdit.GetDirectory: String;
|
|
begin
|
|
Result:=Text;
|
|
end;
|
|
|
|
{ TDateEdit }
|
|
|
|
function StrToDateDef(cDate: String; dDefault: TDateTime): TDateTime;
|
|
begin
|
|
try
|
|
Result := StrToDate(cDate)
|
|
except
|
|
Result := dDefault;
|
|
end;
|
|
end;
|
|
|
|
constructor TDateEdit.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FDefaultToday := False;
|
|
FDisplaySettings := [dsShowHeadings, dsShowDayNames];
|
|
DialogTitle := rsPickDate;
|
|
OKCaption := 'OK';
|
|
CancelCaption := 'Cancel';
|
|
DateFormatChanged;
|
|
end;
|
|
|
|
procedure TDateEdit.DateFormatChanged;
|
|
begin
|
|
FDateFormat := ShortDateFormat;
|
|
end;
|
|
|
|
function TDateEdit.GetDateFormat: string;
|
|
begin
|
|
Result := FDateFormat;
|
|
end;
|
|
|
|
function TDateEdit.GetDefaultGlyph: TBitmap;
|
|
begin
|
|
Result := DateGlyph;
|
|
end;
|
|
|
|
function TDateEdit.GetDefaultGlyphName: String;
|
|
begin
|
|
Result := ResBtnCalendar;
|
|
end;
|
|
|
|
procedure TDateEdit.DoButtonClick(Sender: TObject);//or onClick
|
|
var
|
|
PopupOrigin: TPoint;
|
|
begin
|
|
inherited DoButtonClick(Sender);
|
|
|
|
PopupOrigin := ControlToScreen(Point(0, Height));
|
|
if (GetDate=NullDate) then
|
|
ShowCalendarPopup(PopupOrigin, SysUtils.Date, @CalendarPopupReturnDate)
|
|
else
|
|
ShowCalendarPopup(PopupOrigin, GetDate, @CalendarPopupReturnDate)
|
|
end;
|
|
|
|
procedure TDateEdit.DblClick;
|
|
begin
|
|
inherited DblClick;
|
|
DoButtonClick(nil);
|
|
end;
|
|
|
|
procedure TDateEdit.SetDateMask;
|
|
|
|
Var
|
|
S : String;
|
|
D : TDateTime;
|
|
begin
|
|
Case DateOrder of
|
|
doNone :
|
|
begin
|
|
S:=''; // no mask
|
|
FDateFormat:='';
|
|
end;
|
|
doDMY,
|
|
doMDY :
|
|
begin
|
|
S:='99/99/9999;1;_';
|
|
if DateOrder=doMDY then
|
|
FDateFormat:='mm/dd/yyyy'
|
|
else
|
|
FDateFormat:='dd/mm/yyyy';
|
|
end;
|
|
doYMD :
|
|
begin
|
|
S:='9999/99/99;1;_';
|
|
FDateFormat:='yyyy/mm/dd';
|
|
end;
|
|
end;
|
|
D:=GetDate;
|
|
EditMask:=S;
|
|
SetDate(D);
|
|
end;
|
|
|
|
Function ParseDate(S : String; Order : TDateOrder; Def: TDateTime) : TDateTime;
|
|
|
|
Var
|
|
P,N1,N2,N3 : Integer;
|
|
B : Boolean;
|
|
|
|
begin
|
|
Result:=Def;
|
|
P:=Pos(DateSeparator,S);
|
|
If (P=0) then
|
|
Exit;
|
|
N1:=StrToIntDef(Copy(S,1,P-1),-1);
|
|
If (N1=-1) then Exit;
|
|
Delete(S,1,P);
|
|
P:=Pos(DateSeparator,S);
|
|
If (P=0) then
|
|
Exit;
|
|
N2:=StrToIntDef(Copy(S,1,P-1),-1);
|
|
If (N1=0) then Exit;
|
|
Delete(S,1,P);
|
|
N3:=StrToIntDef(S,-1);
|
|
If (N3=-1) then
|
|
exit;
|
|
Case Order of
|
|
doYMD : B:=TryEncodeDate(N1,N2,N3,Result);
|
|
doMDY : B:=TryEncodeDate(N3,N1,N2,Result);
|
|
doDMY : B:=TryEncodeDate(N3,N2,N1,Result);
|
|
end;
|
|
If not B then // Not sure if TryEncodeDate touches Result.
|
|
Result:=Def;
|
|
end;
|
|
|
|
function TDateEdit.GetDate: TDateTime;
|
|
var
|
|
ADate: string;
|
|
begin
|
|
if FDefaultToday then
|
|
Result := SysUtils.Date
|
|
else
|
|
Result := NullDate;
|
|
ADate := Trim(Text);
|
|
if ADate <> '' then
|
|
begin
|
|
if Assigned(FOnCustomDate) then
|
|
FOnCustomDate(Self, ADate);
|
|
if (DateOrder = doNone) then
|
|
Result := StrToDateDef(ADate, Result)
|
|
else
|
|
Result := ParseDate(ADate,DateOrder,Result)
|
|
end;
|
|
end;
|
|
|
|
function TDateEdit.IsStoreTitle: boolean;
|
|
begin
|
|
Result := DialogTitle <> rsPickDate;
|
|
end;
|
|
|
|
procedure TDateEdit.SetDate(Value: TDateTime);
|
|
var
|
|
D: TDateTime;
|
|
begin
|
|
if {not IsValidDate(Value) or }(Value = NullDate) then
|
|
begin
|
|
if DefaultToday then
|
|
Value := SysUtils.Date
|
|
else
|
|
Value := NullDate;
|
|
end;
|
|
D := Self.Date;
|
|
if Value = NullDate then
|
|
Text := ''
|
|
else
|
|
begin
|
|
If (FDateFormat='') then
|
|
Text:=DateToStr(Value)
|
|
else
|
|
Text:=FormatDateTime(FDateFormat,Value)
|
|
end;
|
|
if D <> Date then
|
|
Change;
|
|
end;
|
|
|
|
procedure TDateEdit.CalendarPopupReturnDate(Sender: TObject;
|
|
const ADate: TDateTime);
|
|
var
|
|
B:Boolean;
|
|
D:TDateTime;
|
|
begin
|
|
try
|
|
B:=true;
|
|
D:=ADate;
|
|
if Assigned(FOnAcceptDate) then
|
|
FOnAcceptDate(Self, D, B);
|
|
if B then
|
|
Self.Date:=D;
|
|
except
|
|
on E:Exception do
|
|
MessageDlg(E.Message, mtError, [mbOK], 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TDateEdit.SetDateOrder(const AValue: TDateOrder);
|
|
begin
|
|
if FDateOrder=AValue then exit;
|
|
FDateOrder:=AValue;
|
|
SetDateMask;
|
|
end;
|
|
|
|
{ TCalcEdit }
|
|
|
|
function TCalcEdit.GetAsFloat: Double;
|
|
begin
|
|
Result := StrToFloatDef(Trim(Text), 0.0);
|
|
end;
|
|
|
|
function TCalcEdit.GetAsInteger: Integer;
|
|
begin
|
|
Result:=StrToIntDef(Text,0);
|
|
end;
|
|
|
|
function TCalcEdit.GetDefaultGlyph: TBitmap;
|
|
begin
|
|
Result := CalcGlyph;
|
|
end;
|
|
|
|
function TCalcEdit.GetDefaultGlyphName: String;
|
|
begin
|
|
Result := ResBtnCalculator;
|
|
end;
|
|
|
|
procedure TCalcEdit.SetAsFloat(const AValue: Double);
|
|
begin
|
|
Text:=FloatToStr(AValue);
|
|
end;
|
|
|
|
procedure TCalcEdit.SetAsInteger(const AValue: Integer);
|
|
begin
|
|
Text:=IntToStr(AValue);
|
|
end;
|
|
|
|
function TCalcEdit.TitleStored: boolean;
|
|
begin
|
|
Result:=FDialogTitle<>rsCalculator;
|
|
end;
|
|
|
|
procedure TCalcEdit.DoButtonClick(Sender: TObject);
|
|
begin
|
|
inherited DoButtonClick(Sender);
|
|
RunDialog;
|
|
end;
|
|
|
|
procedure TCalcEdit.RunDialog;
|
|
var
|
|
D : Double;
|
|
B : Boolean;
|
|
begin
|
|
D:=AsFloat;
|
|
with CreateCalculatorForm(Self,FLayout,0) do
|
|
try
|
|
Caption:=DialogTitle;
|
|
Value:=D;
|
|
if (ShowModal=mrOK) then
|
|
begin
|
|
D:=Value;
|
|
B:=True;
|
|
If Assigned(FOnAcceptValue) then
|
|
FOnAcceptValue(Self,D,B);
|
|
if B then
|
|
AsFloat:=D;
|
|
end;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
constructor TCalcEdit.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FdialogTitle:=rsCalculator;
|
|
end;
|
|
|
|
destructor TCalcEdit.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents('Misc', [TEditButton,TFileNameEdit,TDirectoryEdit,
|
|
TDateEdit,TCalcEdit]);
|
|
end;
|
|
|
|
initialization
|
|
{$i lcl_edbtnimg.lrs}
|
|
|
|
end.
|