Delphi控件源码

开发平台：

Delphi

bsdbctrls.pas：源码内容

{*******************************************************************}
{ }
{ Almediadev Visual Component Library }
{ BusinessSkinForm }
{ Version 1.98 }
{ }
{ }
{ Home: http://www.almdev.com }
{ Support: support@almdev.com }
{ }
{*******************************************************************}
unit bsdbctrls;
{$R-,H+,X+}
{$WARNINGS OFF}
{$HINTS OFF}
interface
uses Windows, SysUtils, Messages, Classes, Controls, Forms,
Graphics, Menus, StdCtrls, ExtCtrls, Mask, Buttons, ComCtrls, Db,
DBCtrls, bsSkinBoxCtrls, bsSkinCtrls, bsSkinData, bsUtils, bsMessages,
bsCalc;
type
TbsSkinDBText = class(TbsSkinStdLabel)
private
FDataLink: TFieldDataLink;
procedure DataChange(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetFieldText: string;
procedure SetDataField(const Value: string);
procedure SetDataSource(Value: TDataSource);
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
protected
function GetLabelText: string; override;
procedure Loaded; override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure SetAutoSize(Value: Boolean); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
function UseRightToLeftAlignment: Boolean; override;
property Field: TField read GetField;
published
property Align;
property Alignment;
property Anchors;
property AutoSize default False;
property BiDiMode;
property Color;
property Constraints;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ParentBiDiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property Transparent;
property ShowHint;
property Visible;
property WordWrap;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
{ TbsSkinDbEdit }
TbsSkinDBEdit = class(TbsSkinEdit)
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;
function EditCanModify: Boolean; 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 Reset; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
function UseRightToLeftAlignment: Boolean; override;
property Field: TField read GetField;
published
property Anchors;
property AutoSelect;
property AutoSize;
property BiDiMode;
property CharCase;
property Color;
property Constraints;
property Ctl3D;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ImeMode;
property ImeName;
property MaxLength;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
TbsSkinDBSpinEdit = class(TbsSkinSpinEdit)
private
FInDataChange: Boolean;
FInChange: Boolean;
FDataLink: TFieldDataLink;
FCanvas: TControlCanvas;
FAlignment: TAlignment;
FFocused: Boolean;
procedure EditingChange(Sender: TObject);
procedure DataChange(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 UpdateData(Sender: TObject);
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
protected
procedure EditEnter(Sender: TObject); override;
procedure EditExit(Sender: TObject); override;
procedure Change; override;
procedure Loaded; override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure Reset;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
property Field: TField read GetField;
published
property Anchors;
property AutoSize;
property BiDiMode;
property Color;
property Constraints;
property Ctl3D;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ImeMode;
property ImeName;
property MaxLength;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
TbsSkinDBDateEdit = class(TbsSkinDateEdit)
private
FInDataChange: Boolean;
FInChange: Boolean;
FDataLink: TFieldDataLink;
FFocused: Boolean;
procedure EditingChange(Sender: TObject);
procedure DataChange(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 UpdateData(Sender: TObject);
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
protected
procedure Change; override;
procedure Loaded; override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure Reset; override;
procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
procedure CMExit(var Message: TCMGotFocus); message CM_EXIT;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
property Field: TField read GetField;
published
published
property Anchors;
property AutoSize;
property BiDiMode;
property Color;
property Constraints;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ImeMode;
property ImeName;
property MaxLength;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
TbsSkinDBTimeEdit = class(TbsSkinTimeEdit)
private
FInDataChange: Boolean;
FInChange: Boolean;
FDataLink: TFieldDataLink;
FFocused: Boolean;
procedure EditingChange(Sender: TObject);
procedure DataChange(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 UpdateData(Sender: TObject);
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
protected
procedure Change; override;
procedure Loaded; override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure Reset; override;
procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
procedure CMExit(var Message: TCMGotFocus); message CM_EXIT;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
property Field: TField read GetField;
published
published
property Anchors;
property AutoSize;
property BiDiMode;
property Color;
property Constraints;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ImeMode;
property ImeName;
property MaxLength;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
TbsSkinDBCalcEdit = class(TbsSkinCalcEdit)
private
FInDataChange: Boolean;
FInChange: Boolean;
FDataLink: TFieldDataLink;
FFocused: Boolean;
procedure EditingChange(Sender: TObject);
procedure DataChange(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 UpdateData(Sender: TObject);
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
protected
procedure Change; override;
procedure Loaded; override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure Reset; override;
procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
procedure CMExit(var Message: TCMGotFocus); message CM_EXIT;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
property Field: TField read GetField;
published
property Anchors;
property AutoSize;
property BiDiMode;
property Color;
property Constraints;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ImeMode;
property ImeName;
property MaxLength;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
TbsSkinDBMemo = class(TbsSkinMemo)
private
FDataLink: TFieldDataLink;
FAutoDisplay: Boolean;
FFocused: Boolean;
FMemoLoaded: Boolean;
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);
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 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;
procedure WndProc(var Message: TMessage); override;
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;
published
property Align;
property Alignment;
property Anchors;
property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
property BiDiMode;
property Color;
property Constraints;
property Ctl3D;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ImeMode;
property ImeName;
property MaxLength;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
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;
TbsSkinDBMemo2 = class(TbsSkinMemo2)
private
FDataLink: TFieldDataLink;
FAutoDisplay: Boolean;
FFocused: Boolean;
FMemoLoaded: Boolean;
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);
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 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;
procedure WndProc(var Message: TMessage); override;
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;
published
property Align;
property Alignment;
property Anchors;
property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
property BiDiMode;
property Color;
property Constraints;
property Ctl3D;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ImeMode;
property ImeName;
property MaxLength;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
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;
TbsSkinDBCheckRadioBox = class(TbsSkinCheckRadioBox)
private
FDataLink: TFieldDataLink;
FValueCheck: string;
FValueUncheck: string;
procedure DataChange(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetFieldState: TCheckBoxState;
function GetReadOnly: Boolean;
procedure SetDataField(const Value: string);
procedure SetDataSource(Value: TDataSource);
procedure SetReadOnly(Value: Boolean);
procedure SetValueCheck(const Value: string);
procedure SetValueUncheck(const Value: string);
procedure UpdateData(Sender: TObject);
function ValueMatch(const ValueList, Value: string): Boolean;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
protected
procedure KeyPress(var Key: Char); override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure WndProc(var Message: TMessage); override;
procedure SetCheckState; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
function UseRightToLeftAlignment: Boolean; override;
property Checked;
property Field: TField read GetField;
published
property Action;
property Anchors;
property BiDiMode;
property Caption;
property Color;
property Constraints;
property Ctl3D;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property ShowHint;
property TabOrder;
property TabStop;
property ValueChecked: string read FValueCheck write SetValueCheck;
property ValueUnchecked: string read FValueUncheck write SetValueUncheck;
property Visible;
property OnClick;
property OnContextPopup;
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;
TbsSkinDBListBox = class(TbsSkinListBox)
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: TStrings);
protected
procedure CheckButtonClick(Sender: TObject);
procedure ListBoxExit; override;
procedure ListBoxWProc(var Message: TMessage;
var Handled: Boolean); override;
procedure ListBoxClick; override;
procedure ListBoxKeyDown(var Key: Word; Shift: TShiftState); override;
procedure ListBoxKeyPress(var Key: Char); override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
function UseRightToLeftAlignment: Boolean; override;
property Field: TField read GetField;
published
property Align;
property Anchors;
property BiDiMode;
property Color;
property Constraints;
property Ctl3D default True;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ImeMode;
property ImeName;
property Items write SetItems;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawItem;
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;
{ TbsSkinDBComboBox }
TbsSkinDBComboBox = class(TbsSkinComboBox)
private
FInDataChange: Boolean;
FInDateSelfChange: Boolean;
FDataLink: TFieldDataLink;
procedure DataChange(Sender: TObject);
function GetComboText: string;
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetReadOnly: Boolean;
procedure SetComboText(const Value: string);
procedure SetDataField(const Value: string);
procedure SetDataSource(Value: TDataSource);
procedure SetItems(Value: TStrings);
procedure SetReadOnly(Value: Boolean);
procedure UpdateData(Sender: TObject);
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
protected
procedure Change; override;
procedure CreateWnd; 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 EditWindowProcHook(var Message: TMessage); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
function UseRightToLeftAlignment: Boolean; override;
property Field: TField read GetField;
property Text;
published
property Style; {Must be published before Items}
property Anchors;
property BiDiMode;
property Color;
property Constraints;
property Ctl3D;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property DragCursor;
property DragKind;
property DragMode;
property DropDownCount;
property Enabled;
property Font;
property ImeMode;
property ImeName;
property Items write SetItems;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property ShowHint;
property Sorted;
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 OnStartDock;
property OnStartDrag;
end;
TbsSkinDBRadioGroup = class(TbsSkinCustomRadioGroup)
private
FInClick: Boolean;
FDataLink: TFieldDataLink;
FValue: string;
FValues: TStrings;
FInSetValue: Boolean;
FOnChange: TNotifyEvent;
procedure DataChange(Sender: TObject);
procedure UpdateData(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;
protected
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;
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;
published
property Align;
property Anchors;
property BiDiMode;
property Caption;
property Color;
property Columns;
property Constraints;
property Ctl3D;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property Items write SetItems;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property ShowHint;
property TabOrder;
property TabStop;
property Values: TStrings read FValues write SetValues;
property Visible;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnClick;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnStartDock;
property OnStartDrag;
end;
{ TbsDBLookupControl }
TbsDBLookupControl = class;
TbsDataSourceLink = class(TDataLink)
private
FDBLookupControl: TbsDBLookupControl;
protected
procedure FocusControl(Field: TFieldRef); override;
procedure ActiveChanged; override;
procedure LayoutChanged; override;
procedure RecordChanged(Field: TField); override;
public
constructor Create;
end;
TbsListSourceLink = class(TDataLink)
private
FDBLookupControl: TbsDBLookupControl;
protected
procedure ActiveChanged; override;
procedure DataSetChanged; override;
procedure LayoutChanged; override;
public
constructor Create;
end;
TbsDBLookupControl = class(TbsSkinCustomControl)
private
FLookupSource: TDataSource;
FDataLink: TbsDataSourceLink;
FListLink: TbsListSourceLink;
FDataFieldName: string;
FKeyFieldName: string;
FListFieldName: string;
FListFieldIndex: Integer;
FDataField: TField;
FMasterField: TField;
FKeyField: TField;
FListField: TField;
FListFields: TList;
FKeyValue: Variant;
FSearchText: string;
FLookupMode: Boolean;
FListActive: Boolean;
FHasFocus: Boolean;
FNullValueKey: TShortCut;
procedure CheckNotCircular;
procedure CheckNotLookup;
procedure DataLinkRecordChanged(Field: TField);
function GetDataSource: TDataSource;
function GetKeyFieldName: string;
function GetListSource: TDataSource;
function GetReadOnly: Boolean;
procedure SetDataFieldName(const Value: string);
procedure SetDataSource(Value: TDataSource);
procedure SetKeyFieldName(const Value: string);
procedure SetKeyValue(const Value: Variant);
procedure SetListFieldName(const Value: string);
procedure SetListSource(Value: TDataSource);
procedure SetLookupMode(Value: Boolean);
procedure SetReadOnly(Value: Boolean);
procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
procedure WMKillFocus(var Message: TMessage); message WM_KILLFOCUS;
procedure WMSetFocus(var Message: TMessage); message WM_SETFOCUS;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
protected
function CanModify: Boolean; virtual;
procedure KeyValueChanged; virtual;
procedure ListLinkDataChanged; virtual;
function LocateKey: Boolean; virtual;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure ProcessSearchKey(Key: Char); virtual;
procedure SelectKeyValue(const Value: Variant); virtual;
procedure UpdateDataFields; virtual;
procedure UpdateListFields; virtual;
property DataField: string read FDataFieldName write SetDataFieldName;
property DataLink: TbsDataSourceLink read FDataLink;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property HasFocus: Boolean read FHasFocus;
property KeyField: string read GetKeyFieldName write SetKeyFieldName;
property KeyValue: Variant read FKeyValue write SetKeyValue;
property ListActive: Boolean read FListActive;
property ListField: string read FListFieldName write SetListFieldName;
property ListFieldIndex: Integer read FListFieldIndex write FListFieldIndex default 0;
property ListFields: TList read FListFields;
property ListLink: TbsListSourceLink read FListLink;
property ListSource: TDataSource read GetListSource write SetListSource;
property NullValueKey: TShortCut read FNullValueKey write FNullValueKey default 0;
property ParentColor default False;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property SearchText: string read FSearchText write FSearchText;
property TabStop default True;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
property Field: TField read FDataField;
end;
{ TbsSkinDBLookupListBox }
TbsSkinDBLookupListBox = class(TbsDBLookupControl)
private
FStopThumbScroll: Boolean;
FScrollBar: TbsSkinScrollBar;
FDefaultItemHeight: Integer;
FRecordIndex: Integer;
FRecordCount: Integer;
FRowCount: Integer;
FBorderStyle: TBorderStyle;
FPopup: Boolean;
FKeySelected: Boolean;
FTracking: Boolean;
FTimerActive: Boolean;
FLockPosition: Boolean;
FMousePos: Integer;
FSelectedItem: string;
procedure ShowScrollBar;
procedure HideScrollBar;
procedure AlignScrollBar;
procedure SetDefaultItemHeight(Value: Integer);
function GetKeyIndex: Integer;
procedure SelectCurrent;
procedure SelectItemAt(X, Y: Integer);
procedure SetBorderStyle(Value: TBorderStyle);
procedure SetRowCount(Value: Integer);
procedure StopTimer;
procedure StopTracking;
procedure TimerScroll;
procedure UpdateScrollBar;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure WMCancelMode(var Message: TMessage); message WM_CANCELMODE;
procedure WMTimer(var Message: TMessage); message WM_TIMER;
procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
procedure OnScrollBarChange(Sender: TObject);
procedure OnScrollBarUpButtonClick(Sender: TObject);
procedure OnScrollBarDownButtonClick(Sender: TObject);
protected
procedure FramePaint(C: TCanvas);
procedure WMNCCALCSIZE(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure WMNCPAINT(var Message: TMessage); message WM_NCPAINT;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure KeyValueChanged; override;
procedure ListLinkDataChanged; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure CreateControlDefaultImage(B: TBitMap); override;
procedure CreateControlSkinImage(B: TBitMap); override;
procedure UpdateListFields; override;
procedure GetSkinData; override;
function GetItemHeight: Integer;
function GetBorderHeight: Integer;
function GetItemWidth: Integer;
public
FontName: String;
FontStyle: TFontStyles;
FontHeight: Integer;
SItemRect, ActiveItemRect, FocusItemRect: TRect;
ItemLeftOffset, ItemRightOffset: Integer;
ItemTextRect: TRect;
FontColor, ActiveFontColor, FocusFontColor: TColor;
ScrollBarName: String;
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 KeyValue;
property SelectedItem: string read FSelectedItem;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
procedure ChangeSkinData; override;
published
property Align;
property Anchors;
property BiDiMode;
property Constraints;
property DataField;
property DataSource;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ImeMode;
property ImeName;
property KeyField;
property ListField;
property ListFieldIndex;
property ListSource;
property NullValueKey;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property RowCount: Integer read FRowCount write SetRowCount;
property DefaultItemHeight: Integer read FDefaultItemHeight
write SetDefaultItemHeight;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
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;
{ TDBLookupComboBox }
TbsPopupDataList = class(TbsSkinDBLookupListBox)
private
procedure WMMouseActivate(var Message: TMessage); message WM_MOUSEACTIVATE;
protected
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); override;
end;
TDropDownAlign = (daLeft, daRight, daCenter);
TbsSkinDBLookupComboBox = class(TbsDBLookupControl)
private
FButtonRect, FItemRect: TRect;
FDataList: TbsPopupDataList;
FButtonWidth: Integer;
FText: string;
FDropDownRows: Integer;
FDropDownWidth: Integer;
FDropDownAlign: TDropDownAlign;
FListVisible: Boolean;
FPressed: Boolean;
FMouseIn: Boolean;
FTracking: Boolean;
FAlignment: TAlignment;
FLookupMode: Boolean;
FOnDropDown: TNotifyEvent;
FOnCloseUp: TNotifyEvent;
procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure StopTracking;
procedure TrackButton(X, Y: Integer);
procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
procedure WMCancelMode(var Message: TMessage); message WM_CANCELMODE;
procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure KeyValueChanged; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure UpdateListFields; override;
procedure CreateControlDefaultImage(B: TBitMap); override;
procedure CreateControlSkinImage(B: TBitMap); override;
procedure GetSkinData; override;
public
FontName: String;
FontStyle: TFontStyles;
FontHeight: Integer;
SItemRect, FocusItemRect: TRect;
ItemLeftOffset, ItemRightOffset: Integer;
ItemTextRect: TRect;
FontColor, FocusFontColor: TColor;
ButtonRect,
ActiveButtonRect,
DownButtonRect: TRect;
ListBoxName: String;
constructor Create(AOwner: TComponent); override;
procedure CloseUp(Accept: Boolean); virtual;
procedure DropDown; virtual;
function ExecuteAction(Action: TBasicAction): Boolean; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
function UpdateAction(Action: TBasicAction): Boolean; override;
function UseRightToLeftAlignment: Boolean; override;
property KeyValue;
property ListVisible: Boolean read FListVisible;
property Text: string read FText;
published
property Anchors;
property BiDiMode;
property Color;
property Constraints;
property DataField;
property DataSource;
property DragCursor;
property DragKind;
property DragMode;
property DropDownAlign: TDropDownAlign read FDropDownAlign write FDropDownAlign default daLeft;
property DropDownRows: Integer read FDropDownRows write FDropDownRows default 7;
property DropDownWidth: Integer read FDropDownWidth write FDropDownWidth default 0;
property Enabled;
property Font;
property ImeMode;
property ImeName;
property KeyField;
property ListField;
property ListFieldIndex;
property ListSource;
property NullValueKey;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
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;
const
InitRepeatPause = 400; { pause before repeat timer (ms) }
RepeatPause = 100; { pause before hint window displays (ms)}
SpaceSize = 5; { size of space between special buttons }
type
TbsNavButton = class;
TbsNavDataLink = class;
TbsNavGlyph = (ngEnabled, ngDisabled);
TbsNavigateBtn = (nbFirst, nbPrior, nbNext, nbLast,
nbInsert, nbDelete, nbEdit, nbPost, nbCancel, nbRefresh);
TbsButtonSet = set of TbsNavigateBtn;
TbsNavButtonStyle = set of (nsAllowTimer, nsFocusRect);
ENavClick = procedure (Sender: TObject; Button: TbsNavigateBtn) of object;
{ TbsSkinDBNavigator }
TbsSkinDBNavigator = class (TbsSkinPanel)
private
FSkinMessage: TbsSkinMessage;
FBtnSkinDataName: String;
FDataLink: TbsNavDataLink;
FVisibleButtons: TbsButtonSet;
FHints: TStrings;
FDefHints: TStrings;
ButtonWidth: Integer;
MinBtnSize: TPoint;
FOnNavClick: ENavClick;
FBeforeAction: ENavClick;
FConfirmDelete: Boolean;
FAdditionalGlyphs: Boolean;
procedure SetAdditionalGlyphs(Value: Boolean);
procedure SetBtnSkinDataName(Value: String);
procedure ClickHandler(Sender: TObject);
function GetDataSource: TDataSource;
function GetHints: TStrings;
procedure HintsChanged(Sender: TObject);
procedure InitButtons;
procedure InitHints;
procedure SetDataSource(Value: TDataSource);
procedure SetHints(Value: TStrings);
procedure SetSize(var W: Integer; var H: Integer);
procedure SetVisible(Value: TbsButtonSet);
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
protected
Buttons: array[TbsNavigateBtn] of TbsNavButton;
procedure DataChanged;
procedure EditingChanged;
procedure ActiveChanged;
procedure Loaded; override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
procedure CalcMinSize(var W, H: Integer);
procedure SetSkinData(Value: TbsSkinData); override;
public
procedure Paint; override;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
procedure BtnClick(Index: TbsNavigateBtn); virtual;
procedure ChangeSkinData; override;
published
property AdditionalGlyphs: Boolean
read FAdditionalGlyphs write SetAdditionalGlyphs;
property SkinMessage: TbsSkinMessage read FSkinMessage write FSkinMessage;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property VisibleButtons: TbsButtonSet read FVisibleButtons write SetVisible
default [nbFirst, nbPrior, nbNext, nbLast, nbInsert, nbDelete,
nbEdit, nbPost, nbCancel, nbRefresh];
property BtnSkinDataName: String read FBtnSkinDataName write SetBtnSkinDataName;
property Align;
property Anchors;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Hints: TStrings read GetHints write SetHints;
property ParentCtl3D;
property ParentShowHint;
property PopupMenu;
property ConfirmDelete: Boolean read FConfirmDelete write FConfirmDelete default True;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property BeforeAction: ENavClick read FBeforeAction write FBeforeAction;
property OnClick: ENavClick read FOnNavClick write FOnNavClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnResize;
property OnStartDock;
property OnStartDrag;
end;
{ TbsNavButton }
TbsNavButton = class(TbsSkinButton)
private
FNavIndex: TbsNavigateBtn;
FNavStyle: TbsNavButtonStyle;
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
procedure GetSkinData; override;
destructor Destroy; override;
property NavStyle: TbsNavButtonStyle read FNavStyle write FNavStyle;
property Index : TbsNavigateBtn read FNavIndex write FNavIndex;
end;
{ TbsNavDataLink }
TbsNavDataLink = class(TDataLink)
private
FNavigator: TbsSkinDBNavigator;
protected
procedure EditingChanged; override;
procedure DataSetChanged; override;
procedure ActiveChanged; override;
public
constructor Create(ANav: TbsSkinDBNavigator);
destructor Destroy; override;
end;
{ TbsSkinDBImage }
TbsSkinDBImage = class(TbsSkinPanel)
private
FDataLink: TFieldDataLink;
FPicture: TPicture;
FBorderStyle: TbsSkinBorderStyle;
FAutoDisplay: Boolean;
FStretch: Boolean;
FCenter: Boolean;
FPictureLoaded: Boolean;
FQuickDraw: Boolean;
procedure DataChange(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetReadOnly: Boolean;
procedure PictureChanged(Sender: TObject);
procedure SetAutoDisplay(Value: Boolean);
procedure SetCenter(Value: Boolean);
procedure SetDataField(const Value: string);
procedure SetDataSource(Value: TDataSource);
procedure SetPicture(Value: TPicture);
procedure SetReadOnly(Value: Boolean);
procedure SetStretch(Value: Boolean);
procedure UpdateData(Sender: TObject);
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
procedure WMCut(var Message: TMessage); message WM_CUT;
procedure WMCopy(var Message: TMessage); message WM_COPY;
procedure WMPaste(var Message: TMessage); message WM_PASTE;
procedure WMSize(var Message: TMessage); message WM_SIZE;
protected
procedure CreateParams(var Params: TCreateParams); override;
function GetPalette: HPALETTE; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure PaintImage(Cnvs: TCanvas);
procedure CreateControlDefaultImage(B: TBitMap); override;
procedure CreateControlSkinImage(B: TBitMap); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure CopyToClipboard;
procedure CutToClipboard;
function ExecuteAction(Action: TBasicAction): Boolean; override;
procedure LoadPicture;
procedure PasteFromClipboard;
function UpdateAction(Action: TBasicAction): Boolean; override;
property Field: TField read GetField;
property Picture: TPicture read FPicture write SetPicture;
published
property Align;
property Anchors;
property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
property Center: Boolean read FCenter write SetCenter default True;
property Color;
property Constraints;
property Ctl3D;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ParentColor default False;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property QuickDraw: Boolean read FQuickDraw write FQuickDraw default True;
property ShowHint;
property Stretch: Boolean read FStretch write SetStretch default False;
property TabOrder;
property TabStop default True;
property Visible;
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;
TbsSkinDBRichEdit = class(TbsSkinRichEdit)
private
FDataLink: TFieldDataLink;
FAutoDisplay: Boolean;
FFocused: Boolean;
FMemoLoaded: Boolean;
FDataSave: string;
procedure BeginEditing;
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);
procedure WMCut(var Message: TMessage); message WM_CUT;
procedure WMPaste(var Message: TMessage); message WM_PASTE;
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 CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
protected
procedure Change; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure Loaded; override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
procedure LoadMemo; virtual;
function UpdateAction(Action: TBasicAction): Boolean; override;
function UseRightToLeftAlignment: Boolean; override;
property Field: TField read GetField;
published
property Align;
property Alignment;
property Anchors;
property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
property BiDiMode;
property Color;
property Constraints;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property HideScrollBars;
property ImeMode;
property ImeName;
property MaxLength;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PlainText;
property PopupMenu;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property ScrollBars;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property WantReturns;
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 OnResizeRequest;
property OnSelectionChange;
property OnProtectChange;
property OnSaveClipboard;
property OnStartDock;
property OnStartDrag;
end;
implementation
uses Clipbrd, Dialogs, Math {$IFDEF VER140}, Variants {$ENDIF}
{$IFDEF VER150}, Variants {$ENDIF};
{$R BSDBCTRLS}
{ TbsSkinDBText }
constructor TbsSkinDBText.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];
AutoSize := False;
ShowAccelChar := False;
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
end;
destructor TbsSkinDBText.Destroy;
begin
FDataLink.Free;
FDataLink := nil;
inherited Destroy;
end;
procedure TbsSkinDBText.Loaded;
begin
inherited Loaded;
if (csDesigning in ComponentState) then DataChange(Self);
end;
procedure TbsSkinDBText.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
end;
function TbsSkinDBText.UseRightToLeftAlignment: Boolean;
begin
Result := DBUseRightToLeftAlignment(Self, Field);
end;
procedure TbsSkinDBText.SetAutoSize(Value: Boolean);
begin
if AutoSize <> Value then
begin
// if Value and FDataLink.DataSourceFixed then DatabaseError(SDataSourceFixed);
inherited SetAutoSize(Value);
end;
end;
function TbsSkinDBText.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
procedure TbsSkinDBText.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 TbsSkinDBText.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;
procedure TbsSkinDBText.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value;
end;
function TbsSkinDBText.GetField: TField;
begin
Result := FDataLink.Field;
end;
function TbsSkinDBText.GetFieldText: string;
begin
if FDataLink.Field <> nil then
Result := FDataLink.Field.DisplayText
else
if csDesigning in ComponentState then Result := Name else Result := '';
end;
procedure TbsSkinDBText.DataChange(Sender: TObject);
begin
Caption := GetFieldText;
end;
function TbsSkinDBText.GetLabelText: string;
begin
if csPaintCopy in ControlState then
Result := GetFieldText else
Result := Caption;
end;
procedure TbsSkinDBText.CMGetDataLink(var Message: TMessage);
begin
Message.Result := Integer(FDataLink);
end;
function TbsSkinDBText.ExecuteAction(Action: TBasicAction): Boolean;
begin
Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
FDataLink.ExecuteAction(Action);
end;
function TbsSkinDBText.UpdateAction(Action: TBasicAction): Boolean;
begin
Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
FDataLink.UpdateAction(Action);
end;
procedure TbsSkinDbEdit.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 TbsSkinDbEdit.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 TbsSkinDbEdit.Destroy;
begin
FDataLink.Free;
FDataLink := nil;
FCanvas.Free;
inherited Destroy;
end;
procedure TbsSkinDbEdit.Loaded;
begin
inherited Loaded;
ResetMaxLength;
if (csDesigning in ComponentState) then DataChange(Self);
end;
procedure TbsSkinDbEdit.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
end;
function TbsSkinDbEdit.UseRightToLeftAlignment: Boolean;
begin
Result := DBUseRightToLeftAlignment(Self, Field);
end;
procedure TbsSkinDbEdit.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 TbsSkinDbEdit.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;
function TbsSkinDbEdit.EditCanModify: Boolean;
begin
Result := FDataLink.Edit;
end;
procedure TbsSkinDbEdit.Reset;
begin
FDataLink.Reset;
SelectAll;
end;
procedure TbsSkinDbEdit.SetFocused(Value: Boolean);
begin
if FFocused <> Value then
begin
FFocused := Value;
if (FAlignment <> taLeftJustify) and not IsMasked then Invalidate;
FDataLink.Reset;
end;
end;
procedure TbsSkinDbEdit.Change;
begin
FDataLink.Modified;
inherited Change;
end;
function TbsSkinDbEdit.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
procedure TbsSkinDbEdit.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 TbsSkinDbEdit.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;
procedure TbsSkinDbEdit.SetDataField(const Value: string);
begin
if not (csDesigning in ComponentState) then
ResetMaxLength;
FDataLink.FieldName := Value;
end;
function TbsSkinDbEdit.GetReadOnly: Boolean;
begin
Result := FDataLink.ReadOnly;
end;
procedure TbsSkinDbEdit.SetReadOnly(Value: Boolean);
begin
FDataLink.ReadOnly := Value;
end;
function TbsSkinDbEdit.GetField: TField;
begin
Result := FDataLink.Field;
end;
procedure TbsSkinDbEdit.ActiveChange(Sender: TObject);
begin
ResetMaxLength;
end;
procedure TbsSkinDbEdit.DataChange(Sender: TObject);
begin
if FDataLink.Field <> nil then
begin
if FAlignment <> FDataLink.Field.Alignment then
begin
EditText := ''; {forces update}
FAlignment := FDataLink.Field.Alignment;
end;
EditMask := FDataLink.Field.EditMask;
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
EditText := FDataLink.Field.DisplayText;
if FDataLink.Editing and FDataLink.CanModify then
Modified := True;
end;
end else
begin
FAlignment := taLeftJustify;
EditMask := '';
if csDesigning in ComponentState then
EditText := Name else
EditText := '';
end;
end;
procedure TbsSkinDbEdit.EditingChange(Sender: TObject);
begin
inherited ReadOnly := not FDataLink.Editing;
end;
procedure TbsSkinDbEdit.UpdateData(Sender: TObject);
begin
ValidateEdit;
FDataLink.Field.Text := Text;
end;
procedure TbsSkinDbEdit.WMUndo(var Message: TMessage);
begin
FDataLink.Edit;
inherited;
end;
procedure TbsSkinDbEdit.WMPaste(var Message: TMessage);
begin
FDataLink.Edit;
inherited;
end;
procedure TbsSkinDbEdit.WMCut(var Message: TMessage);
begin
FDataLink.Edit;
inherited;
end;
procedure TbsSkinDbEdit.CMEnter(var Message: TCMEnter);
begin
SetFocused(True);
inherited;
if FDataLink.CanModify then
inherited ReadOnly := False;
end;
procedure TbsSkinDbEdit.CMExit(var Message: TCMExit);
begin
try
FDataLink.UpdateRecord;
except
SelectAll;
SetFocus;
raise;
end;
SetFocused(False);
CheckCursor;
DoExit;
end;
procedure TbsSkinDbEdit.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;
Brush.Style := bsClear;
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 := EditText;
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 TbsSkinDbEdit.CMGetDataLink(var Message: TMessage);
begin
Message.Result := Integer(FDataLink);
end;
function TbsSkinDbEdit.GetTextMargins: TPoint;
begin
Result.X := 0;
Result.Y := 0;
end;
function TbsSkinDbEdit.ExecuteAction(Action: TBasicAction): Boolean;
begin
Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
FDataLink.ExecuteAction(Action);
end;
function TbsSkinDbEdit.UpdateAction(Action: TBasicAction): Boolean;
begin
Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
FDataLink.UpdateAction(Action);
end;
constructor TbsSkinDBMemo.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
inherited ReadOnly := True;
ControlStyle := ControlStyle + [csReplicatable];
FAutoDisplay := True;
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
FDataLink.OnEditingChange := EditingChange;
FDataLink.OnUpdateData := UpdateData;
end;
destructor TbsSkinDBMemo.Destroy;
begin
FDataLink.Free;
FDataLink := nil;
inherited Destroy;
end;
procedure TbsSkinDBMemo.Loaded;
begin
inherited Loaded;
// if (csDesigning in ComponentState) then DataChange(Self);
end;
procedure TbsSkinDBMemo.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
end;
function TbsSkinDBMemo.UseRightToLeftAlignment: Boolean;
begin
Result := DBUseRightToLeftAlignment(Self, Field);
end;
procedure TbsSkinDBMemo.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 TbsSkinDBMemo.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 TbsSkinDBMemo.Change;
begin
if FMemoLoaded then FDataLink.Modified;
FMemoLoaded := True;
inherited Change;
end;
function TbsSkinDBMemo.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
procedure TbsSkinDBMemo.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 TbsSkinDBMemo.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;
procedure TbsSkinDBMemo.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value;
end;
function TbsSkinDBMemo.GetReadOnly: Boolean;
begin
Result := FDataLink.ReadOnly;
end;
procedure TbsSkinDBMemo.SetReadOnly(Value: Boolean);
begin
FDataLink.ReadOnly := Value;
end;
function TbsSkinDBMemo.GetField: TField;
begin
Result := FDataLink.Field;
end;
procedure TbsSkinDBMemo.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 TbsSkinDBMemo.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 TbsSkinDBMemo.EditingChange(Sender: TObject);
begin
inherited ReadOnly := not (FDataLink.Editing and FMemoLoaded);
end;
procedure TbsSkinDBMemo.UpdateData(Sender: TObject);
begin
FDataLink.Field.AsString := Text;
end;
procedure TbsSkinDBMemo.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 TbsSkinDBMemo.WndProc(var Message: TMessage);
begin
inherited;
end;
procedure TbsSkinDBMemo.CMEnter(var Message: TCMEnter);
begin
SetFocused(True);
inherited;
if FDataLink.CanModify then
inherited ReadOnly := False;
end;
procedure TbsSkinDBMemo.CMExit(var Message: TCMExit);
begin
try
FDataLink.UpdateRecord;
except
SetFocus;
raise;
end;
SetFocused(False);
inherited;
end;
procedure TbsSkinDBMemo.SetAutoDisplay(Value: Boolean);
begin
if FAutoDisplay <> Value then
begin
FAutoDisplay := Value;
if Value then LoadMemo;
end;
end;
procedure TbsSkinDBMemo.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
if not FMemoLoaded then LoadMemo else inherited;
end;
procedure TbsSkinDBMemo.WMCut(var Message: TMessage);
begin
FDataLink.Edit;
inherited;
end;
procedure TbsSkinDBMemo.WMUndo(var Message: TMessage);
begin
FDataLink.Edit;
inherited;
end;
procedure TbsSkinDBMemo.WMPaste(var Message: TMessage);
begin
FDataLink.Edit;
inherited;
end;
procedure TbsSkinDBMemo.CMGetDataLink(var Message: TMessage);
begin
Message.Result := Integer(FDataLink);
end;
function TbsSkinDBMemo.ExecuteAction(Action: TBasicAction): Boolean;
begin
Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
FDataLink.ExecuteAction(Action);
end;
function TbsSkinDBMemo.UpdateAction(Action: TBasicAction): Boolean;
begin
Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
FDataLink.UpdateAction(Action);
end;
{ TbsSkinDBCheckRadioBox }
constructor TbsSkinDBCheckRadioBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];
FValueCheck := 'True';
FValueUncheck := 'False';
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
FDataLink.OnUpdateData := UpdateData;
end;
destructor TbsSkinDBCheckRadioBox.Destroy;
begin
FDataLink.Free;
FDataLink := nil;
inherited Destroy;
end;
procedure TbsSkinDBCheckRadioBox.SetCheckState;
begin
if not ReadOnly
then
begin
inherited;
if FDataLink.Edit then FDataLink.Modified;
end;
end;
procedure TbsSkinDBCheckRadioBox.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
end;
function TbsSkinDBCheckRadioBox.UseRightToLeftAlignment: Boolean;
begin
Result := DBUseRightToLeftAlignment(Self, Field);
end;
function TbsSkinDBCheckRadioBox.GetFieldState: TCheckBoxState;
var
Text: string;
begin
if FDatalink.Field <> nil then
if FDataLink.Field.IsNull then
Result := cbGrayed
else if FDataLink.Field.DataType = ftBoolean then
if FDataLink.Field.AsBoolean then
Result := cbChecked
else
Result := cbUnchecked
else
begin
Result := cbGrayed;
Text := FDataLink.Field.Text;
if ValueMatch(FValueCheck, Text) then Result := cbChecked else
if ValueMatch(FValueUncheck, Text) then Result := cbUnchecked;
end
else
Result := cbUnchecked;
end;
procedure TbsSkinDBCheckRadioBox.DataChange(Sender: TObject);
var
State: TCheckBoxState;
begin
State := GetFieldState;
FChecked := State = cbChecked;
RePaint;
end;
procedure TbsSkinDBCheckRadioBox.UpdateData(Sender: TObject);
var
Pos: Integer;
S: string;
begin
if FDataLink.Field.DataType = ftBoolean then
FDataLink.Field.AsBoolean := Checked
else
begin
if Checked then S := FValueCheck else S := FValueUncheck;
Pos := 1;
FDataLink.Field.Text := ExtractFieldName(S, Pos);
end;
end;
function TbsSkinDBCheckRadioBox.ValueMatch(const ValueList, Value: string): Boolean;
var
Pos: Integer;
begin
Result := False;
Pos := 1;
while Pos <= Length(ValueList) do
if AnsiCompareText(ExtractFieldName(ValueList, Pos), Value) = 0 then
begin
Result := True;
Break;
end;
end;
function TbsSkinDBCheckRadioBox.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
procedure TbsSkinDBCheckRadioBox.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 TbsSkinDBCheckRadioBox.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;
procedure TbsSkinDBCheckRadioBox.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value;
end;
function TbsSkinDBCheckRadioBox.GetReadOnly: Boolean;
begin
Result := FDataLink.ReadOnly;
end;
procedure TbsSkinDBCheckRadioBox.SetReadOnly(Value: Boolean);
begin
FDataLink.ReadOnly := Value;
end;
function TbsSkinDBCheckRadioBox.GetField: TField;
begin
Result := FDataLink.Field;
end;
procedure TbsSkinDBCheckRadioBox.KeyPress(var Key: Char);
begin
inherited KeyPress(Key);
case Key of
#8, ' ':
FDataLink.Edit;
#27:
FDataLink.Reset;
end;
end;
procedure TbsSkinDBCheckRadioBox.SetValueCheck(const Value: string);
begin
FValueCheck := Value;
DataChange(Self);
end;
procedure TbsSkinDBCheckRadioBox.SetValueUncheck(const Value: string);
begin
FValueUncheck := Value;
DataChange(Self);
end;
procedure TbsSkinDBCheckRadioBox.WndProc(var Message: TMessage);
begin
inherited;
end;
procedure TbsSkinDBCheckRadioBox.CMExit(var Message: TCMExit);
begin
try
FDataLink.UpdateRecord;
except
SetFocus;
raise;
end;
inherited;
end;
procedure TbsSkinDBCheckRadioBox.CMGetDataLink(var Message: TMessage);
begin
Message.Result := Integer(FDataLink);
end;
function TbsSkinDBCheckRadioBox.ExecuteAction(Action: TBasicAction): Boolean;
begin
Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
FDataLink.ExecuteAction(Action);
end;
function TbsSkinDBCheckRadioBox.UpdateAction(Action: TBasicAction): Boolean;
begin
Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
FDataLink.UpdateAction(Action);
end;
{ TbsSkinDBListBox }
constructor TbsSkinDBListBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
FDataLink.OnUpdateData := UpdateData;
OnCheckButtonClick := CheckButtonClick;
end;
destructor TbsSkinDBListBox.Destroy;
begin
FDataLink.Free;
FDataLink := nil;
inherited Destroy;
end;
procedure TbsSkinDBListBox.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
end;
function TbsSkinDBListBox.UseRightToLeftAlignment: Boolean;
begin
Result := DBUseRightToLeftAlignment(Self, Field);
end;
procedure TbsSkinDBListBox.CheckButtonClick;
begin
if ReadOnly or not FDataLink.CanModify or not ListBox.Focused then Exit;
if FDataLink.Edit
then
FDataLink.Modified;
try
FDataLink.UpdateRecord;
except
SetFocus;
raise;
end;
end;
procedure TbsSkinDBListBox.DataChange(Sender: TObject);
begin
if FDataLink.Field <> nil
then
ItemIndex := Items.IndexOf(FDataLink.Field.Text)
else
ItemIndex := -1;
end;
procedure TbsSkinDBListBox.UpdateData(Sender: TObject);
begin
if ItemIndex >= 0 then
FDataLink.Field.Text := Items[ItemIndex] else
FDataLink.Field.Text := '';
end;
procedure TbsSkinDBListBox.ListBoxClick;
begin
inherited;
if FDataLink.Edit
then
FDataLink.Modified;
end;
function TbsSkinDBListBox.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
procedure TbsSkinDBListBox.SetDataSource(Value: TDataSource);
begin
FDataLink.DataSource := Value;
if Value <> nil then Value.FreeNotification(Self);
end;
function TbsSkinDBListBox.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;
procedure TbsSkinDBListBox.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value;
end;
function TbsSkinDBListBox.GetReadOnly: Boolean;
begin
Result := FDataLink.ReadOnly;
end;
procedure TbsSkinDBListBox.SetReadOnly(Value: Boolean);
begin
FDataLink.ReadOnly := Value;
end;
function TbsSkinDBListBox.GetField: TField;
begin
Result := FDataLink.Field;
end;
procedure TbsSkinDBListBox.ListBoxKeyDown;
begin
inherited;
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 TbsSkinDBListBox.ListBoxKeyPress;
begin
inherited;
case Key of
#32..#255:
if not FDataLink.Edit then Key := #0;
#27:
FDataLink.Reset;
end;
end;
type
TbsListBoxX = class(TbsListBox);
procedure TbsSkinDBListBox.ListBoxWProc(var Message: TMessage;
var Handled: Boolean);
begin
inherited;
case Message.Msg of
WM_LButtonDown:
if not (csDesigning in ComponentState)
then
with TWMLButtonDown(Message) do
begin
if not FDataLink.Edit
then
begin
ListBox.SetFocus;
TbsListBoxX(ListBox).MouseDown(mbLeft, KeysToShiftState(Keys), XPos, YPos);
Handled := False;
end;
end;
end;
end;
procedure TbsSkinDBListBox.ListBoxExit;
begin
try
FDataLink.UpdateRecord;
except
SetFocus;
raise;
end;
inherited;
end;
procedure TbsSkinDBListBox.SetItems(Value: TStrings);
begin
Items.Assign(Value);
DataChange(Self);
end;
function TbsSkinDBListBox.ExecuteAction(Action: TBasicAction): Boolean;
begin
Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
FDataLink.ExecuteAction(Action);
end;
function TbsSkinDBListBox.UpdateAction(Action: TBasicAction): Boolean;
begin
Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
FDataLink.UpdateAction(Action);
end;
{ TbsSkinDBComboBox }
constructor TbsSkinDBComboBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
FDataLink.OnUpdateData := UpdateData;
FInDataChange := True;
FInDateSelfChange := False;
end;
destructor TbsSkinDBComboBox.Destroy;
begin
FDataLink.Free;
FDataLink := nil;
inherited Destroy;
end;
procedure TbsSkinDBComboBox.Loaded;
begin
inherited Loaded;
if (csDesigning in ComponentState) then DataChange(Self);
end;
procedure TbsSkinDBComboBox.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
end;
procedure TbsSkinDBComboBox.CreateWnd;
begin
inherited CreateWnd;
end;
procedure TbsSkinDBComboBox.DataChange(Sender: TObject);
begin
FInDataChange := True;
if not FInDateSelfChange
then
begin
if FDataLink.Field <> nil
then
SetComboText(FDataLink.Field.Text)
else
if csDesigning in ComponentState
then
SetComboText(Name)
else
SetComboText('');
end;
FInDataChange := False;
end;
procedure TbsSkinDBComboBox.UpdateData(Sender: TObject);
begin
FDataLink.Field.Text := GetComboText;
end;
procedure TbsSkinDBComboBox.SetComboText(const Value: string);
var
I: Integer;
Redraw: Boolean;
begin
if Value <> GetComboText then
begin
if Style = bscbFixedStyle then
begin
Redraw := HandleAllocated;
try
if Value = '' then I := -1 else I := Items.IndexOf(Value);
ItemIndex := I;
finally
if Redraw then Invalidate;
end;
if I >= 0 then Exit;
end;
if Style = bscbEditStyle then Text := Value;
end;
end;
function TbsSkinDBComboBox.GetComboText: string;
var
I: Integer;
begin
if Style = bscbEditStyle then Result := Text else
begin
I := ItemIndex;
if I < 0 then Result := '' else Result := Items[I];
end;
end;
procedure TbsSkinDBComboBox.Change;
begin
inherited;
if not FInDataChange and not ReadOnly and FDataLink.CanModify
then
begin
FInDateSelfChange := True;
FDataLink.Edit;
FDataLink.Modified;
FInDateSelfChange := False;
end;
end;
function TbsSkinDBComboBox.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
procedure TbsSkinDBComboBox.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 TbsSkinDBComboBox.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;
procedure TbsSkinDBComboBox.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value;
end;
function TbsSkinDBComboBox.GetReadOnly: Boolean;
begin
Result := FDataLink.ReadOnly;
end;
procedure TbsSkinDBComboBox.SetReadOnly(Value: Boolean);
begin
FDataLink.ReadOnly := Value;
end;
function TbsSkinDBComboBox.GetField: TField;
begin
Result := FDataLink.Field;
end;
procedure TbsSkinDBComboBox.EditWindowProcHook;
begin
inherited;
case Message.Msg of
WM_SETFOCUS:
begin
if ReadOnly or not FDataLink.CanModify
then FEdit.ReadOnly := True;
end;
WM_KILLFOCUS:
begin
try
begin
FDataLink.UpdateRecord;
end;
except
raise;
end;
end;
end;
end;
procedure TbsSkinDBComboBox.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 TbsSkinDBComboBox.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;
end;
end;
end;
procedure TbsSkinDBComboBox.CMEnter(var Message: TCMEnter);
begin
inherited;
end;
procedure TbsSkinDBComboBox.CMExit(var Message: TCMExit);
begin
try
if ReadOnly or not FDataLink.CanModify
then
DataChange(Self)
else
FDataLink.UpdateRecord;
except
SetFocus;
raise;
end;
inherited;
end;
procedure TbsSkinDBComboBox.SetItems(Value: TStrings);
begin
Items.Assign(Value);
DataChange(Self);
end;
function TbsSkinDBComboBox.UseRightToLeftAlignment: Boolean;
begin
Result := DBUseRightToLeftAlignment(Self, Field);
end;
procedure TbsSkinDBComboBox.CMGetDatalink(var Message: TMessage);
begin
Message.Result := Integer(FDataLink);
end;
function TbsSkinDBComboBox.ExecuteAction(Action: TBasicAction): Boolean;
begin
Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
FDataLink.ExecuteAction(Action);
end;
function TbsSkinDBComboBox.UpdateAction(Action: TBasicAction): Boolean;
begin
Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
FDataLink.UpdateAction(Action);
end;
{ TbsSkinDBNavigator }
var
BtnTypeName: array[TbsNavigateBtn] of PChar = ('FIRST', 'PRIOR', 'NEXT',
'LAST', 'INSERT', 'DELETE', 'EDIT', 'POST', 'CANCEL', 'REFRESH');
BtnHints: array[TbsNavigateBtn] of String = ('FirstRecord', 'PriorRecord',
'NextRecord', 'LastRecord', 'InsertRecord', 'DeleteRecord', 'EditRecord',
'PostEdit', 'CancelEdit', 'RefreshRecord');
constructor TbsSkinDBNavigator.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle - [csAcceptsControls, csSetCaption] + [csOpaque];
if not NewStyleControls then ControlStyle := ControlStyle + [csFramed];
FSkinMessage := nil;
FAdditionalGlyphs := False;
FDataLink := TbsNavDataLink.Create(Self);
FVisibleButtons := [nbFirst, nbPrior, nbNext, nbLast, nbInsert,
nbDelete, nbEdit, nbPost, nbCancel, nbRefresh];
FHints := TStringList.Create;
TStringList(FHints).OnChange := HintsChanged;
InitButtons;
InitHints;
Width := 241;
Height := 25;
ButtonWidth := 0;
FConfirmDelete := True;
BorderStyle := bvNone;
FBtnSkinDataName := 'button';
end;
procedure TbsSkinDBNavigator.SetAdditionalGlyphs;
var
I: TbsNavigateBtn;
ResName: String;
begin
if Value <> FAdditionalGlyphs
then
begin
FAdditionalGlyphs := Value;
for I := Low(Buttons) to High(Buttons) do
begin
FmtStr(ResName, 'bsdbn_%s', [BtnTypeName[I]]);
if FAdditionalGlyphs then ResName := ResName + '1';
Buttons[I].Glyph.LoadFromResourceName(HInstance, ResName);
Buttons[I].RePaint;
end;
end;
end;
destructor TbsSkinDBNavigator.Destroy;
begin
FDefHints.Free;
FDataLink.Free;
FHints.Free;
FDataLink := nil;
inherited Destroy;
end;
procedure TbsSkinDBNavigator.ChangeSkinData;
var
i: Integer;
begin
inherited;
if (FIndex <> -1) and (GetResizeMode = 1) and (FBtnSkinDataName <> '')
then
begin
i := SkinData.GetControlIndex(FBtnSkinDataName);
if i <> -1
then
with TbsDataSkinButtonControl(FSD.CtrlList.Items[i]) do
begin
if (LBPoint.X = 0) and (LBPoint.Y = 0)
then
Height := SkinRect.Bottom - SkinRect.Top;
end;
end;
end;
procedure TbsSkinDBNavigator.SetSkinData;
var
I: TbsNavigateBtn;
begin
inherited;
for I := Low(Buttons) to High(Buttons) do
with Buttons[I] do
begin
SkinData := Self.SkinData;
end;
end;
procedure TbsSkinDBNavigator.SetBtnSkinDataName;
var
I: TbsNavigateBtn;
begin
FBtnSkinDataName := Value;
for I := Low(Buttons) to High(Buttons) do
with Buttons[I] do
begin
SkinDataName := FBtnSkinDataName;
end;
end;
procedure TbsSkinDBNavigator.Paint;
begin
if VisibleButtons = []
then
inherited;
end;
procedure TbsSkinDBNavigator.InitButtons;
var
I: TbsNavigateBtn;
Btn: TbsNavButton;
X: Integer;
ResName: string;
begin
MinBtnSize := Point(20, 18);
X := 0;
for I := Low(Buttons) to High(Buttons) do
begin
Btn := TbsNavButton.Create (Self);
Btn.CanFocused := True;
Btn.Index := I;
Btn.Visible := I in FVisibleButtons;
Btn.Enabled := True;
Btn.SetBounds (X, 0, MinBtnSize.X, MinBtnSize.Y);
FmtStr(ResName, 'bsdbn_%s', [BtnTypeName[I]]);
if FAdditionalGlyphs then ResName := ResName + '1';
Btn.Glyph.LoadFromResourceName(HInstance, ResName);
Btn.NumGlyphs := 2;
Btn.Enabled := False;
Btn.Enabled := True;
Btn.OnClick := ClickHandler;
Btn.Parent := Self;
Buttons[I] := Btn;
X := X + MinBtnSize.X;
end;
Buttons[nbPrior].NavStyle := Buttons[nbPrior].NavStyle + [nsAllowTimer];
Buttons[nbNext].NavStyle := Buttons[nbNext].NavStyle + [nsAllowTimer];
end;
procedure TbsSkinDBNavigator.InitHints;
var
I: Integer;
J: TbsNavigateBtn;
begin
if not Assigned(FDefHints) then
begin
FDefHints := TStringList.Create;
for J := Low(Buttons) to High(Buttons) do
FDefHints.Add(BtnHints[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 TbsSkinDBNavigator.HintsChanged(Sender: TObject);
begin
InitHints;
end;
procedure TbsSkinDBNavigator.SetHints(Value: TStrings);
begin
if Value.Text = FDefHints.Text then
FHints.Clear else
FHints.Assign(Value);
end;
function TbsSkinDBNavigator.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 TbsSkinDBNavigator.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
end;
procedure TbsSkinDBNavigator.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
if (Operation = opRemove) and (FSkinMessage <> nil) and
(AComponent = FSkinMessage) then FSkinMessage := nil;
end;
procedure TbsSkinDBNavigator.SetVisible(Value: TbsButtonSet);
var
I: TbsNavigateBtn;
W, H: Integer;
begin
W := Width;
H := Height;
FVisibleButtons := Value;
for I := Low(Buttons) to High(Buttons) do
Buttons[I].Visible := I in FVisibleButtons;
SetSize(W, H);
if (W <> Width) or (H <> Height) then
inherited SetBounds (Left, Top, W, H);
Invalidate;
end;
procedure TbsSkinDBNavigator.CalcMinSize(var W, H: Integer);
var
Count: Integer;
I: TbsNavigateBtn;
begin
if (csLoading in ComponentState) then Exit;
if Buttons[nbFirst] = 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 TbsSkinDBNavigator.SetSize(var W: Integer; var H: Integer);
var
Count: Integer;
I: TbsNavigateBtn;
Space, Temp, Remain: Integer;
X: Integer;
begin
if (csLoading in ComponentState) then Exit;
if Buttons[nbFirst] = 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 TbsSkinDBNavigator.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 TbsSkinDBNavigator.WMSize(var Message: TWMSize);
var
W, H: Integer;
begin
inherited;
W := Width;
H := Height;
SetSize(W, H);
end;
procedure TbsSkinDBNavigator.WMWindowPosChanging(var Message: TWMWindowPosChanging);
begin
inherited;
if (SWP_NOSIZE and Message.WindowPos.Flags) = 0 then
CalcMinSize(Message.WindowPos.cx, Message.WindowPos.cy);
end;
procedure TbsSkinDBNavigator.ClickHandler(Sender: TObject);
begin
BtnClick (TbsNavButton (Sender).Index);
end;
procedure TbsSkinDBNavigator.BtnClick(Index: TbsNavigateBtn);
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
nbPrior: Prior;
nbNext: Next;
nbFirst: First;
nbLast: Last;
nbInsert: Insert;
nbEdit: Edit;
nbCancel: Cancel;
nbPost: Post;
nbRefresh: Refresh;
nbDelete:
if (FSkinMessage <> nil)
then
begin
if not FConfirmDelete or
(FSkinMessage.MessageDlg('Delete record?', mtConfirmation,
[mbOK, mbCancel], 0) <> idCancel) then Delete;
end
else
begin
if not FConfirmDelete or
(MessageDlg('Delete record?', mtConfirmation,
mbOKCancel, 0) <> idCancel) then Delete;
end;
end;
end;
end;
if not (csDesigning in ComponentState) and Assigned(FOnNavClick) then
FOnNavClick(Self, Index);
end;
procedure TbsSkinDBNavigator.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
Message.Result := DLGC_WANTARROWS;
end;
procedure TbsSkinDBNavigator.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[nbFirst].Enabled := UpEnable;
Buttons[nbPrior].Enabled := UpEnable;
Buttons[nbNext].Enabled := DnEnable;
Buttons[nbLast].Enabled := DnEnable;
Buttons[nbDelete].Enabled := Enabled and FDataLink.Active and
FDataLink.DataSet.CanModify and
not (FDataLink.DataSet.BOF and FDataLink.DataSet.EOF);
end;
procedure TbsSkinDBNavigator.EditingChanged;
var
CanModify: Boolean;
begin
CanModify := Enabled and FDataLink.Active and FDataLink.DataSet.CanModify;
Buttons[nbInsert].Enabled := CanModify;
Buttons[nbEdit].Enabled := CanModify and not FDataLink.Editing;
Buttons[nbPost].Enabled := CanModify and FDataLink.Editing;
Buttons[nbCancel].Enabled := CanModify and FDataLink.Editing;
Buttons[nbRefresh].Enabled := CanModify;
end;
procedure TbsSkinDBNavigator.ActiveChanged;
var
I: TbsNavigateBtn;
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 TbsSkinDBNavigator.CMEnabledChanged(var Message: TMessage);
begin
inherited;
if not (csLoading in ComponentState) then
ActiveChanged;
end;
procedure TbsSkinDBNavigator.SetDataSource(Value: TDataSource);
begin
FDataLink.DataSource := Value;
if not (csLoading in ComponentState) then
ActiveChanged;
if Value <> nil then Value.FreeNotification(Self);
end;
function TbsSkinDBNavigator.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
procedure TbsSkinDBNavigator.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;
{TbsNavButton}
destructor TbsNavButton.Destroy;
begin
if FRepeatTimer <> nil then
FRepeatTimer.Free;