bsdbgrids.pas

BusinessSkinForm的控件包与实例

    procedure WMKillFocus(var Message: TMessage); message WM_KillFocus;
  protected
    FUpdateFields: Boolean;
    FAcquireFocus: Boolean;
    procedure DrawSkinCheckImage(Cnvs: TCanvas; R: TRect; AChecked: Boolean);
    procedure DrawSkinGraphic(F: TField; Cnvs: TCanvas; R: TRect);
    procedure WMChar(var Msg: TWMChar); message WM_CHAR;
    procedure PickListBoxOnCheckButtonClick(Sender: TObject);
    procedure SetHScrollBar(Value: TbsSkinScrollBar); override;
    procedure UpdateScrollPos(UpDateVert: Boolean); override;
    procedure UpdateScrollRange(UpDateVert: Boolean); override;

    function  RawToDataColumn(ACol: Integer): Integer;
    function  DataToRawColumn(ACol: Integer): Integer;
    function  AcquireLayoutLock: Boolean;
    procedure BeginLayout;
    procedure BeginUpdate;
    procedure CalcSizingState(X, Y: Integer; var State: TbsGridState;
      var Index: Longint; var SizingPos, SizingOfs: Integer;
      var FixedInfo: TbsGridDrawInfo); override;
    procedure CancelLayout;
    function  CanEditAcceptKey(Key: Char): Boolean; override;
    function  CanEditModify: Boolean; override;
    function  CanEditShow: Boolean; override;
    procedure CellClick(Column: TbsColumn); dynamic;
    procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
    function CalcTitleRect(Col: TbsColumn; ARow: Integer;
      var MasterCol: TbsColumn): TRect;
    function ColumnAtDepth(Col: TbsColumn; ADepth: Integer): TbsColumn;
    procedure ColEnter; dynamic;
    procedure ColExit; dynamic;
    procedure ColWidthsChanged; override;
    function  CreateColumns: TbsDBGridColumns; dynamic;
    function  CreateEditor: TbsSkinInplaceEdit; override;
    procedure CreateWnd; override;
    procedure DeferLayout;
    procedure DefineFieldMap; virtual;
    procedure DefineProperties(Filer: TFiler); override;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
    procedure DrawSkinCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
    procedure DrawDefaultCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
    procedure DrawDataCell(const Rect: TRect; Field: TField;
      State: TGridDrawState); dynamic; { obsolete }
    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
      Column: TbsColumn; State: TGridDrawState); dynamic;
    procedure EditButtonClick; dynamic;
    procedure EndLayout;
    procedure EndUpdate;
    function  GetColField(DataCol: Integer): TField;
    function  GetEditLimit: Integer; override;
    function  GetEditMask(ACol, ARow: Longint): string; override;
    function  GetEditText(ACol, ARow: Longint): string; override;
    function  GetFieldValue(ACol: Integer): string;
    function  HighlightCell(DataCol, DataRow: Integer; const Value: string;
      AState: TGridDrawState): Boolean; virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure InvalidateTitles;
    procedure LayoutChanged; virtual;
    procedure LinkActive(Value: Boolean); virtual;
    procedure Loaded; override;
    procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Scroll(Distance: Integer); virtual;
    procedure SetColumnAttributes; virtual;
    procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
    function  StoreColumns: Boolean;
    procedure TimedScroll(Direction: TGridScrollDirection); override;
    procedure TitleClick(Column: TbsColumn); dynamic;
    procedure TopLeftChanged; override;
    function UseRightToLeftAlignmentForField(const AField: TField;
      Alignment: TAlignment): Boolean;
    function BeginColumnDrag(var Origin, Destination: Integer;
      const MousePt: TPoint): Boolean; override;
    function CheckColumnDrag(var Origin, Destination: Integer;
      const MousePt: TPoint): Boolean; override;
    function EndColumnDrag(var Origin, Destination: Integer;
      const MousePt: TPoint): Boolean; override;
    property Columns: TbsDBGridColumns read FColumns write SetColumns;
    property DefaultDrawing: Boolean read FDefaultDrawing write FDefaultDrawing default True;
    property DataLink: TbsGridDataLink read FDataLink;
    property IndicatorOffset: Byte read FIndicatorOffset;
    property LayoutLock: Byte read FLayoutLock;
    property Options: TbsDBGridOptions read FOptions write SetOptions
      default [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColLines,
      dgRowLines, dgTabs, dgConfirmDelete, dgCancelOnExit];
    property ParentColor default False;
    property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
    property SelectedRows: TbsBookmarkList read FBookmarks;
    property TitleFont: TFont read FTitleFont write SetTitleFont;
    property UpdateLock: Byte read FUpdateLock;
    property SaveMultiSelection: Boolean read
      FSaveMultiSelection write FSaveMultiSelection;
    property OnGetCellParam: TGetDBCellParamEvent
      read FOnGetCellParam write FOnGetCellParam;
    property OnColEnter: TNotifyEvent read FOnColEnter write FOnColEnter;
    property OnColExit: TNotifyEvent read FOnColExit write FOnColExit;
    property OnDrawDataCell: TDrawDataCellEvent read FOnDrawDataCell
      write FOnDrawDataCell; { obsolete }
    property OnDrawColumnCell: TDrawColumnCellEvent read FOnDrawColumnCell
      write FOnDrawColumnCell;
    property OnEditButtonClick: TNotifyEvent read FOnEditButtonClick
      write FOnEditButtonClick;
    property OnColumnMoved: TMovedEvent read FOnColumnMoved write FOnColumnMoved;
    property OnCellClick: TDBGridClickEvent read FOnCellClick write FOnCellClick;
    property OnTitleClick: TDBGridClickEvent read FOnTitleClick write FOnTitleClick;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ChangeSkinData; override;
    procedure DefaultDrawDataCell(const Rect: TRect; Field: TField;
      State: TGridDrawState); { obsolete }
    procedure DefaultDrawColumnCell(const Rect: TRect; DataCol: Integer;
      Column: TbsColumn; State: TGridDrawState);
    procedure DefaultHandler(var Msg); override;
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    procedure ShowPopupEditor(Column: TbsColumn; X: Integer = Low(Integer);
      Y: Integer = Low(Integer)); dynamic;
    function UpdateAction(Action: TBasicAction): Boolean; override;
    function ValidFieldIndex(FieldIndex: Integer): Boolean;
    property SkinMessage: TbsSkinMessage read FSkinMessage write FSkinMessage;
    property EditorMode;
    property FieldCount: Integer read GetFieldCount;
    property Fields[FieldIndex: Integer]: TField read GetFields;
    property SelectedField: TField read GetSelectedField write SetSelectedField;
    property SelectedIndex: Integer read GetSelectedIndex write SetSelectedIndex;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property PickListBoxSkinDataName: String read FPickListBoxSkinDataName
                                         write FPickListBoxSkinDataName;
    property PickListBoxCaptionMode: Boolean read FPickListBoxCaptionMode
                                         write FPickListBoxCaptionMode;
    property MouseWheelSupport: Boolean
      read FMouseWheelSupport write FMouseWheelSupport;
    property UseColumnsFont: Boolean
      read FUseColumnsFont write FUseColumnsFont;
    property DrawGraphicFields: Boolean
     read FDrawGraphicFields write FDrawGraphicFields; 
  published
    property Font;
  end;

  TbsSkinDBGrid = class(TbsSkinCustomDBGrid)
  public
    property Canvas;
    property SelectedRows;
  published
    property DrawGraphicFields;
    property UseColumnsFont;
    property DefaultRowHeight;
    property DefaultColWidth;
    property BiDiMode;
    property MouseWheelSupport;
    property SkinMessage;
    property SaveMultiSelection;
    property PickListBoxSkinDataName;
    property PickListBoxCaptionMode;
    property Align;
    property Anchors;
    property BorderStyle;
    property Color;
    property Columns stored False; 
    property Constraints;
    property Ctl3D;
    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 ParentColor;
    property ParentCtl3D;
    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;
    property OnGetCellParam;
  end;

const
  IndicatorWidth = 11;

implementation

uses Math, DBConsts, Dialogs, bsConst;

{$R BSDBGRIDS.RES}

const
  bmArrow = 'BSDBGARROW';
  bmEdit = 'BSDBEDIT';
  bmInsert = 'BSDBINSERT';
  bmMultiDot = 'BSDBMULTIDOT';
  bmMultiArrow = 'BSDBMULTIARROW';

  MaxMapSize = (MaxInt div 2) div SizeOf(Integer);  { 250 million }


type
  TParentGrid = class(TbsSkinCustomDBGrid);

{ Error reporting }

procedure RaiseGridError(const S: string);
begin
//  raise EInvalidGridOperation.Create(S);
end;

procedure KillMessage(Wnd: HWnd; Msg: Integer);
var
  M: TMsg;
begin
  M.Message := 0;
  if PeekMessage(M, Wnd, Msg, Msg, pm_Remove) and (M.Message = WM_QUIT) then
    PostQuitMessage(M.wparam);
end;

{ TDBGridInplaceEdit }

type
  TEditStyle = (esSimple, esEllipsis, esPickList, esDataList);

  TbsDBPopupListbox = class;

  TDBGridInplaceEdit = class(TbsSkinInplaceEdit)
  private
    FButtonWidth: Integer;
    FDataList: TbsPopupDataList;
    FPickList: TbsDBPopupListbox;
    FActiveList: TWinControl;
    FLookupSource: TDatasource;
    FEditStyle: TEditStyle;
    FListVisible: Boolean;
    FTracking: Boolean;
    FPressed: Boolean;
    procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SetEditStyle(Value: TEditStyle);
    procedure StopTracking;
    procedure TrackButton(X,Y: Integer);
    procedure CMCancelMode(var Message: TCMCancelMode); message CM_CancelMode;
    procedure WMCancelMode(var Message: TMessage); message WM_CancelMode;
    procedure WMKillFocus(var Message: TMessage); message WM_KillFocus;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message wm_LButtonDblClk;
    procedure WMPaint(var Message: TWMPaint); message wm_Paint;
    procedure WMSetCursor(var Message: TWMSetCursor); message WM_SetCursor;
    function OverButton(const P: TPoint): Boolean;
    function ButtonRect: TRect;
  protected
    function IsValidChar(Key: Char): Boolean;
    procedure KeyPress(var Key: Char); override;
    procedure BoundsChanged; override;
    procedure DoDropDownKeys(var Key: Word; Shift: TShiftState);
    procedure DropDown;
    procedure KeyDown(var Key: Word; Shift: TShiftState); 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 PaintWindow(DC: HDC); override;
    procedure UpdateContents; override;
    procedure WndProc(var Message: TMessage); override;
    property  EditStyle: TEditStyle read FEditStyle write SetEditStyle;
    property  ActiveList: TWinControl read FActiveList write FActiveList;
    property  DataList: TbsPopupDataList read FDataList;
    property  PickList: TbsDBPopupListbox read FPickList;
  public
    procedure CloseUp(Accept: Boolean);
    constructor Create(Owner: TComponent); override;
  end;

{ TbsDBPopupListbox }

  TbsDBPopupListbox = class(TbsPopupListBox)
  protected
    FListBoxWindowProc: TWndMethod;
    procedure ListBoxWindowProcHook(var Message: TMessage);
    procedure ListBoxMouseMove(Sender: TObject; Shift: TShiftState;
              X, Y: Integer);
  public
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
  end;

constructor TbsDBPopupListbox.Create(Owner: TComponent);
begin
  inherited;
  FListBoxWindowProc := ListBox.WindowProc;
  ListBox.WindowProc := ListBoxWindowProcHook;
  ListBox.OnMouseMove := ListBoxMouseMove;
end;

destructor TbsDBPopupListbox.Destroy;
begin
  inherited;
end;

procedure TbsDBPopupListbox.ListBoxWindowProcHook(var Message: TMessage);
var
  FOld: Boolean;
begin
  FOld := True;
  case Message.Msg of
     WM_LBUTTONUP:
       begin
         TDBGridInPlaceEdit(Owner).CloseUp(True);
       end;
     WM_RBUTTONDOWN, WM_RBUTTONUP,
     WM_MBUTTONDOWN, WM_MBUTTONUP,
     WM_LBUTTONDOWN:
       begin
         FOLd := False;
       end;
     WM_MOUSEACTIVATE:
      begin
        Message.Result := MA_NOACTIVATE;
      end;
  end;
  if FOld then FListBoxWindowProc(Message);
end;

procedure TbsDBPopupListbox.ListBoxMouseMove(Sender: TObject; Shift: TShiftState;
                           X, Y: Integer);

var
  Index: Integer;
begin
  Index := ListBox.ItemAtPos(Point (X, Y), True);
  if (Index >= 0) and (Index < Items.Count)
  then
    ItemIndex := Index;
end;

constructor TDBGridInplaceEdit.Create(Owner: TComponent);
begin
  inherited Create(Owner);
  FLookupSource := TDataSource.Create(Self);
  FButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
  FEditStyle := esSimple;
end;

procedure TDBGridInplaceEdit.KeyPress(var Key: Char);
begin
  if not IsValidChar(Key) then
  begin
    Key := #0;
    MessageBeep(0)
  end;
  if Key <> #0 then inherited KeyPress(Key);
end;

function TDBGridInplaceEdit.IsValidChar(Key: Char): Boolean;
var
  CharCode: Integer;
  DBGrid: TbsSkinCustomDBGrid;
  FT: TFieldType;
  CellIndex: Integer;
begin
  DBGrid := TbsSkinCustomDBGrid(Grid);
  if dgIndicator in  DBGrid.Options
  then
    CellIndex :=  DBGrid.Col - 1
  else
    CellIndex :=  DBGrid.Col;
  if not Assigned(DBGrid.Columns[CellIndex].Field) then Exit;
  FT := DBGrid.Columns[CellIndex].Field.DataType;
  if (Key = '-') or (Key = '+') or (Key = DecimalSeparator)
  then
    begin
      case FT of
        ftSmallint, ftInteger,
        ftFloat, ftCurrency:
          Result := not (
                    ((Key = DecimalSeparator) and
                     (Pos(DecimalSeparator, Text) <> 0)) or