unit FlatCtrdb; interface {$I FlatStyle.inc} uses Windows, Messages, Classes, Controls, Forms, Graphics, SysUtils, StdCtrls, ExtCtrls, DB, DBCtrls, Grids, DBGrids, FlatUtils, FlatCtrls; type { TDefineDBButton } TDefineDBButton = class; { TDefineDBBDataLink } TDefineDBBDataLink = class(TDataLink) private FDBBitBtn: TDefineDBButton; protected procedure EditingChanged; override; procedure DataSetChanged; override; procedure ActiveChanged; override; public constructor Create(ANav: TDefineDBButton); destructor Destroy; override; end; { TDefineDBButton } TDefineDBButton = class(TDefineButton) private FDBButton: TFlatDBBName; FBeforeAction: EFlatBroClick; FShowDialog: Boolean; FOnNavClick: EFlatBroClick; function GetDataSource: TDataSource; procedure SetDataSource(const Value: TDataSource); procedure SetDBButton(const Value: TFlatDBBName); protected FDataLink : TDefineDBBDataLink; procedure ActiveChanged; procedure DataChanged; procedure EditingChanged; procedure BtnClick(Index: TFlatDBBName); procedure Loaded; override; procedure LoadResourceData(Value: TFlatDBBName); procedure ClickHandler(Sender: TObject); procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS; procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS; procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE; procedure SetName(const Value: TComponentName); override; property DataSource : TDataSource read GetDataSource write SetDataSource; property DBButton : TFlatDBBName read FDBButton write SetDBButton default vbNew; property BeforeAction: EFlatBroClick read FBeforeAction write FBeforeAction; property ShowDialog : Boolean read FShowDialog write FShowDialog default true; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; end; { TDefineDBNavigator } TDefineDBNavigator = class; TDefineDBNButton = class(TDefineButton) private FIndex: TFlatDBBName; FBroStyle: TFlatDBBStyle; FRepeatTimer: TTimer; procedure TimerExpired(Sender: TObject); protected procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; public destructor Destroy; override; property BroStyle: TFlatDBBStyle read FBroStyle write FBroStyle; property Index : TFlatDBBName read FIndex write FIndex; end; { TDefineDBNDataLink } TDefineDBNDataLink = class(TDataLink) private FBrowser: TDefineDBNavigator; protected procedure EditingChanged; override; procedure DataSetChanged; override; procedure ActiveChanged; override; public constructor Create(ANav: TDefineDBNavigator); destructor Destroy; override; end; { TDefineDBNavigator } TDefineDBNavigator = class(TDefinePanel) private FDataLink: TDefineDBNDataLink; FVisibleBtns: TFlatDBBTSet; FHints: TStrings; FDefHints: TStrings; ButtonWidth: Integer; MinBtnSize: TPoint; FOnNavClick: EFlatBroClick; FBeforeAction: EFlatBroClick; FocusedButton: TFlatDBBName; FConfirmDelete: Boolean; procedure SetDataSource(Value: TDataSource); procedure SetVisible(Value: TFlatDBBTSet); procedure SetHints(Value: TStrings); function GetDataSource: TDataSource; function GetHints: TStrings; protected Buttons: array[TFlatDBBName] of TDefineDBNButton; procedure InitButtons; procedure InitHints; procedure SetSize(var W: Integer; var H: Integer); procedure WMSize(var Message: TWMSize); message WM_SIZE; procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS; procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS; procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE; procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING; procedure BtnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ClickHandler(Sender: TObject); procedure HintsChanged(Sender: TObject); procedure DataChanged; procedure EditingChanged; procedure ActiveChanged; procedure Loaded; override; procedure SetColors(Index: Integer; Value: TColor); override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; procedure CalcMinSize(var W, H: Integer); property DataSource: TDataSource read GetDataSource write SetDataSource; property VISButtons: TFlatDBBTSet read FVisibleBtns write SetVisible default [vbFirst,vbPrior,vbNext,vbLast,vbNew,vbDelete,vbEdit,vbSave,vbCancel,vbRefresh]; property DeleteDialog: Boolean read FConfirmDelete write FConfirmDelete default True; property Hints: TStrings read GetHints write SetHints; property BeforeAction: EFlatBroClick read FBeforeAction write FBeforeAction; property OnClick: EFlatBroClick read FOnNavClick write FOnNavClick; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; procedure BtnClick(Index: TFlatDBBName); virtual; end; { TDefineDBComboBox } TDefineDBComboBox = class(TDefineComboBox) private FDataLink: TFieldDataLink; FPaintControl: TPaintControl; 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); protected procedure DataChange(Sender: TObject); procedure EditingChange(Sender: TObject); 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; procedure ResetMaxLength; procedure ActiveChange(Sender: TObject); 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; 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; 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; end; { TDefineDBListBox } TDefineDBListBox = 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; 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; 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; end; { TDefineDBEdit } TDefineDBEdit = 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; property DataField: string read GetDataField write SetDataField; property DataSource: TDataSource read GetDataSource write SetDataSource; property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False; 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; end; { TDefineDBFloat } TDefineDBFloat = class(TDefineFloat) private FDataLink : TFieldDataLink; function GetField : TField; function GetDataField : string; procedure SetDataField(const Value: string); function GetDataSource : TDataSource ; procedure SetDataSource(Value : TDataSource); procedure EditingChange(Sender: TObject); procedure DataChange(sender : TObject); procedure UpdateData(sender : TObject); procedure ActiveChange(sender : TObject); function GetReadOnly: Boolean; procedure SetReadOnly(const Value: Boolean); 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 CMExit(var Message:TCMExit);message CM_Exit; procedure Change; override; property DataField: string read GetDataField write SetDataField; property DataSource: TDataSource read GetDataSource write SetDataSource; property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; property Field: TField read GetField; end; { TDefineDBInteger } TDefineDBInteger = class (TDefineInteger) 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); function GetField: TField; 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; 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; property DataSource : TDataSource read GetDataSource write SetDataSource; property DataField: string read GetDataField write SetDataField; property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; property Field: TField read GetField; end; { TDefineDBMask } TDefineDBMask = 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; property DataField: string read GetDataField write SetDataField; property DataSource: TDataSource read GetDataSource write SetDataSource; property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False; 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; end; { TDefineDBMemo } TDefineDBMemo = 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); procedure SetDataSource(Value: TDataSource); procedure SetReadOnly(Value: Boolean); procedure SetAutoDisplay(Value: Boolean); procedure SetFocused(Value: Boolean); procedure UpdateData(Sender: TObject); protected 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 WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK; procedure WMPaint(var Message: TWMPaint); message WM_PAINT; procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK; 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; procedure WndProc(var Message: TMessage); override; property DataField: string read GetDataField write SetDataField; property DataSource: TDataSource read GetDataSource write SetDataSource; property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False; property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function ExecuteAction(Action: TBasicAction): Boolean; override; procedure LoadMemo; virtual; function UpdateAction(Action: TBasicAction): Boolean; override; function UseRightToLeftAlignment: Boolean; override; property Field: TField read GetField; end; { TDefineDBCheckBox } TDefineDBCheckBox = class(TDefineCheckBox) private FDataLink: TFieldDataLink; FValueCheck: string; FValueUncheck: string; procedure SetDataField(const Value: string); procedure SetDataSource(Value: TDataSource); procedure SetReadOnly(Value: Boolean); function GetDataField: string; function GetDataSource: TDataSource; function GetField: TField; function GetReadOnly: Boolean; protected procedure CMExit(var Message: TCMExit); message CM_EXIT; procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK; procedure DataChange(Sender: TObject); procedure UpdateRecord; procedure KeyPress(var Key: Char); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; property DataLink: TFieldDataLink read FDataLink; property DataField: string read GetDataField write SetDataField; property DataSource: TDataSource read GetDataSource write SetDataSource; property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False; property Checked; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; property Field: TField read GetField; function ExecuteAction(Action: TBasicAction): Boolean; override; function UpdateAction(Action: TBasicAction): Boolean; override; function UseRightToLeftAlignment: Boolean; override; end; { TFlatDBCheckBox } TFlatDBCheckBox = class(TDefineDBCheckBox) published property DataField; property DataSource; property ReadOnly; property Transparent; property Action; property Caption; property ColorFocused; property ColorDown; property ColorChecked; property Color; property ColorBorder; property Enabled; property Font; property Layout; property ParentColor; property ParentFont; property ShowHint; property TabOrder; property TabStop; property Visible; 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; end; TFlatDBGrid = class(TVersionDBGrid) private FSingleColor: TColor; FDoubleColor: TColor; FDbBgColor: boolean; OldGridWnd : TWndMethod; FParentColor: Boolean; FFocusColor: TColor; FBorderColor: TColor; FFlatColor: TColor; FMouseIn: Boolean; FLinesColor: TColor; procedure SetColors(Index: Integer; Value: TColor); procedure SetParentColor(Value: Boolean); procedure NewGridWnd (var Message : TMessage); procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL; procedure SetDbBgColor(const Value: boolean); function GetMouseIn: boolean; protected procedure DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); override; procedure RedrawBorder (const Clip: HRGN = 0); procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS; procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS; procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE; procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT; procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE; procedure CMParentColorChanged(var Message: TWMNoParams); message CM_PARENTCOLORCHANGED; procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override; property MouseIn:boolean read GetMouseIn; public constructor Create(AOwner: TComponent); override; property Canvas; property SelectedRows; published property DbBgColor :Boolean read FDbBgColor Write SetDbBgColor default true; property ColorFocused: TColor index 0 read FFocusColor write SetColors default clWhite; property ColorBorder: TColor index 1 read FBorderColor write SetColors default DefaultBorderColor; property ColorFlat: TColor index 2 read FFlatColor write SetColors default DefaultFlatColor; property ColorLines: TColor index 3 read FLinesColor write SetColors default DefaultBorderColor; property ColorRowSingle :TColor index 4 read FSingleColor Write SetColors default clWhite; property ColorRowDouble :TColor index 5 read FDoubleColor Write SetColors default clWhite; property ParentColor: Boolean read FParentColor write SetParentColor default false; property Align; property Anchors; property BiDiMode; property Columns stored False; //StoreColumns; property Constraints; property DataSource; property DefaultDrawing; property DragCursor; property DragKind; property DragMode; property Enabled; property FixedColor; property Font; property ImeMode; property ImeName; property Options; property ParentBiDiMode; property ParentFont; property ParentShowHint; property PopupMenu; property ReadOnly; property ShowHint; property TabOrder; property TabStop; property TitleFont; property Visible; property OnCellClick; property OnColEnter; property OnColExit; property OnColumnMoved; property OnDrawDataCell; { obsolete } property OnDrawColumnCell; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEditButtonClick; property OnEndDock; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnStartDock; property OnStartDrag; property OnTitleClick; end; { TDefineDBRadioGroup } TDefineDBRadioGroup = class(TDefineRadioGroup) private FDataLink: TFieldDataLink; FValue: string; FValues: TStrings; FInSetValue: Boolean; FOnChange: TNotifyEvent; procedure DataChange(Sender: TObject); function GetDataField: string; function GetDataSource: TDataSource; function GetField: TField; function GetReadOnly: Boolean; function GetButtonValue(Index: Integer): string; procedure SetDataField(const Value: string); procedure SetDataSource(Value: TDataSource); procedure SetReadOnly(Value: Boolean); procedure SetValue(const Value: string); procedure SetItems(Value: TStrings); procedure SetValues(Value: TStrings); procedure CMExit(var Message: TCMExit); message CM_EXIT; procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK; protected SaveState:Boolean; procedure Change; dynamic; procedure Click; override; procedure KeyPress(var Key: Char); override; function CanModify: Boolean; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; property DataLink: TFieldDataLink read FDataLink; procedure UpdateRecord; //---------------------------- property DataField: string read GetDataField write SetDataField; property DataSource: TDataSource read GetDataSource write SetDataSource; property Items write SetItems; property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False; property Values: TStrings read FValues write SetValues; property OnChange: TNotifyEvent read FOnChange write FOnChange; 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 ItemIndex; property Value: string read FValue write SetValue; end; TFlatDBButton = class(TDefineDBButton) published property DataSource; property DBButton; property BeforeAction; property ShowDialog; property Transparent; property HasFocusFrame; property Default; property AllowAllUp; property ColorFocused; property ColorDown; property ColorBorder; property ColorShadow; property ColorFlat; property GroupIndex; property Action; property Down; property Font; property Layout; property Margin; property ParentFont; property ParentColor; property ParentShowHint; property ShowHint; property TabStop; property TabOrder; property Spacing; property ModalResult; property Visible; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnMouseEnter; property OnMouseLeave; {$IFDEF DFS_DELPHI_4_UP} property Anchors; property BiDiMode; property Constraints; property DragKind; property ParentBiDiMode; property OnEndDock; property OnStartDock; {$ENDIF} end; TFlatDBComboBox = class(TDefineDBComboBox) published property Style; property Ticket; property TicketPosition; property TicketSpace; property DataField; property DataSource; property ReadOnly; property Items; 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 CharCase; 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 = class(TDefineDBListBox) published property ReadOnly; property DataField; property DataSource; property Items; 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 = class(TDefineDBEdit) published property Anchors; property AutoSelect; property AutoSize; property BiDiMode; property BorderStyle; property CharCase; property Color; property Constraints; property DataField; property DataSource; property ReadOnly; 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 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 = class(TDefineDBFloat) published property DataField; property DataSource; property ReadOnly; property Digits; property Precision; property FloatFormat; property EditorEnabled; property Increment; property MaxValue; property MinValue; property Value; property Alignment; property ColorFocused; property ColorBorder; property ColorFlat; property AutoSelect; property AutoSize; property DragCursor; property DragMode; property Enabled; property Font; property Ticket; property TicketPosition; property TicketSpace; property ParentColor; property ParentFont; property ParentShowHint; property ImeMode; property ImeName; property PopupMenu; property ShowHint; property TabOrder; property TabStop; 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; end; TFlatDBInteger = class (TDefineDBInteger) published property DataSource; property DataField; property ReadOnly; property Increment; property MaxValue; property MinValue; property Value; property EditorEnabled; property Alignment; property ColorFocused; property ColorBorder; property ColorFlat; property AutoSelect; property AutoSize; property DragCursor; property DragMode; property Enabled; property ImeMode; property ImeName; property Font; property Ticket; property TicketPosition; property TicketSpace; property ParentColor; property ParentFont; property ParentShowHint; property PopupMenu; property ShowHint; property TabOrder; property TabStop; 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; end; TFlatDBMaskEdit = Class(TDefineDBMask) published property DataField; property DataSource; property ReadOnly; 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 = class(TDefineDBMemo) published property ColorFocused; property ColorBorder; property ColorFlat; property ParentColor; property Version; property Align; property Alignment; property Anchors; property BiDiMode; property BorderStyle; property Color; property Constraints; property DataField; property DataSource; property ReadOnly; property AutoDisplay; property DragCursor; property DragKind; property DragMode; property Enabled; property Font; property MaxLength; property ParentBiDiMode; property ParentCtl3D; property ParentFont; property ParentShowHint; property PopupMenu; property ScrollBars; property ShowHint; property TabOrder; property TabStop; property Visible; property WantTabs; property WordWrap; 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; TFlatDBNavigator = class(TDefineDBNavigator) published property DataSource; property VISButtons; property DeleteDialog; property Hints; property BeforeAction; property OnClick; property ColorBorder; property Constraints; property Transparent; property Align; property Anchors; property Enabled; property ParentShowHint; property PopupMenu; property ShowHint; property TabOrder; property TabStop; property Visible; property Locked; property FullRepaint; property Color; property OnContextPopup; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEndDock; property OnEndDrag; property OnEnter; property OnExit; property OnResize; property OnStartDock; property OnStartDrag; end; TFlatDBRadioGroup = class(TDefineDBRadioGroup) published property Transparent; property Alignment; property ItemIndex; property Columns; property Align; property Cursor; property Caption; property Font; property ParentFont; property Color; property ParentColor; property PopupMenu; property ShowHint; property ParentShowHint; property Enabled; property Visible; property TabOrder; property TabStop; property Hint; property ColorBorder; property BackgropStartColor; property BackgropStopColor; property BackgropOrien; property StyleFace; property Border; property Anchors; property Constraints; property DragKind; property DragMode; property DragCursor; property DataField; property DataSource; property Items; property ReadOnly; property Values; property OnChange; property DockSite; property OnEndDock; property OnStartDock; property OnDockDrop; property OnDockOver; property OnUnDock; property OnClick; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnEnter; property OnExit; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnStartDrag; end; implementation uses Clipbrd, FlatCnsts; { TDefineDBBDataLink } constructor TDefineDBBDataLink.Create(ANav: TDefineDBButton); begin inherited Create; FDBBitBtn := ANav; VisualControl := True; end; destructor TDefineDBBDataLink.Destroy; begin FDBBitBtn := nil; inherited Destroy; end; procedure TDefineDBBDataLink.EditingChanged; begin if FDBBitBtn <> nil then FDBBitBtn.EditingChanged; end; procedure TDefineDBBDataLink.DataSetChanged; begin if FDBBitBtn <> nil then FDBBitBtn.DataChanged; end; procedure TDefineDBBDataLink.ActiveChanged; begin if FDBBitBtn <> nil then FDBBitBtn.ActiveChanged; end; { TDefineDBButton } var myResIDName : array[TFlatDBBName] of PChar = ('FIRST', 'PRIOR', 'NEXT', 'LAST', 'NEW', 'DELETE', 'EDIT', 'SAVE', 'CANCEL', 'REFRESH'); myBtnHintId : array[TFlatDBBName] of Pointer = (@myFirstHint, @myPriorHint, @myNextHint, @myLastHint, @myNewHint, @myDeleteHint, @myEditHint, @myPostHint, @myCancelHint, @myRefreshHint); myBtnCapId : array[TFlatDBBName] of Pointer = (@myFirstCap, @myPriorCap, @myNextCap, @myLastCap, @myNewCap, @myDeleteCap, @myEditCap, @myPostCap, @myCancelCap, @myRefreshCap); constructor TDefineDBButton.Create(AOwner: TComponent); begin inherited Create(AOwner); FDataLink := TDefineDBBDataLink.Create(self); FDBButton := vbNew; FShowDialog := True; Layout := blGlyphLeft; OnClick := ClickHandler; Enabled := False; ShowHint := True; LoadResourceData(DBButton); end; destructor TDefineDBButton.Destroy; begin FDataLink.Free; inherited Destroy; end; function TDefineDBButton.GetDataSource: TDataSource; begin result := FDataLink.DataSource; end; procedure TDefineDBButton.SetDataSource(const Value: TDataSource); begin FDataLink.DataSource := Value; if not (csLoading in ComponentState) then ActiveChanged; if Value <> nil then begin LoadResourceData(DBButton); Value.FreeNotification(Self); end; end; procedure TDefineDBButton.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if (Operation = opRemove) and (FDataLink <> nil) and (AComponent = DataSource) then DataSource := nil; end; procedure TDefineDBButton.LoadResourceData(Value:TFlatDBBName); var ResName : String; begin FmtStr(ResName, 'FLAT_%s', [myResIDName[Value]]); Glyph.LoadFromResourceName(HInstance, ResName); NumGlyphs := 2; Caption := LoadResString(myBtnCapId[Value]); Hint := LoadResString(myBtnHintId[Value]); end; procedure TDefineDBButton.SetDBButton(const Value: TFlatDBBName); begin If FDBButton <> Value then begin FDBButton := Value; LoadResourceData(Value); ActiveChanged; end; end; procedure TDefineDBButton.BtnClick(Index: TFlatDBBName); begin if (DataSource <> nil) and (DataSource.State <> dsInactive) then begin if not (csDesigning in ComponentState) and Assigned(FBeforeAction) then FBeforeAction(Self, Index); with DataSource.DataSet do begin case Index of vbFirst : First; vbPrior : Prior; vbNext : Next; vbLast : Last; vbEdit : Edit; vbCancel : Cancel; vbRefresh : Refresh; vbNew : if not FShowDialog or(ShowBox(myNewRecordQuestion, mbIYn)<>idNo) then Insert; vbSave : if not FShowDialog or(ShowBox(mySaveRecordQuestion, mbIYn)<>idNo) then Post; vbDelete : if not FShowDialog or(ShowBox(myDeleteRecordQuestion, mbIYn)<>idNo) then Delete; end; end; end; if not (csDesigning in ComponentState) and Assigned(FOnNavClick) then FOnNavClick(Self, Index); end; procedure TDefineDBButton.ClickHandler(Sender: TObject); begin BtnClick(FDBButton); end; procedure TDefineDBButton.DataChanged; var UpEnable, DnEnable, EnDelete: Boolean; begin UpEnable := FDataLink.Active and not FDataLink.DataSet.BOF; DnEnable := FDataLink.Active and not FDataLink.DataSet.EOF; EnDelete := FDataLink.Active and FDataLink.DataSet.CanModify and not (FDataLink.DataSet.BOF and FDataLink.DataSet.EOF); case FDBButton of vbFirst,vbPrior : Enabled := UpEnable; vbNext,vbLast : Enabled := DnEnable; vbDelete : Enabled := EnDelete; end; end; procedure TDefineDBButton.EditingChanged; var CanModify: Boolean; begin CanModify := FDataLink.Active and FDataLink.DataSet.CanModify; case FDBButton of vbNew,vbRefresh : Enabled := CanModify; vbEdit : Enabled := CanModify and not FDataLink.Editing; vbSave : Enabled := CanModify and FDataLink.Editing; vbCancel : Enabled := CanModify and FDataLink.Editing; end; end; procedure TDefineDBButton.ActiveChanged; begin if not FDataLink.Active then Enabled := False else begin DataChanged; EditingChanged; end; end; procedure TDefineDBButton.CMEnabledChanged(var Message: TMessage); begin inherited; if not (csLoading in ComponentState) then ActiveChanged; end; procedure TDefineDBButton.Loaded; begin inherited Loaded; ActiveChanged; end; procedure TDefineDBButton.WMGetDlgCode(var Message: TWMGetDlgCode); begin Message.Result := DLGC_WANTARROWS; end; procedure TDefineDBButton.WMKillFocus(var Message: TWMKillFocus); begin inherited; Invalidate; end; procedure TDefineDBButton.WMSetFocus(var Message: TWMSetFocus); begin inherited; Invalidate; end; procedure TDefineDBButton.SetName(const Value: TComponentName); begin inherited SetName(Value); if (csDesigning in ComponentState)and((GetTextLen = 0)or (CompareText(Caption, Name) = 0)) then LoadResourceData(FDBButton); end; { TDefineDBNavigator } constructor TDefineDBNavigator.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := ControlStyle - [csAcceptsControls, csSetCaption] + [csOpaque]; if not NewStyleControls then ControlStyle := ControlStyle + [csFramed]; FDataLink := TDefineDBNDataLink.Create(Self); FHints := TStringList.Create; TStringList(FHints).OnChange := HintsChanged; FVisibleBtns := [vbFirst,vbPrior,vbNext,vbLast,vbNew,vbDelete,vbEdit,vbSave,vbCancel,vbRefresh]; InitButtons; InitHints; ShowHint := True; Cursor := crHandPoint; Width := 241; Height := 25; ButtonWidth := 0; FocusedButton := vbFirst; FConfirmDelete := True; FullRepaint := False; end; destructor TDefineDBNavigator.Destroy; begin FDefHints.Free; FDataLink.Free; FHints.Free; FDataLink := nil; inherited Destroy; end; procedure TDefineDBNavigator.InitButtons; var I: TFlatDBBName; Btn: TDefineDBNButton; X: Integer; ResName: string; begin MinBtnSize := Point(20, 18); X := 0; for I := Low(Buttons) to High(Buttons) do begin Btn := TDefineDBNButton.Create (Self); Btn.Index := I; Btn.Visible := I in FVisibleBtns; Btn.Enabled := True; Btn.SetBounds(X, 0, MinBtnSize.X, MinBtnSize.Y); FmtStr(ResName, 'FLAT_%s', [myResIDName[I]]); Btn.Glyph.LoadFromResourceName(HInstance, ResName); Btn.NumGlyphs := 2; Btn.Enabled := False; Btn.Parent := Self; Btn.Transparent := tmAlways; Btn.OnClick := ClickHandler; Btn.OnMouseDown := BtnMouseDown; Btn.ColorBorder := ColorBorder; Buttons[I] := Btn; X := X + MinBtnSize.X; end; Buttons[vbPrior].BroStyle := Buttons[vbPrior].BroStyle + [myAllowTimer]; Buttons[vbNext].BroStyle := Buttons[vbNext].BroStyle + [myAllowTimer]; end; procedure TDefineDBNavigator.InitHints; var I: Integer; J: TFlatDBBName; begin if not Assigned(FDefHints) then begin FDefHints := TStringList.Create; for J := Low(Buttons) to High(Buttons) do FDefHints.Add(LoadResString(myBtnHintId[J])); end; for J := Low(Buttons) to High(Buttons) do Buttons[J].Hint := FDefHints[Ord(J)]; J := Low(Buttons); for I := 0 to (FHints.Count - 1) do begin if FHints.Strings[I] <> '' then Buttons[J].Hint := FHints.Strings[I]; if J = High(Buttons) then Exit; Inc(J); end; end; procedure TDefineDBNavigator.HintsChanged(Sender: TObject); begin InitHints; end; procedure TDefineDBNavigator.SetHints(Value: TStrings); begin if Value.Text = FDefHints.Text then FHints.Clear else FHints.Assign(Value); end; function TDefineDBNavigator.GetHints: TStrings; begin if (csDesigning in ComponentState) and not (csWriting in ComponentState) and not (csReading in ComponentState) and (FHints.Count = 0) then Result := FDefHints else Result := FHints; end; procedure TDefineDBNavigator.GetChildren(Proc: TGetChildProc; Root: TComponent); begin end; procedure TDefineDBNavigator.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if (Operation = opRemove) and (FDataLink <> nil) and (AComponent = DataSource) then DataSource := nil; end; procedure TDefineDBNavigator.SetVisible(Value: TFlatDBBTSet); var I: TFlatDBBName; W, H: Integer; begin W := Width; H := Height; FVisibleBtns := Value; for I := Low(Buttons) to High(Buttons) do Buttons[I].Visible := I in FVisibleBtns; SetSize(W, H); if (W <> Width) or (H <> Height) then inherited SetBounds(Left, Top, W, H); Invalidate; end; procedure TDefineDBNavigator.CalcMinSize(var W, H: Integer); var Count: Integer; I: TFlatDBBName; begin if (csLoading in ComponentState) then Exit; if Buttons[vbFirst] = nil then Exit; Count := 0; for I := Low(Buttons) to High(Buttons) do if Buttons[I].Visible then Inc(Count); if Count = 0 then Inc(Count); W := Max(W, Count * MinBtnSize.X); H := Max(H, MinBtnSize.Y); if Align = alNone then W := (W div Count) * Count; end; procedure TDefineDBNavigator.SetSize(var W: Integer; var H: Integer); var Count: Integer; I: TFlatDBBName; Space, Temp, Remain: Integer; X: Integer; begin if (csLoading in ComponentState) then Exit; if Buttons[vbFirst] = nil then Exit; CalcMinSize(W, H); Count := 0; for I := Low(Buttons) to High(Buttons) do if Buttons[I].Visible then Inc(Count); if Count = 0 then Inc(Count); ButtonWidth := W div Count; Temp := Count * ButtonWidth; if Align = alNone then W := Temp; X := 0; Remain := W - Temp; Temp := Count div 2; for I := Low(Buttons) to High(Buttons) do begin if Buttons[I].Visible then begin Space := 0; if Remain <> 0 then begin Dec(Temp, Remain); if Temp < 0 then begin Inc(Temp, Count); Space := 1; end; end; Buttons[I].SetBounds(X, 0, ButtonWidth + Space, Height); Inc(X, ButtonWidth + Space); end else Buttons[I].SetBounds(Width + 1, 0, ButtonWidth, Height); end; end; procedure TDefineDBNavigator.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); var W, H: Integer; begin W := AWidth; H := AHeight; if not HandleAllocated then SetSize(W, H); inherited SetBounds (ALeft, ATop, W, H); end; procedure TDefineDBNavigator.WMSize(var Message: TWMSize); var W, H: Integer; begin inherited; W := Width; H := Height; SetSize(W, H); end; procedure TDefineDBNavigator.WMWindowPosChanging(var Message: TWMWindowPosChanging); begin inherited; if (SWP_NOSIZE and Message.WindowPos.Flags) = 0 then CalcMinSize(Message.WindowPos.cx, Message.WindowPos.cy); end; procedure TDefineDBNavigator.ClickHandler(Sender: TObject); begin BtnClick(TDefineDBNButton(Sender).Index); end; procedure TDefineDBNavigator.BtnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var OldFocus: TFlatDBBName; begin OldFocus := FocusedButton; FocusedButton := TDefineDBNButton (Sender).Index; if TabStop and (GetFocus <> Handle) and CanFocus then begin SetFocus; if (GetFocus <> Handle) then Exit; end else if TabStop and (GetFocus = Handle) and (OldFocus <> FocusedButton) then begin Buttons[OldFocus].Invalidate; Buttons[FocusedButton].Invalidate; end; end; procedure TDefineDBNavigator.BtnClick(Index: TFlatDBBName); begin if (DataSource <> nil) and (DataSource.State <> dsInactive) then begin if not (csDesigning in ComponentState) and Assigned(FBeforeAction) then FBeforeAction(Self, Index); with DataSource.DataSet do begin case Index of vbPrior : Prior; vbNext : Next; vbFirst : First; vbLast : Last; vbNew : Insert; vbEdit : Edit; vbCancel: Cancel; vbSave : Post; vbRefresh: Refresh; vbDelete: if(not FConfirmDelete)or(ShowBox(myDeleteRecordQuestion, mbIYN)<>idCancel) then Delete; end; end; end; if not (csDesigning in ComponentState) and Assigned(FOnNavClick) then FOnNavClick(Self, Index); end; procedure TDefineDBNavigator.WMSetFocus(var Message: TWMSetFocus); begin Buttons[FocusedButton].Invalidate; end; procedure TDefineDBNavigator.WMKillFocus(var Message: TWMKillFocus); begin Buttons[FocusedButton].Invalidate; end; procedure TDefineDBNavigator.KeyDown(var Key: Word; Shift: TShiftState); var NewFocus: TFlatDBBName; OldFocus: TFlatDBBName; begin OldFocus := FocusedButton; case Key of VK_RIGHT: begin NewFocus := FocusedButton; repeat if NewFocus < High(Buttons) then NewFocus := Succ(NewFocus); until (NewFocus = High(Buttons)) or (Buttons[NewFocus].Visible); if NewFocus <> FocusedButton then begin FocusedButton := NewFocus; Buttons[OldFocus].Invalidate; Buttons[FocusedButton].Invalidate; end; end; VK_LEFT: begin NewFocus := FocusedButton; repeat if NewFocus > Low(Buttons) then NewFocus := Pred(NewFocus); until (NewFocus = Low(Buttons)) or (Buttons[NewFocus].Visible); if NewFocus <> FocusedButton then begin FocusedButton := NewFocus; Buttons[OldFocus].Invalidate; Buttons[FocusedButton].Invalidate; end; end; VK_SPACE: begin if Buttons[FocusedButton].Enabled then Buttons[FocusedButton].Click; end; end; end; procedure TDefineDBNavigator.WMGetDlgCode(var Message: TWMGetDlgCode); begin Message.Result := DLGC_WANTARROWS; end; procedure TDefineDBNavigator.DataChanged; var UpEnable, DnEnable: Boolean; begin UpEnable := Enabled and FDataLink.Active and not FDataLink.DataSet.BOF; DnEnable := Enabled and FDataLink.Active and not FDataLink.DataSet.EOF; Buttons[vbFirst].Enabled := UpEnable; Buttons[vbPrior].Enabled := UpEnable; Buttons[vbNext].Enabled := DnEnable; Buttons[vbLast].Enabled := DnEnable; Buttons[vbDelete].Enabled := Enabled and FDataLink.Active and FDataLink.DataSet.CanModify and not (FDataLink.DataSet.BOF and FDataLink.DataSet.EOF); end; procedure TDefineDBNavigator.EditingChanged; var CanModify: Boolean; begin CanModify := Enabled and FDataLink.Active and FDataLink.DataSet.CanModify; Buttons[vbNew].Enabled := CanModify; Buttons[vbEdit].Enabled := CanModify and not FDataLink.Editing; Buttons[vbSave].Enabled := CanModify and FDataLink.Editing; Buttons[vbCancel].Enabled := CanModify and FDataLink.Editing; Buttons[vbRefresh].Enabled := CanModify; end; procedure TDefineDBNavigator.ActiveChanged; var I: TFlatDBBName; begin if not (Enabled and FDataLink.Active) then for I := Low(Buttons) to High(Buttons) do Buttons[I].Enabled := False else begin DataChanged; EditingChanged; end; end; procedure TDefineDBNavigator.CMEnabledChanged(var Message: TMessage); begin inherited; if not (csLoading in ComponentState) then ActiveChanged; end; procedure TDefineDBNavigator.SetDataSource(Value: TDataSource); begin FDataLink.DataSource := Value; if not (csLoading in ComponentState) then ActiveChanged; if Value <> nil then Value.FreeNotification(Self); end; function TDefineDBNavigator.GetDataSource: TDataSource; begin Result := FDataLink.DataSource; end; procedure TDefineDBNavigator.Loaded; var W, H: Integer; begin inherited Loaded; W := Width; H := Height; SetSize(W, H); if (W <> Width) or (H <> Height) then inherited SetBounds (Left, Top, W, H); InitHints; ActiveChanged; end; procedure TDefineDBNavigator.SetColors(Index: Integer; Value: TColor); var I: TFlatDBBName; begin inherited; for I := low(Buttons) to high(Buttons) do begin Buttons[i].ColorBorder := Value; end; end; { TDefineDBNDataLink } constructor TDefineDBNDataLink.Create(ANav: TDefineDBNavigator); begin inherited Create; FBrowser := ANav; VisualControl := True; end; destructor TDefineDBNDataLink.Destroy; begin FBrowser := nil; inherited Destroy; end; procedure TDefineDBNDataLink.EditingChanged; begin if FBrowser <> nil then FBrowser.EditingChanged; end; procedure TDefineDBNDataLink.DataSetChanged; begin if FBrowser <> nil then FBrowser.DataChanged; end; procedure TDefineDBNDataLink.ActiveChanged; begin if FBrowser <> nil then FBrowser.ActiveChanged; end; {TDefineDBNButton} destructor TDefineDBNButton.Destroy; begin if FRepeatTimer <> nil then FRepeatTimer.Free; inherited Destroy; end; procedure TDefineDBNButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseDown (Button, Shift, X, Y); if myAllowTimer in FBroStyle then begin if FRepeatTimer = nil then FRepeatTimer := TTimer.Create(Self); FRepeatTimer.OnTimer := TimerExpired; FRepeatTimer.Interval := FlatInitRepeatPause; FRepeatTimer.Enabled := True; end; end; procedure TDefineDBNButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseUp (Button, Shift, X, Y); if FRepeatTimer <> nil then FRepeatTimer.Enabled := False; end; procedure TDefineDBNButton.TimerExpired(Sender: TObject); begin FRepeatTimer.Interval :=FlatRepeatPause; if (FState = bsDown) and MouseCapture then begin try Click; except FRepeatTimer.Enabled := False; raise; end; end; end; { TDefineDBComboBox } constructor TDefineDBComboBox.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := ControlStyle + [csReplicatable]; FDataLink := TFieldDataLink.Create; FDataLink.Control := Self; FDataLink.OnDataChange := DataChange; FDataLink.OnUpdateData := UpdateData; FDataLink.OnEditingChange := EditingChange; FDataLink.OnActiveChange := ActiveChange; FPaintControl := TPaintControl.Create(Self, 'COMBOBOX'); end; destructor TDefineDBComboBox.Destroy; begin FPaintControl.Free; FDataLink.Free; FDataLink := nil; inherited Destroy; end; procedure TDefineDBComboBox.Loaded; begin inherited Loaded; ResetMaxLength; if(csDesigning in ComponentState) then DataChange(Self); end; procedure TDefineDBComboBox.ActiveChange(Sender: TObject); begin ResetMaxLength; end; procedure TDefineDBComboBox.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if(Operation = opRemove) and(FDataLink <> nil) and (AComponent = DataSource) then DataSource := nil; end; procedure TDefineDBComboBox.CreateWnd; begin inherited CreateWnd; SetEditReadOnly; end; procedure TDefineDBComboBox.ResetMaxLength; var F: TField; begin if (MaxLength > 0) and Assigned(DataSource) and Assigned(DataSource.DataSet) then begin F := DataSource.DataSet.FindField(DataField); if Assigned(F) and (F.DataType in [ftString, ftWideString]) and (F.Size = MaxLength) then MaxLength := 0; end; end; procedure TDefineDBComboBox.DataChange(Sender: TObject); begin if not(Style = csSimple) and DroppedDown then Exit; if not (csDesigning in ComponentState) then begin if (FDataLink.Field.DataType in [ftString, ftWideString]) and (MaxLength = 0) then MaxLength := FDataLink.Field.Size; end; if FDataLink.Field <> nil then SetComboText(FDataLink.Field.Text) else if csDesigning in ComponentState then begin if DataField <> '' then SetComBoText(DataField) else SetComboText(Name); end else SetComboText(''); end; procedure TDefineDBComboBox.UpdateData(Sender: TObject); begin FDataLink.Field.Text := GetComboText; end; procedure TDefineDBComboBox.SetComboText(const Value: string); var I: Integer; Redraw: Boolean; begin if Value <> GetComboText then begin if Style <> csDropDown then begin Redraw :=(Style <> csSimple) and HandleAllocated; if Redraw then SendMessage(Handle, WM_SETREDRAW, 0, 0); try if Value = '' then I := -1 else I := Items.IndexOf(Value); ItemIndex := I; finally if Redraw then begin SendMessage(Handle, WM_SETREDRAW, 1, 0); Invalidate; end; end; if I >= 0 then Exit; end; if Style in [csDropDown, csSimple] then Text := Value; end; end; function TDefineDBComboBox.GetComboText: string; var I: Integer; begin if Style in [csDropDown, csSimple] then Result := Text else begin I := ItemIndex; if I < 0 then Result := '' else Result := Items[I]; end; end; procedure TDefineDBComboBox.Change; begin FDataLink.Edit; inherited Change; FDataLink.Modified; end; procedure TDefineDBComboBox.Click; begin FDataLink.Edit; inherited Click; FDataLink.Modified; end; procedure TDefineDBComboBox.DropDown; begin inherited DropDown; end; function TDefineDBComboBox.GetDataSource: TDataSource; begin Result := FDataLink.DataSource; end; procedure TDefineDBComboBox.SetDataSource(Value: TDataSource); begin if not(FDataLink.DataSourceFixed and(csLoading in ComponentState)) then FDataLink.DataSource := Value; if Value <> nil then Value.FreeNotification(Self); end; function TDefineDBComboBox.GetDataField: string; begin Result := FDataLink.FieldName; end; procedure TDefineDBComboBox.SetDataField(const Value: string); begin if not (csDesigning in ComponentState) then ResetMaxLength; FDataLink.FieldName := Value; end; function TDefineDBComboBox.GetReadOnly: Boolean; begin Result := FDataLink.ReadOnly; end; procedure TDefineDBComboBox.SetReadOnly(Value: Boolean); begin FDataLink.ReadOnly := Value; end; function TDefineDBComboBox.GetField: TField; begin Result := FDataLink.Field; end; procedure TDefineDBComboBox.KeyDown(var Key: Word; Shift: TShiftState); begin inherited KeyDown(Key, Shift); if Key in [VK_BACK, VK_DELETE, VK_UP, VK_DOWN, 32..255] then begin if not FDataLink.Edit and(Key in [VK_UP, VK_DOWN]) then Key := 0; end; end; procedure TDefineDBComboBox.KeyPress(var Key: Char); begin inherited KeyPress(Key); if(Key in [#32..#255]) and(FDataLink.Field <> nil) and not FDataLink.Field.IsValidChar(Key) then begin MessageBeep(0); Key := #0; end; case Key of ^H, ^V, ^X, #32..#255: FDataLink.Edit; #27: begin FDataLink.Reset; SelectAll; end; end; end; procedure TDefineDBComboBox.EditingChange(Sender: TObject); begin SetEditReadOnly; end; procedure TDefineDBComboBox.SetEditReadOnly; begin if(Style in [csDropDown, csSimple]) and HandleAllocated then SendMessage(EditHandle, EM_SETREADONLY, Ord(not FDataLink.Editing), 0); end; procedure TDefineDBComboBox.WndProc(var Message: TMessage); begin if not(csDesigning in ComponentState) then case Message.Msg of WM_COMMAND: if TWMCommand(Message).NotifyCode = CBN_SELCHANGE then if not FDataLink.Edit then begin if Style <> csSimple then PostMessage(Handle, CB_SHOWDROPDOWN, 0, 0); Exit; end; CB_SHOWDROPDOWN: if Message.WParam <> 0 then FDataLink.Edit else if not FDataLink.Editing then DataChange(Self); {Restore text} WM_CREATE, WM_WINDOWPOSCHANGED, CM_FONTCHANGED: FPaintControl.DestroyHandle; end; inherited WndProc(Message); end; procedure TDefineDBComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer); begin if not(csDesigning in ComponentState) then case Message.Msg of WM_LBUTTONDOWN: if(Style = csSimple) and(ComboWnd <> EditHandle) then if not FDataLink.Edit then Exit; end; inherited ComboWndProc(Message, ComboWnd, ComboProc); end; procedure TDefineDBComboBox.CMEnter(var Message: TCMEnter); begin inherited; if SysLocale.FarEast and FDataLink.CanModify then SendMessage(EditHandle, EM_SETREADONLY, Ord(False), 0); end; procedure TDefineDBComboBox.CMExit(var Message: TCMExit); begin try FDataLink.UpdateRecord; except SelectAll; SetFocus; raise; end; inherited; end; procedure TDefineDBComboBox.WMPaint(var Message: TWMPaint); var S: string; R: TRect; P: TPoint; Child: HWND; begin if csPaintCopy in ControlState then begin if FDataLink.Field <> nil then S := FDataLink.Field.Text else S := ''; if Style = csDropDown then begin SendMessage(FPaintControl.Handle, WM_SETTEXT, 0, Longint(PChar(S))); SendMessage(FPaintControl.Handle, WM_PAINT, Message.DC, 0); Child := GetWindow(FPaintControl.Handle, GW_CHILD); if Child <> 0 then begin Windows.GetClientRect(Child, R); Windows.MapWindowPoints(Child, FPaintControl.Handle, R.TopLeft, 2); GetWindowOrgEx(Message.DC, P); SetWindowOrgEx(Message.DC, P.X - R.Left, P.Y - R.Top, nil); IntersectClipRect(Message.DC, 0, 0, R.Right - R.Left, R.Bottom - R.Top); SendMessage(Child, WM_PAINT, Message.DC, 0); end; end else begin SendMessage(FPaintControl.Handle, CB_RESETCONTENT, 0, 0); if Items.IndexOf(S) <> -1 then begin SendMessage(FPaintControl.Handle, CB_ADDSTRING, 0, Longint(PChar(S))); SendMessage(FPaintControl.Handle, CB_SETCURSEL, 0, 0); end; SendMessage(FPaintControl.Handle, WM_PAINT, Message.DC, 0); end; end else inherited; end; procedure TDefineDBComboBox.SetItems(const Value: TStrings); begin inherited SetItems(Value); DataChange(Self); end; procedure TDefineDBComboBox.SetStyle(Value: TComboboxStyle); begin if(Value = csSimple) and Assigned(FDatalink) and FDatalink.DatasourceFixed then DatabaseError(SNotReplicatable); inherited SetStyle(Value); end; function TDefineDBComboBox.UseRightToLeftAlignment: Boolean; begin Result := DBUseRightToLeftAlignment(Self, Field); end; procedure TDefineDBComboBox.CMGetDatalink(var Message: TMessage); begin Message.Result := Integer(FDataLink); end; function TDefineDBComboBox.ExecuteAction(Action: TBasicAction): Boolean; begin Result := inherited ExecuteAction(Action) or(FDataLink <> nil) and FDataLink.ExecuteAction(Action); end; function TDefineDBComboBox.UpdateAction(Action: TBasicAction): Boolean; begin Result := inherited UpdateAction(Action) or(FDataLink <> nil) and FDataLink.UpdateAction(Action); end; { TDefineDBListBox } constructor TDefineDBListBox.Create(AOwner: TComponent); begin inherited Create(AOwner); FDataLink := TFieldDataLink.Create; FDataLink.Control := Self; FDataLink.OnDataChange := DataChange; FDataLink.OnUpdateData := UpdateData; end; destructor TDefineDBListBox.Destroy; begin FDataLink.Free; FDataLink := nil; inherited Destroy; end; procedure TDefineDBListBox.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if(Operation = opRemove) and(FDataLink <> nil) and (AComponent = DataSource) then DataSource := nil; end; function TDefineDBListBox.UseRightToLeftAlignment: Boolean; begin Result := DBUseRightToLeftAlignment(Self, Field); end; procedure TDefineDBListBox.DataChange(Sender: TObject); begin if FDataLink.Field <> nil then ItemIndex := Items.IndexOf(FDataLink.Field.Text) else ItemIndex := -1; end; procedure TDefineDBListBox.UpdateData(Sender: TObject); begin if ItemIndex >= 0 then FDataLink.Field.Text := Items[ItemIndex] else FDataLink.Field.Text := ''; end; procedure TDefineDBListBox.Click; begin if FDataLink.Edit then begin inherited Click; FDataLink.Modified; end; end; function TDefineDBListBox.GetDataSource: TDataSource; begin Result := FDataLink.DataSource; end; procedure TDefineDBListBox.SetDataSource(Value: TDataSource); begin FDataLink.DataSource := Value; if Value <> nil then Value.FreeNotification(Self); end; function TDefineDBListBox.GetDataField: string; begin Result := FDataLink.FieldName; end; procedure TDefineDBListBox.SetDataField(const Value: string); begin FDataLink.FieldName := Value; end; function TDefineDBListBox.GetReadOnly: Boolean; begin Result := FDataLink.ReadOnly; end; procedure TDefineDBListBox.SetReadOnly(Value: Boolean); begin FDataLink.ReadOnly := Value; end; function TDefineDBListBox.GetField: TField; begin Result := FDataLink.Field; end; procedure TDefineDBListBox.KeyDown(var Key: Word; Shift: TShiftState); begin inherited KeyDown(Key, Shift); if Key in [VK_PRIOR, VK_NEXT, VK_END, VK_HOME, VK_LEFT, VK_UP, VK_RIGHT, VK_DOWN] then if not FDataLink.Edit then Key := 0; end; procedure TDefineDBListBox.KeyPress(var Key: Char); begin inherited KeyPress(Key); case Key of #32..#255: if not FDataLink.Edit then Key := #0; #27: FDataLink.Reset; end; end; procedure TDefineDBListBox.WMLButtonDown(var Message: TWMLButtonDown); begin if FDataLink.Edit then inherited else begin Self.SetFocus; with Message do MouseDown(mbLeft, KeysToShiftState(Keys), XPos, YPos); end; end; procedure TDefineDBListBox.CMExit(var Message: TCMExit); begin try if IndexInCount(ItemIndex, Items.Count) then FDataLink.UpdateRecord; except Self.SetFocus; raise; end; inherited; end; procedure TDefineDBListBox.SetItems(Value: TStringList); begin Items.Assign(Value); DataChange(Self); end; function TDefineDBListBox.ExecuteAction(Action: TBasicAction): Boolean; begin Result := inherited ExecuteAction(Action) or(FDataLink <> nil) and FDataLink.ExecuteAction(Action); end; function TDefineDBListBox.UpdateAction(Action: TBasicAction): Boolean; begin Result := inherited UpdateAction(Action) or(FDataLink <> nil) and FDataLink.UpdateAction(Action); end; { TDefineDBEdit } procedure TDefineDBEdit.ResetMaxLength; var F: TField; begin if (MaxLength > 0) and Assigned(DataSource) and Assigned(DataSource.DataSet) then begin F := DataSource.DataSet.FindField(DataField); if Assigned(F) and (F.DataType in [ftString, ftWideString]) and (F.Size = MaxLength) then MaxLength := 0; end; end; constructor TDefineDBEdit.Create(AOwner: TComponent); begin inherited Create(AOwner); inherited ReadOnly := True; ControlStyle := ControlStyle + [csReplicatable]; FDataLink := TFieldDataLink.Create; FDataLink.Control := Self; FDataLink.OnDataChange := DataChange; FDataLink.OnEditingChange := EditingChange; FDataLink.OnUpdateData := UpdateData; FDataLink.OnActiveChange := ActiveChange; end; destructor TDefineDBEdit.Destroy; begin FDataLink.Free; FDataLink := nil; FCanvas.Free; inherited Destroy; end; procedure TDefineDBEdit.Loaded; begin inherited Loaded; ResetMaxLength; if (csDesigning in ComponentState) then DataChange(Self); end; procedure TDefineDBEdit.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if (Operation = opRemove) and (FDataLink <> nil) and (AComponent = DataSource) then DataSource := nil; end; function TDefineDBEdit.UseRightToLeftAlignment: Boolean; begin Result := DBUseRightToLeftAlignment(Self, Field); end; procedure TDefineDBEdit.KeyDown(var Key: Word; Shift: TShiftState); begin inherited KeyDown(Key, Shift); if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then FDataLink.Edit; end; procedure TDefineDBEdit.KeyPress(var Key: Char); begin inherited KeyPress(Key); if (Key in [#32..#255]) and (FDataLink.Field <> nil) and not FDataLink.Field.IsValidChar(Key) then begin MessageBeep(0); Key := #0; end; case Key of ^H, ^V, ^X, #32..#255: FDataLink.Edit; #27: begin FDataLink.Reset; SelectAll; Key := #0; end; end; end; procedure TDefineDBEdit.SetFocused(Value: Boolean); begin if FFocused <> Value then begin FFocused := Value; if (FAlignment <> taLeftJustify) then Invalidate; FDataLink.Reset; end; end; procedure TDefineDBEdit.Change; begin FDataLink.Modified; inherited Change; end; function TDefineDBEdit.GetDataSource: TDataSource; begin Result := FDataLink.DataSource; end; procedure TDefineDBEdit.SetDataSource(Value: TDataSource); begin if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then FDataLink.DataSource := Value; if Value <> nil then Value.FreeNotification(Self); end; function TDefineDBEdit.GetDataField: string; begin Result := FDataLink.FieldName; end; procedure TDefineDBEdit.SetDataField(const Value: string); begin if not (csDesigning in ComponentState) then ResetMaxLength; FDataLink.FieldName := Value; end; function TDefineDBEdit.GetReadOnly: Boolean; begin Result := FDataLink.ReadOnly; end; procedure TDefineDBEdit.SetReadOnly(Value: Boolean); begin FDataLink.ReadOnly := Value; end; function TDefineDBEdit.GetField: TField; begin Result := FDataLink.Field; end; procedure TDefineDBEdit.ActiveChange(Sender: TObject); begin ResetMaxLength; end; procedure TDefineDBEdit.DataChange(Sender: TObject); begin if FDataLink.Field <> nil then begin if FAlignment <> FDataLink.Field.Alignment then begin Text := ''; {forces update} FAlignment := FDataLink.Field.Alignment; end; if not (csDesigning in ComponentState) then begin if (FDataLink.Field.DataType in [ftString, ftWideString]) and (MaxLength = 0) then MaxLength := FDataLink.Field.Size; end; if FFocused and FDataLink.CanModify then Text := FDataLink.Field.Text else begin Text := FDataLink.Field.DisplayText; if FDataLink.Editing then Modified := True; end; end else begin FAlignment := taLeftJustify; if csDesigning in ComponentState then begin if DataField <> '' then Text := DataField else Text := Name; end else Text := ''; end; end; procedure TDefineDBEdit.EditingChange(Sender: TObject); begin inherited ReadOnly := not FDataLink.Editing; end; procedure TDefineDBEdit.UpdateData(Sender: TObject); begin FDataLink.Field.Text := Text; end; procedure TDefineDBEdit.WMUndo(var Message: TMessage); begin FDataLink.Edit; inherited; end; procedure TDefineDBEdit.WMPaste(var Message: TMessage); begin FDataLink.Edit; inherited; end; procedure TDefineDBEdit.WMCut(var Message: TMessage); begin FDataLink.Edit; inherited; end; procedure TDefineDBEdit.CMEnter(var Message: TCMEnter); begin SetFocused(True); inherited; if SysLocale.FarEast and FDataLink.CanModify then inherited ReadOnly := False; end; procedure TDefineDBEdit.CMExit(var Message: TCMExit); begin try FDataLink.UpdateRecord; except SelectAll; SetFocus; raise; end; SetFocused(False); DoExit; end; procedure TDefineDBEdit.WMPaint(var Message: TWMPaint); const AlignStyle : array[Boolean, TAlignment] of DWORD = ((WS_EX_LEFT, WS_EX_RIGHT, WS_EX_LEFT), (WS_EX_RIGHT, WS_EX_LEFT, WS_EX_LEFT)); var Left: Integer; Margins: TPoint; R: TRect; DC: HDC; PS: TPaintStruct; S: string; AAlignment: TAlignment; ExStyle: DWORD; begin AAlignment := FAlignment; if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment); if ((AAlignment = taLeftJustify) or FFocused) and not (csPaintCopy in ControlState) then begin if SysLocale.MiddleEast and HandleAllocated and (IsRightToLeft) then begin { This keeps the right aligned text, right aligned } ExStyle := DWORD(GetWindowLong(Handle, GWL_EXSTYLE)) and (not WS_EX_RIGHT) and (not WS_EX_RTLREADING) and (not WS_EX_LEFTSCROLLBAR); if UseRightToLeftReading then ExStyle := ExStyle or WS_EX_RTLREADING; if UseRightToLeftScrollbar then ExStyle := ExStyle or WS_EX_LEFTSCROLLBAR; ExStyle := ExStyle or AlignStyle[UseRightToLeftAlignment, AAlignment]; if DWORD(GetWindowLong(Handle, GWL_EXSTYLE)) <> ExStyle then SetWindowLong(Handle, GWL_EXSTYLE, ExStyle); end; inherited; Exit; end; { Since edit controls do not handle justification unless multi-line (and then only poorly) we will draw right and center justify manually unless the edit has the focus. } if FCanvas = nil then begin FCanvas := TControlCanvas.Create; FCanvas.Control := Self; end; DC := Message.DC; if DC = 0 then DC := BeginPaint(Handle, PS); FCanvas.Handle := DC; try FCanvas.Font := Font; with FCanvas do begin R := ClientRect; if not (NewStyleControls and Ctl3D) and (BorderStyle = bsSingle) then begin Brush.Color := clWindowFrame; FrameRect(R); InflateRect(R, -1, -1); end; Brush.Color := Color; if not Enabled then Font.Color := clGrayText; if (csPaintCopy in ControlState) and (FDataLink.Field <> nil) then begin S := FDataLink.Field.DisplayText; case CharCase of ecUpperCase: S := AnsiUpperCase(S); ecLowerCase: S := AnsiLowerCase(S); end; end else S := Text; if PasswordChar <> #0 then FillChar(S[1], Length(S), PasswordChar); Margins := GetTextMargins; case AAlignment of taLeftJustify: Left := Margins.X; taRightJustify: Left := ClientWidth - TextWidth(S) - Margins.X - 1; else Left := (ClientWidth - TextWidth(S)) div 2; end; if SysLocale.MiddleEast then UpdateTextFlags; TextRect(R, Left, Margins.Y, S); end; finally FCanvas.Handle := 0; if Message.DC = 0 then EndPaint(Handle, PS); end; end; procedure TDefineDBEdit.CMGetDataLink(var Message: TMessage); begin // Message.Result := Integer(FDataLink); Message.Result := SizeOf(FDataLink); end; function TDefineDBEdit.GetTextMargins: TPoint; var DC: HDC; SaveFont: HFont; I: Integer; SysMetrics, Metrics: TTextMetric; begin if NewStyleControls then begin if BorderStyle = bsNone then I := 0 else if Ctl3D then I := 1 else I := 2; Result.X := SendMessage(Handle, EM_GETMARGINS, 0, 0) and $0000FFFF + I; Result.Y := I; end else begin if BorderStyle = bsNone then I := 0 else begin DC := GetDC(0); GetTextMetrics(DC, SysMetrics); SaveFont := SelectObject(DC, Font.Handle); GetTextMetrics(DC, Metrics); SelectObject(DC, SaveFont); ReleaseDC(0, DC); I := SysMetrics.tmHeight; if I > Metrics.tmHeight then I := Metrics.tmHeight; I := I div 4; end; Result.X := I; Result.Y := I; end; end; function TDefineDBEdit.ExecuteAction(Action: TBasicAction): Boolean; begin Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and FDataLink.ExecuteAction(Action); end; function TDefineDBEdit.UpdateAction(Action: TBasicAction): Boolean; begin Result := inherited UpdateAction(Action) or (FDataLink <> nil) and FDataLink.UpdateAction(Action); end; { TDefineDBFloat } procedure TDefineDBFloat.EditingChange(Sender: TObject); begin inherited ReadOnly := not FDataLink.Editing; end; function TDefineDBFloat.GetDataSource: TDataSource; begin Result := FDataLink.DataSource; end; procedure TDefineDBFloat.SetDataSource(Value: TDataSource); begin if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then FDataLink.DataSource := Value; if Value <> nil then Value.FreeNotification(Self); Enabled := FDataLink.Active and (FDataLink.Field <> nil) and not FDataLink.Field.ReadOnly ; end; function TDefineDBFloat.GetField: TField; begin Result := FDataLink.Field; end; function TDefineDBFloat.GetDataField: string; begin Result := FDataLink.FieldName; end; procedure TDefineDBFloat.SetDataField(const Value: string); begin FDataLink.FieldName := Value; end; constructor TDefineDBFloat.Create(AOwner: TComponent); begin inherited Create(AOwner); FDataLink := TFieldDataLink.Create; FDataLink.Control := Self; FDataLink.OnDataChange := DataChange; FDataLink.OnEditingChange := EditingChange; FDataLink.OnUpdateData := UpdateData; FDataLink.OnActiveChange := ActiveChange; end; destructor TDefineDBFloat.Destroy; begin FDataLink.Free; FDataLink := nil; inherited Destroy; end; procedure TDefineDBFloat.DataChange(sender : TObject); begin if (FDataLink.Field <> nil) and ((FDataLink.Field is TFloatField) or (FDataLink.Field is TCurrencyField)) then value := FDataLink.Field.AsFloat else value := 0.00; end; procedure TDefineDBFloat.UpdateData(sender : TObject); begin if (FDataLink.Field <> nil) and ((FDataLink.Field is TFloatField) or (FDataLink.Field is TCurrencyField)) then FDataLink.Field.AsFloat := value ; end; procedure TDefineDBFloat.ActiveChange(sender : TObject); begin Enabled := FDataLink.Active and (FDataLink.Field <> nil); end; procedure TDefineDBFloat.CMExit(var Message:TCMExit); begin try FDataLink.UpdateRecord; except SelectAll; SetFocus; raise; end; inherited; end; procedure TDefineDBFloat.KeyDown(var Key: Word; Shift: TShiftState); begin inherited KeyDown(Key, Shift); if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then FDataLink.Edit; end; procedure TDefineDBFloat.KeyPress(var Key: Char); begin inherited KeyPress(Key); if (Key in [#32..#255]) and (FDataLink.Field <> nil) and not FDataLink.Field.IsValidChar(Key) then begin MessageBeep(0); Key := #0; end; case Key of {^H, ^V, ^X,} #48..#57: FDataLink.Edit; #27: //esc取消 begin FDataLink.Reset; SelectAll; Key := #0; end; end; end; procedure TDefineDBFloat.Change; begin if FDataLink <> nil then FDataLink.Modified; inherited Change; end; procedure TDefineDBFloat.DownClick (Sender: TObject); begin inherited DownClick (Sender); FDataLink.Edit; end; procedure TDefineDBFloat.UpClick (Sender: TObject); begin inherited UpClick (Sender); FDataLink.Edit; end; function TDefineDBFloat.GetReadOnly: Boolean; begin Result := FDataLink.ReadOnly; inherited ReadOnly := Result; end; procedure TDefineDBFloat.SetReadOnly(const Value: Boolean); begin FDataLink.ReadOnly := Value; inherited ReadOnly := Value; end; { TDefineDBInteger } function TDefineDBInteger.GetDataField : String; begin Result := FDataLink.FieldName; end; function TDefineDBInteger.GetDataSource : TDataSource; begin Result := FDataLink.DataSource; end; function TDefineDBInteger.GetReadOnly : Boolean; begin Result := FDataLink.ReadOnly; inherited ReadOnly := Result; end; procedure TDefineDBInteger.SetReadOnly (aValue : Boolean); begin FDataLink.ReadOnly := aValue; inherited ReadOnly := aValue; end; procedure TDefineDBInteger.SetDataSource (aValue : TDataSource); begin FDataLink.DataSource := aValue; if aValue <> nil then aValue.FreeNotification(Self); end; procedure TDefineDBInteger.SetDataField (const aValue : String); begin FDataLink.FieldName := aValue; end; procedure TDefineDBInteger.DataChange (Sender : TObject); begin if FDataLink.Field <> nil then begin if not (csDesigning in ComponentState) then begin if (FDataLink.Field.DataType = ftInteger) and (MaxLength = 0) then MaxLength := FDataLink.Field.Size; end; if {FFocused and} FDataLink.CanModify then begin Value := FDataLink.Field.AsInteger; end else begin Value := FDataLink.Field.AsInteger; end; end end; procedure TDefineDBInteger.UpdateData(Sender: TObject); begin FDataLink.Field.AsInteger := Value; { Value, Text } end; procedure TDefineDBInteger.EditingChange(Sender: TObject); begin inherited ReadOnly := not FDataLink.Editing; end; procedure TDefineDBInteger.WMPaste(var Message: TMessage); begin FDataLink.Edit; inherited; end; procedure TDefineDBInteger.WMCut(var Message: TMessage); begin FDataLink.Edit; inherited; end; procedure TDefineDBInteger.Change; begin if FDataLink <> nil then FDataLink.Modified; inherited Change; end; procedure TDefineDBInteger.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if (Operation = opRemove) and (FDataLink <> nil) and (AComponent = DataSource) then DataSource := nil; end; procedure TDefineDBInteger.CMGetDataLink(var Message: TMessage); begin Message.Result := Integer(FDataLink); end; procedure TDefineDBInteger.CMExit(var Message: TCMExit); begin try FDataLink.UpdateRecord; except SelectAll; SetFocus; raise; end; end; procedure TDefineDBInteger.KeyDown(var Key: Word; Shift: TShiftState); begin inherited KeyDown(Key, Shift); if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then FDataLink.Edit; end; procedure TDefineDBInteger.KeyPress(var Key: Char); begin inherited KeyPress(Key); if (Key in [#32..#255]) and (FDataLink.Field <> nil) and not FDataLink.Field.IsValidChar(Key) then begin MessageBeep(0); Key := #0; end; case Key of {^H, ^V, ^X,} #48..#57: FDataLink.Edit; #27: begin FDataLink.Reset; SelectAll; Key := #0; end; end; end; procedure TDefineDBInteger.DownClick (Sender: TObject); begin inherited DownClick (Sender); FDataLink.Edit; end; procedure TDefineDBInteger.UpClick (Sender: TObject); begin inherited UpClick (Sender); FDataLink.Edit; end; constructor TDefineDBInteger.Create(AOwner: TComponent); begin inherited Create(AOwner); inherited ReadOnly := True; ControlStyle:=ControlStyle-[csReplicatable]; FDataLink := TFieldDataLink.Create; FDataLink.Control := Self; FDataLink.OnDataChange := DataChange; FDataLink.OnEditingChange := EditingChange; FDataLink.OnUpdateData := UpdateData; end; destructor TDefineDBInteger.Destroy; begin FDataLink.Free; FDataLink := nil; inherited Destroy; end; function TDefineDBInteger.GetField: TField; begin result := FDataLink.Field; end; { TDefineDBMask } procedure TDefineDBMask.ActiveChange(Sender: TObject); begin ResetMaxLength; end; procedure TDefineDBMask.Change; begin FDataLink.Modified; inherited Change; end; procedure TDefineDBMask.CMEnter(var Message: TCMEnter); begin SetFocused(True); inherited; if SysLocale.FarEast and FDataLink.CanModify then inherited ReadOnly := False; end; procedure TDefineDBMask.CMExit(var Message: TCMExit); begin try FDataLink.UpdateRecord; except SelectAll; SetFocus; raise; end; SetFocused(False); DoExit; end; procedure TDefineDBMask.CMGetDataLink(var Message: TMessage); begin Message.Result := SizeOf(FDataLink); end; constructor TDefineDBMask.Create(AOwner: TComponent); begin inherited Create(AOwner); inherited ReadOnly := True; ControlStyle := ControlStyle + [csReplicatable]; FDataLink := TFieldDataLink.Create; FDataLink.Control := Self; FDataLink.OnDataChange := DataChange; FDataLink.OnEditingChange := EditingChange; FDataLink.OnUpdateData := UpdateData; FDataLink.OnActiveChange := ActiveChange; end; procedure TDefineDBMask.DataChange(Sender: TObject); begin if FDataLink.Field <> nil then begin if FAlignment <> FDataLink.Field.Alignment then begin Text := ''; {forces update} FAlignment := FDataLink.Field.Alignment; end; if not (csDesigning in ComponentState) then begin if (FDataLink.Field.DataType in [ftString, ftWideString]) and (MaxLength = 0) then MaxLength := FDataLink.Field.Size; end; if FFocused and FDataLink.CanModify then Text := FDataLink.Field.Text else begin Text := FDataLink.Field.DisplayText; if FDataLink.Editing then Modified := True; end; end else begin FAlignment := taLeftJustify; if csDesigning in ComponentState then Text := Name else Text := ''; end; end; destructor TDefineDBMask.Destroy; begin FDataLink.Free; FDataLink := nil; FCanvas.Free; inherited Destroy; end; procedure TDefineDBMask.EditingChange(Sender: TObject); begin inherited ReadOnly := not FDataLink.Editing; end; function TDefineDBMask.ExecuteAction(Action: TBasicAction): Boolean; begin Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and FDataLink.ExecuteAction(Action); end; function TDefineDBMask.GetDataField: string; begin Result := FDataLink.FieldName; end; function TDefineDBMask.GetDataSource: TDataSource; begin Result := FDataLink.DataSource; end; function TDefineDBMask.GetField: TField; begin Result := FDataLink.Field; end; function TDefineDBMask.GetReadOnly: Boolean; begin Result := FDataLink.ReadOnly; end; function TDefineDBMask.GetTextMargins: TPoint; var DC: HDC; SaveFont: HFont; I: Integer; SysMetrics, Metrics: TTextMetric; begin if NewStyleControls then begin if BorderStyle = bsNone then I := 0 else if Ctl3D then I := 1 else I := 2; Result.X := SendMessage(Handle, EM_GETMARGINS, 0, 0) and $0000FFFF + I; Result.Y := I; end else begin if BorderStyle = bsNone then I := 0 else begin DC := GetDC(0); GetTextMetrics(DC, SysMetrics); SaveFont := SelectObject(DC, Font.Handle); GetTextMetrics(DC, Metrics); SelectObject(DC, SaveFont); ReleaseDC(0, DC); I := SysMetrics.tmHeight; if I > Metrics.tmHeight then I := Metrics.tmHeight; I := I div 4; end; Result.X := I; Result.Y := I; end; end; procedure TDefineDBMask.KeyDown(var Key: Word; Shift: TShiftState); begin inherited KeyDown(Key, Shift); if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then FDataLink.Edit; end; procedure TDefineDBMask.KeyPress(var Key: Char); begin inherited KeyPress(Key); if (Key in [#32..#255]) and (FDataLink.Field <> nil) and not FDataLink.Field.IsValidChar(Key) then begin MessageBeep(0); Key := #0; end; case Key of ^H, ^V, ^X, #32..#255: FDataLink.Edit; #27: begin FDataLink.Reset; SelectAll; Key := #0; end; end; end; procedure TDefineDBMask.Loaded; begin inherited Loaded; ResetMaxLength; if (csDesigning in ComponentState) then DataChange(Self); end; procedure TDefineDBMask.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if (Operation = opRemove) and (FDataLink <> nil) and (AComponent = DataSource) then DataSource := nil; end; procedure TDefineDBMask.ResetMaxLength; var F: TField; begin if (MaxLength > 0) and Assigned(DataSource) and Assigned(DataSource.DataSet) then begin F := DataSource.DataSet.FindField(DataField); if Assigned(F) and (F.DataType in [ftString, ftWideString]) and (F.Size = MaxLength) then MaxLength := 0; end; end; procedure TDefineDBMask.SetDataField(const Value: string); begin if not (csDesigning in ComponentState) then ResetMaxLength; FDataLink.FieldName := Value; end; procedure TDefineDBMask.SetDataSource(const Value: TDataSource); begin if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then FDataLink.DataSource := Value; if Value <> nil then Value.FreeNotification(Self); end; procedure TDefineDBMask.SetFocused(Value: Boolean); begin if FFocused <> Value then begin FFocused := Value; if (FAlignment <> taLeftJustify) then Invalidate; FDataLink.Reset; end; end; procedure TDefineDBMask.SetReadOnly(const Value: Boolean); begin FDataLink.ReadOnly := Value; end; function TDefineDBMask.UpdateAction(Action: TBasicAction): Boolean; begin Result := inherited UpdateAction(Action) or (FDataLink <> nil) and FDataLink.UpdateAction(Action); end; procedure TDefineDBMask.UpdateData(Sender: TObject); begin FDataLink.Field.Text := Text; end; function TDefineDBMask.UseRightToLeftAlignment: Boolean; begin Result := DBUseRightToLeftAlignment(Self, Field); end; procedure TDefineDBMask.WMCut(var Message: TMessage); begin FDataLink.Edit; inherited; end; procedure TDefineDBMask.WMPaint(var Message: TWMPaint); const AlignStyle : array[Boolean, TAlignment] of DWORD = ((WS_EX_LEFT, WS_EX_RIGHT, WS_EX_LEFT), (WS_EX_RIGHT, WS_EX_LEFT, WS_EX_LEFT)); var Left: Integer; Margins: TPoint; R: TRect; DC: HDC; PS: TPaintStruct; S: string; AAlignment: TAlignment; ExStyle: DWORD; begin AAlignment := FAlignment; if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment); if ((AAlignment = taLeftJustify) or FFocused) and not (csPaintCopy in ControlState) then begin if SysLocale.MiddleEast and HandleAllocated and (IsRightToLeft) then begin { This keeps the right aligned text, right aligned } ExStyle := DWORD(GetWindowLong(Handle, GWL_EXSTYLE)) and (not WS_EX_RIGHT) and (not WS_EX_RTLREADING) and (not WS_EX_LEFTSCROLLBAR); if UseRightToLeftReading then ExStyle := ExStyle or WS_EX_RTLREADING; if UseRightToLeftScrollbar then ExStyle := ExStyle or WS_EX_LEFTSCROLLBAR; ExStyle := ExStyle or AlignStyle[UseRightToLeftAlignment, AAlignment]; if DWORD(GetWindowLong(Handle, GWL_EXSTYLE)) <> ExStyle then SetWindowLong(Handle, GWL_EXSTYLE, ExStyle); end; inherited; Exit; end; { Since edit controls do not handle justification unless multi-line (and then only poorly) we will draw right and center justify manually unless the edit has the focus. } if FCanvas = nil then begin FCanvas := TControlCanvas.Create; FCanvas.Control := Self; end; DC := Message.DC; if DC = 0 then DC := BeginPaint(Handle, PS); FCanvas.Handle := DC; try FCanvas.Font := Font; with FCanvas do begin R := ClientRect; if not (NewStyleControls and Ctl3D) and (BorderStyle = bsSingle) then begin Brush.Color := clWindowFrame; FrameRect(R); InflateRect(R, -1, -1); end; Brush.Color := Color; if not Enabled then Font.Color := clGrayText; if (csPaintCopy in ControlState) and (FDataLink.Field <> nil) then begin S := FDataLink.Field.DisplayText; case CharCase of ecUpperCase: S := AnsiUpperCase(S); ecLowerCase: S := AnsiLowerCase(S); end; end else S := Text; if PasswordChar <> #0 then FillChar(S[1], Length(S), PasswordChar); Margins := GetTextMargins; case AAlignment of taLeftJustify: Left := Margins.X; taRightJustify: Left := ClientWidth - TextWidth(S) - Margins.X - 1; else Left := (ClientWidth - TextWidth(S)) div 2; end; if SysLocale.MiddleEast then UpdateTextFlags; TextRect(R, Left, Margins.Y, S); end; finally FCanvas.Handle := 0; if Message.DC = 0 then EndPaint(Handle, PS); end; end; procedure TDefineDBMask.WMPaste(var Message: TMessage); begin FDataLink.Edit; inherited; end; procedure TDefineDBMask.WMUndo(var Message: TMessage); begin FDataLink.Edit; inherited; end; {TDefineDBMemo} constructor TDefineDBMemo.Create(AOwner: TComponent); begin inherited Create(AOwner); inherited ReadOnly := True; AutoSize := False; FAutoDisplay := True; FDataLink := TFieldDataLink.Create; FDataLink.Control := Self; FDataLink.OnDataChange := DataChange; FDataLink.OnEditingChange := EditingChange; FDataLink.OnUpdateData := UpdateData; FPaintControl := TPaintControl.Create(Self, 'EDIT'); end; destructor TDefineDBMemo.Destroy; begin FPaintControl.Free; FDataLink.Free; FDataLink := nil; inherited Destroy; end; procedure TDefineDBMemo.Loaded; begin inherited Loaded; if (csDesigning in ComponentState) then DataChange(Self); end; procedure TDefineDBMemo.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if (Operation = opRemove) and (FDataLink <> nil) and (AComponent = DataSource) then DataSource := nil; end; function TDefineDBMemo.UseRightToLeftAlignment: Boolean; begin Result := DBUseRightToLeftAlignment(Self, Field); end; procedure TDefineDBMemo.KeyDown(var Key: Word; Shift: TShiftState); begin inherited KeyDown(Key, Shift); if FMemoLoaded then begin if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then FDataLink.Edit; end; end; procedure TDefineDBMemo.KeyPress(var Key: Char); begin inherited KeyPress(Key); if FMemoLoaded then begin if (Key in [#32..#255]) and (FDataLink.Field <> nil) and not FDataLink.Field.IsValidChar(Key) then begin MessageBeep(0); Key := #0; end; case Key of ^H, ^I, ^J, ^M, ^V, ^X, #32..#255: FDataLink.Edit; #27: FDataLink.Reset; end; end else begin if Key = #13 then LoadMemo; Key := #0; end; end; procedure TDefineDBMemo.Change; begin if FMemoLoaded then FDataLink.Modified; FMemoLoaded := True; inherited Change; end; function TDefineDBMemo.GetDataSource: TDataSource; begin Result := FDataLink.DataSource; end; procedure TDefineDBMemo.SetDataSource(Value: TDataSource); begin if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then FDataLink.DataSource := Value; if Value <> nil then Value.FreeNotification(Self); end; function TDefineDBMemo.GetDataField: string; begin Result := FDataLink.FieldName; end; procedure TDefineDBMemo.SetDataField(const Value: string); begin FDataLink.FieldName := Value; end; function TDefineDBMemo.GetReadOnly: Boolean; begin Result := FDataLink.ReadOnly; end; procedure TDefineDBMemo.SetReadOnly(Value: Boolean); begin FDataLink.ReadOnly := Value; end; function TDefineDBMemo.GetField: TField; begin Result := FDataLink.Field; end; procedure TDefineDBMemo.LoadMemo; begin if not FMemoLoaded and Assigned(FDataLink.Field) and FDataLink.Field.IsBlob then begin try Lines.Text := FDataLink.Field.AsString; FMemoLoaded := True; except // Memo too large on E:EInvalidOperation do Lines.Text := Format('(%s)', [E.Message]); end; EditingChange(Self); end; end; procedure TDefineDBMemo.DataChange(Sender: TObject); begin if FDataLink.Field <> nil then if FDataLink.Field.IsBlob then begin if FAutoDisplay or (FDataLink.Editing and FMemoLoaded) then begin FMemoLoaded := False; LoadMemo; end else begin Text := Format('(%s)', [FDataLink.Field.DisplayLabel]); FMemoLoaded := False; end; end else begin if FFocused and FDataLink.CanModify then Text := FDataLink.Field.Text else Text := FDataLink.Field.DisplayText; FMemoLoaded := True; end else begin if csDesigning in ComponentState then Text := Name else Text := ''; FMemoLoaded := False; end; if HandleAllocated then RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ERASE or RDW_FRAME); end; procedure TDefineDBMemo.EditingChange(Sender: TObject); begin inherited ReadOnly := not (FDataLink.Editing and FMemoLoaded); end; procedure TDefineDBMemo.UpdateData(Sender: TObject); begin FDataLink.Field.AsString := Text; end; procedure TDefineDBMemo.SetFocused(Value: Boolean); begin if FFocused <> Value then begin FFocused := Value; if not Assigned(FDataLink.Field) or not FDataLink.Field.IsBlob then FDataLink.Reset; end; end; procedure TDefineDBMemo.WndProc(var Message: TMessage); begin with Message do if (Msg = WM_CREATE) or (Msg = WM_WINDOWPOSCHANGED) or (Msg = CM_FONTCHANGED) then FPaintControl.DestroyHandle; inherited; end; procedure TDefineDBMemo.CMEnter(var Message: TCMEnter); begin SetFocused(True); inherited; if SysLocale.FarEast and FDataLink.CanModify then inherited ReadOnly := False; end; procedure TDefineDBMemo.CMExit(var Message: TCMExit); begin try FDataLink.UpdateRecord; except SetFocus; raise; end; SetFocused(False); inherited; end; procedure TDefineDBMemo.SetAutoDisplay(Value: Boolean); begin if FAutoDisplay <> Value then begin FAutoDisplay := Value; if Value then LoadMemo; end; end; procedure TDefineDBMemo.WMLButtonDblClk(var Message: TWMLButtonDblClk); begin if not FMemoLoaded then LoadMemo else inherited; end; procedure TDefineDBMemo.WMCut(var Message: TMessage); begin FDataLink.Edit; inherited; end; procedure TDefineDBMemo.WMUndo(var Message: TMessage); begin FDataLink.Edit; inherited; end; procedure TDefineDBMemo.WMPaste(var Message: TMessage); begin FDataLink.Edit; inherited; end; procedure TDefineDBMemo.CMGetDataLink(var Message: TMessage); begin Message.Result := Integer(FDataLink); end; procedure TDefineDBMemo.WMPaint(var Message: TWMPaint); var S: string; begin if not (csPaintCopy in ControlState) then inherited else begin if FDataLink.Field <> nil then if FDataLink.Field.IsBlob then begin if FAutoDisplay then S := AdjustLineBreaks(FDataLink.Field.AsString) else S := Format('(%s)', [FDataLink.Field.DisplayLabel]); end else S := FDataLink.Field.DisplayText; SendMessage(FPaintControl.Handle, WM_SETTEXT, 0, Integer(PChar(S))); SendMessage(FPaintControl.Handle, WM_ERASEBKGND, Message.DC, 0); SendMessage(FPaintControl.Handle, WM_PAINT, Message.DC, 0); end; end; function TDefineDBMemo.ExecuteAction(Action: TBasicAction): Boolean; begin Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and FDataLink.ExecuteAction(Action); end; function TDefineDBMemo.UpdateAction(Action: TBasicAction): Boolean; begin Result := inherited UpdateAction(Action) or (FDataLink <> nil) and FDataLink.UpdateAction(Action); end; { TFlatDBGrid } constructor TFlatDBGrid.Create(AOwner: TComponent); begin inherited Create(AOwner); FSingleColor := clWhite; FDoubleColor := clWhite;//$00FFF0E1; OldGridWnd := self.WindowProc ; self.WindowProc := NewGridWnd; fDBBGColor := True; BorderStyle := bsNone; FFocusColor := clWhite; FBorderColor := DefaultBorderColor; FLinesColor := DefaultBorderColor; FFlatColor := DefaultFlatColor; FParentColor := True; FMouseIn := False; end; procedure TFlatDBGrid.NewGridWnd(var Message: TMessage); var IsNeg : Boolean; begin if Message.Msg = WM_MOUSEWHEEL then begin IsNeg := Short(Message.WParamHi) < 0; if IsNeg then Self.DataSource.DataSet.MoveBy(1) else Self.DataSource.DataSet.MoveBy(-1) end else OldGridWnd(Message); end; procedure TFlatDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin inherited; if GdSelected in State then exit; if DbBgColor then begin if DataSource.DataSet.RecNo mod 2<>0 then Canvas.Brush.Color := FSingleColor //读取单横颜色值。。。 else Canvas.Brush.Color := FDoubleColor; // 读取双横颜色值。$00F7E7E7。。 end; DefaultDrawColumnCell(Rect, DataCol, Column, State); end; procedure TFlatDBGrid.SetDbBgColor(const Value: boolean); begin FDbBgColor := Value; repaint; end; procedure TFlatDBGrid.WMVScroll(var Message: TWMVScroll); var SI: TScrollInfo; begin inherited; if Datalink.Active then with Message, DataLink.DataSet do case ScrollCode of SB_THUMBPOSITION: begin if IsSequenced then begin SI.cbSize := sizeof(SI); SI.fMask := SIF_ALL; SetScrollPos(self.Handle,SB_VERT,Pos,True); //强行设定滚动条的位置 GetScrollInfo(Self.Handle, SB_VERT, SI); if SI.nTrackPos <= 1 then First else if SI.nTrackPos >= RecordCount then Last else RecNo := SI.nTrackPos; end else case Pos of 0: First; 1: MoveBy(-VisibleRowCount); 2: Exit; 3: MoveBy(VisibleRowCount); 4: Last; end; end; end; end; procedure TFlatDBGrid.RedrawBorder(const Clip: HRGN); var Attrib:TBorderAttrib; begin with Attrib do begin Ctrl := self; FocusColor := ColorFocused; BorderColor := ColorBorder; FlatColor := ColorFlat; MouseState := MouseIn; FocusState := Focused; DesignState := ComponentState; HasBars := ScrollBars = ssBoth; BoldState := False; end; Color := DrawEditBorder(Attrib,Clip); end; procedure TFlatDBGrid.SetParentColor(Value: Boolean); begin if Value <> FParentColor then begin FParentColor := Value; if FParentColor then begin if Parent <> nil then FFlatColor := TForm(Parent).Color; RedrawBorder; end; end; end; procedure TFlatDBGrid.CMSysColorChange(var Message: TMessage); begin if (Parent <> nil)and(FParentColor) then FFlatColor := TForm(Parent).Color; RedrawBorder; end; procedure TFlatDBGrid.CMParentColorChanged(var Message: TWMNoParams); begin if (Parent <> nil)and(FParentColor) then FFlatColor := TForm(Parent).Color; RedrawBorder; end; procedure TFlatDBGrid.SetColors(Index: Integer; Value: TColor); begin case Index of 0: FFocusColor := Value; 1: FBorderColor := Value; 2: begin FFlatColor := Value; FParentColor := False; end; 3: FLinesColor := Value; 4: FSingleColor := Value; 5: FDoubleColor := Value; end; Repaint; RedrawBorder; end; procedure TFlatDBGrid.CMMouseEnter(var Message: TMessage); begin inherited; if (GetActiveWindow <> 0) then begin FMouseIn := True; RedrawBorder; end; end; procedure TFlatDBGrid.CMMouseLeave(var Message: TMessage); begin inherited; FMouseIn := False; RedrawBorder; end; procedure TFlatDBGrid.CMEnabledChanged(var Message: TMessage); const EnableColors: array[Boolean] of TColor = (clBtnFace, clWindow); begin inherited; Color := EnableColors[Enabled]; RedrawBorder; end; procedure TFlatDBGrid.WMSetFocus(var Message: TWMSetFocus); begin inherited; if not(csDesigning in ComponentState) then RedrawBorder; end; procedure TFlatDBGrid.WMKillFocus(var Message: TWMKillFocus); begin inherited; if not(csDesigning in ComponentState) then RedrawBorder; end; procedure TFlatDBGrid.WMNCCalcSize(var Message: TWMNCCalcSize); begin inherited; InflateRect(Message.CalcSize_Params^.rgrc[0], -3, -3); end; procedure TFlatDBGrid.WMNCPaint(var Message: TMessage); begin inherited; RedrawBorder(HRGN(Message.WParam)); end; procedure TFlatDBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); var FRect:TRect; begin inherited; //绘制数据区的表格边框 with ARect, Canvas do begin if (ACol = 0)or(ARow = 0) then begin if ARow > 0 then begin FRect := Rect(Left-1,Top-1,Right,Bottom+2); DrawFrame(Canvas, FRect, FLinesColor, FLinesColor, 1) end else if ACol > 0 then begin FRect := Rect(Left-2,Top,Right+1,Bottom+1); DrawFrame(Canvas, FRect, FLinesColor, FLinesColor, 1) end else begin FRect := Rect(Left,Top,Right+1,Bottom+1); DrawButtonBorder(Canvas,FRect,FLinesColor,1) end; end else begin FRect := Rect(Left-1,Top-1,Right+1,Bottom+1); DrawButtonBorder(Canvas,FRect,FLinesColor,1); end; end; end; function TFlatDBGrid.GetMouseIn: boolean; begin result := FMouseIn; end; { TDefineDBCheckBox } constructor TDefineDBCheckBox.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := ControlStyle + [csReplicatable]; FValueCheck := STextTrue; FValueUncheck := STextFalse; FDataLink := TFieldDataLink.Create; FDataLink.Control := Self; FDataLink.OnDataChange := DataChange; end; destructor TDefineDBCheckBox.Destroy; begin FDataLink.Free; FDataLink := nil; inherited Destroy; end; procedure TDefineDBCheckBox.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if (Operation = opRemove) and (FDataLink <> nil) and (AComponent = DataSource) then DataSource := nil; end; procedure TDefineDBCheckBox.DataChange(Sender: TObject); begin if (FDataLink.Field <> nil) and (FDataLink.Field is TBooleanField) then Checked := FDataLink.Field.AsBoolean else Checked := False; end; procedure TDefineDBCheckBox.UpdateRecord; var Pos: Integer; S: string; begin if (FDataLink.DataSet <> nil)and(not ReadOnly) then begin FDataLink.DataSet.Edit; if FDataLink.Field.DataType = ftBoolean then FDataLink.Field.AsBoolean := not Checked else begin if Checked then S := FValueCheck else S := FValueUncheck; Pos := 1; FDataLink.Field.Text := ExtractFieldName(S, Pos); end; FDataLink.DataSet.Post; end; end; function TDefineDBCheckBox.GetDataSource: TDataSource; begin Result := FDataLink.DataSource; end; procedure TDefineDBCheckBox.SetDataSource(Value: TDataSource); begin if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then FDataLink.DataSource := Value; if Value <> nil then Value.FreeNotification(Self); end; function TDefineDBCheckBox.GetDataField: string; begin Result := FDataLink.FieldName; end; procedure TDefineDBCheckBox.SetDataField(const Value: string); begin FDataLink.FieldName := Value; end; function TDefineDBCheckBox.GetReadOnly: Boolean; begin Result := FDataLink.ReadOnly; end; procedure TDefineDBCheckBox.SetReadOnly(Value: Boolean); begin FDataLink.ReadOnly := Value; end; function TDefineDBCheckBox.GetField: TField; begin Result := FDataLink.Field; end; procedure TDefineDBCheckBox.KeyPress(var Key: Char); begin inherited KeyPress(Key); case Key of #8 : UpdateRecord; #27: FDataLink.Reset; end; end; procedure TDefineDBCheckBox.CMExit(var Message: TCMExit); begin try UpdateRecord; except SetFocus; raise; end; inherited; end; procedure TDefineDBCheckBox.CMGetDataLink(var Message: TMessage); begin Message.Result := Integer(FDataLink); end; function TDefineDBCheckBox.ExecuteAction(Action: TBasicAction): Boolean; begin Result := inherited ExecuteAction(Action) or (DataLink <> nil) and DataLink.ExecuteAction(Action); end; function TDefineDBCheckBox.UpdateAction(Action: TBasicAction): Boolean; begin Result := inherited UpdateAction(Action) or (DataLink <> nil) and DataLink.UpdateAction(Action); end; function TDefineDBCheckBox.UseRightToLeftAlignment: Boolean; begin Result := inherited UseRightToLeftAlignment; end; { TDefineDBRadioGroup } constructor TDefineDBRadioGroup.Create(AOwner: TComponent); begin FValues := TStringList.Create; FDataLink := TFieldDataLink.Create; SaveState := True; inherited Create(AOwner); FDataLink.Control := Self; FDataLink.OnDataChange := DataChange; end; destructor TDefineDBRadioGroup.Destroy; begin FDataLink.Free; FDataLink := nil; FValues.Free; inherited Destroy; end; procedure TDefineDBRadioGroup.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if (Operation = opRemove) and (FDataLink <> nil) and (AComponent = DataSource) then DataSource := nil; end; function TDefineDBRadioGroup.UseRightToLeftAlignment: Boolean; begin Result := inherited UseRightToLeftAlignment; end; procedure TDefineDBRadioGroup.DataChange(Sender: TObject); begin if SaveState then begin if FDataLink.Field <> nil then Value := FDataLink.Field.Text else Value := ''; end; end; function TDefineDBRadioGroup.GetDataSource: TDataSource; begin Result := FDataLink.DataSource; end; procedure TDefineDBRadioGroup.SetDataSource(Value: TDataSource); begin FDataLink.DataSource := Value; if Value <> nil then Value.FreeNotification(Self); end; function TDefineDBRadioGroup.GetDataField: string; begin Result := FDataLink.FieldName; end; procedure TDefineDBRadioGroup.SetDataField(const Value: string); begin FDataLink.FieldName := Value; end; function TDefineDBRadioGroup.GetReadOnly: Boolean; begin Result := FDataLink.ReadOnly; end; procedure TDefineDBRadioGroup.SetReadOnly(Value: Boolean); begin FDataLink.ReadOnly := Value; end; function TDefineDBRadioGroup.GetField: TField; begin Result := FDataLink.Field; end; function TDefineDBRadioGroup.GetButtonValue(Index: Integer): string; begin if (Index < FValues.Count) and (FValues[Index] <> '') then Result := FValues[Index] else if Index < Items.Count then Result := Items[Index] else Result := ''; end; procedure TDefineDBRadioGroup.SetValue(const Value: string); var I, Index: Integer; begin if FValue <> Value then begin FInSetValue := True; try Index := -1; for I := 0 to Items.Count - 1 do if Value = GetButtonValue(I) then begin Index := I; Break; end; ItemIndex := Index; finally FInSetValue := False; end; FValue := Value; Change; end; end; procedure TDefineDBRadioGroup.UpdateRecord; begin if (FDataLink.DataSet <> nil)and(not ReadOnly) then begin if (FDataLink.Field <> nil)and(ItemIndex>=0) then begin FDataLink.DataSet.Edit; FDataLink.Field.Text := Value;//GetButtonValue(ItemIndex); FDataLink.DataSet.Post; SaveState := True; end; end; end; procedure TDefineDBRadioGroup.CMExit(var Message: TCMExit); begin try UpdateRecord; except if ItemIndex >= 0 then TDefineRadioButton(Controls[ItemIndex]).SetFocus else TDefineRadioButton(Controls[0]).SetFocus; raise; end; inherited; end; procedure TDefineDBRadioGroup.CMGetDataLink(var Message: TMessage); begin Message.Result := Integer(FDataLink); end; procedure TDefineDBRadioGroup.Click; begin if not FInSetValue then begin inherited Click; SaveState := False; if ItemIndex >= 0 then Value := GetButtonValue(ItemIndex); end; end; procedure TDefineDBRadioGroup.SetItems(Value: TStrings); begin Items.Assign(Value); DataChange(Self); end; procedure TDefineDBRadioGroup.SetValues(Value: TStrings); begin FValues.Assign(Value); DataChange(Self); end; procedure TDefineDBRadioGroup.Change; begin if Assigned(FOnChange) then FOnChange(Self); end; procedure TDefineDBRadioGroup.KeyPress(var Key: Char); begin inherited KeyPress(Key); case Key of #8 : UpdateRecord; #27 : FDataLink.Reset; end; end; function TDefineDBRadioGroup.CanModify: Boolean; begin Result := FDataLink.Edit; end; function TDefineDBRadioGroup.ExecuteAction(Action: TBasicAction): Boolean; begin Result := inherited ExecuteAction(Action) or (DataLink <> nil) and DataLink.ExecuteAction(Action); end; function TDefineDBRadioGroup.UpdateAction(Action: TBasicAction): Boolean; begin Result := inherited UpdateAction(Action) or (DataLink <> nil) and DataLink.UpdateAction(Action); end; end.