📄 flatctrdb.pas
字号:
unit FlatCtrdb;
interface
{$I FlatStyle.inc}
uses
Windows, Messages, Classes, Forms, Controls, Graphics, SysUtils,
DB, DBCtrls, StdCtrls, FlatBoxs, FlatCtrls, FlatUtils, FlatConsts;
type
{ TFlatDBComboBox }
TFlatDBComboBox = class(TDefineComboBox)
private
FDataLink: TFieldDataLink;
FPaintControl: TPaintControl;
procedure DataChange(Sender: TObject);
procedure EditingChange(Sender: TObject);
function GetComboText: string;
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetReadOnly: Boolean;
procedure SetComboText(const Value: string);
procedure SetDataField(const Value: string);
procedure SetDataSource(Value: TDataSource);
procedure SetEditReadOnly;
procedure SetReadOnly(Value: Boolean);
procedure UpdateData(Sender: TObject);
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
protected
procedure Change; override;
procedure Click; override;
procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer); override;
procedure CreateWnd; override;
procedure DropDown; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure Loaded; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetItems(const Value: TStrings); override;
procedure SetStyle(Value: TComboboxStyle); override;
procedure WndProc(var Message: TMessage); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
function UseRightToLeftAlignment: Boolean; override;
property Field: TField read GetField;
property Text;
published
property Style;
property Ticket;
property TicketPosition;
property TicketSpace;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property Items write SetItems;
property Version;
property ColorArrow;
property ColorArrowBackground;
property ColorBorder;
property ColorFlat;
property ColorFocued;
property DragMode;
property DragCursor;
property DropDownCount;
property Enabled;
property Font;
property ItemHeight;
property MaxLength;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Sorted;
property TabOrder;
property TabStop;
property Visible;
property ItemIndex;
property OnChange;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawItem;
property OnDropDown;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMeasureItem;
property OnStartDrag;
property Anchors;
property BiDiMode;
property Constraints;
property DragKind;
property ParentBiDiMode;
property OnEndDock;
property OnStartDock;
end;
{ TFlatDBListBox }
TFlatDBListBox = class(TDefineListBox)
private
FDataLink: TFieldDataLink;
procedure DataChange(Sender: TObject);
procedure UpdateData(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetReadOnly: Boolean;
procedure SetDataField(const Value: string);
procedure SetDataSource(Value: TDataSource);
procedure SetReadOnly(Value: Boolean);
procedure SetItems(Value: TStringList);
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
protected
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Click; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
function UseRightToLeftAlignment: Boolean; override;
property Field: TField read GetField;
published
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property Items write SetItems;
property Version;
property Caption;
property Skin;
property Align;
property Anchors;
property Constraints;
property Enabled;
property Font;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnChange;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
{ TFlatDBEdit }
TFlatDBEdit = class(TDefineEdit)
private
FDataLink: TFieldDataLink;
FCanvas: TControlCanvas;
FAlignment: TAlignment;
FFocused: Boolean;
procedure ActiveChange(Sender: TObject);
procedure DataChange(Sender: TObject);
procedure EditingChange(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetReadOnly: Boolean;
function GetTextMargins: TPoint;
procedure ResetMaxLength;
procedure SetDataField(const Value: string);
procedure SetDataSource(Value: TDataSource);
procedure SetFocused(Value: Boolean);
procedure SetReadOnly(Value: Boolean);
procedure UpdateData(Sender: TObject);
procedure WMCut(var Message: TMessage); message WM_CUT;
procedure WMPaste(var Message: TMessage); message WM_PASTE;
procedure WMUndo(var Message: TMessage); message WM_UNDO;
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
protected
procedure Change; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure Loaded; override;
procedure Notification(AComponent: TComponent;Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
function UseRightToLeftAlignment: Boolean; override;
property Field: TField read GetField;
published
property Anchors;
property AutoSelect;
property AutoSize;
property BiDiMode;
property BorderStyle;
property CharCase;
property Color;
property Constraints;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property Ticket;
property TicketPosition;
property TicketSpace;
property Version;
property Alignment;
property ColorFocused;
property ColorBorder;
property ColorFlat;
property ParentColor;
property MaxLength;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ParentBiDiMode;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PasswordChar;
property PopupMenu;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
{ TFlatDBFloat }
TFlatDBFloat = class(TFlatFloat)
private
FDataLink : TFieldDataLink;
function GetField : TField;
function GetDataField : string;
procedure SetDataField(const Value: string);
function GetDataSource : TDataSource ;
procedure SetDataSource(Value : TDataSource);
procedure CMExit(var Message:TCMExit);message CM_Exit;
procedure EditingChange(Sender: TObject);
procedure DataChange(sender : TObject);
procedure UpdateData(sender : TObject);
procedure ActiveChange(sender : TObject);
protected
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure DownClick (Sender: TObject); override;
procedure UpClick (Sender: TObject); override;
procedure Change; override;
public
property Field: TField read GetField;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
end;
{ TFlatDBInteger }
TFlatDBInteger = class (TFlatInteger)
private
FDataLink : TFieldDataLink;
function GetDataField : String;
function GetDataSource : TDataSource;
function GetReadOnly : Boolean;
procedure SetReadOnly (aValue : Boolean);
procedure SetDataSource (aValue : TDataSource);
procedure SetDataField (const aValue : String);
procedure DataChange (Sender : TObject);
procedure UpdateData(Sender: TObject);
procedure EditingChange(Sender: TObject);
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure WMCut(var Message: TMessage); message WM_CUT;
procedure WMPaste(var Message: TMessage); message WM_PASTE;
protected
procedure Change; override;
procedure Notification(AComponent: TComponent; Operation: TOperation);override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure DownClick (Sender: TObject); override;
procedure UpClick (Sender: TObject); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property DataSource : TDataSource read GetDataSource write SetDataSource;
property DataField: string read GetDataField write SetDataField;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
end;
{ TFlatDBMaskEdit }
TFlatDBMaskEdit = Class(TDefineMask)
private
FDataLink: TFieldDataLink;
FCanvas: TControlCanvas;
FAlignment: TAlignment;
FFocused: Boolean;
procedure ActiveChange(Sender: TObject);
procedure DataChange(Sender: TObject);
procedure EditingChange(Sender: TObject);
procedure ResetMaxLength;
procedure UpdateData(Sender: TObject);
procedure SetFocused(Value: Boolean);
function GetTextMargins: TPoint;
procedure WMCut(var Message: TMessage); message WM_CUT;
procedure WMPaste(var Message: TMessage); message WM_PASTE;
procedure WMUndo(var Message: TMessage); message WM_UNDO;
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetReadOnly: Boolean;
procedure SetDataField(const Value: string);
procedure SetDataSource(const Value: TDataSource);
procedure SetReadOnly(const Value: Boolean);
protected
procedure Change; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure Loaded; override;
procedure Notification(AComponent: TComponent;Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
function UseRightToLeftAlignment: Boolean; override;
property Field: TField read GetField;
published
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property Ticket;
property TicketPosition;
property TicketSpace;
property Version;
property ColorFocused;
property ColorBorder;
property ColorFlat;
property ParentColor;
property Alignment;
property Align;
property AutoSelect;
property AutoSize;
property BorderStyle;
property CharCase;
property Color;
property DragCursor;
property DragMode;
property Enabled;
property EditMask;
property Font;
property HideSelection;
property MaxLength;
property OEMConvert;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PasswordChar;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Text;
property Visible;
property OnChange;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
property OnValidate;
{$IFDEF DFS_DELPHI_4_UP}
property ImeMode;
property ImeName;
property Anchors;
property BiDiMode;
property Constraints;
property DragKind;
property ParentBiDiMode;
property OnEndDock;
property OnStartDock;
{$ENDIF}
end;
{ TFlatDBMemo }
TFlatDBMemo = class(TDefineMemo)
private
FDataLink: TFieldDataLink;
FAutoDisplay: Boolean;
FFocused: Boolean;
FMemoLoaded: Boolean;
FPaintControl: TPaintControl;
procedure DataChange(Sender: TObject);
procedure EditingChange(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetReadOnly: Boolean;
procedure SetDataField(const Value: string);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -