wwdbgrid.pas

胜天进销存源码,国产优秀的进销存

unit Wwdbgrid;
{
//
// Components : TwwDBGrid
//
// Copyright (c) 1995-2001 by Woll2Woll Software
//
// 7/19/97 - Only readjust customedit rectangle if cell boundary left,right
//           has changed.  Previoulsy would readjust even on height change
//           which caused a flicker with a lookupcombo that had its icon too
//           big to fit into the cell.
// 8/12/97 - Optimization for screen painting.  Check if field is TBlobField
//           before calling IsRichEditCell
// 8/14/97 - Optimized logic to speed painting of grid in
//           function IsRichEditCell and IsCustomEditCell
// 9/2/97  - Override isCustomEditCell so that it ignores record-view when
//           mapping
// 9/4/97  - fctRichEdit same path as customEdit in SetControlType method
// 9/15/97 - Hidecontrols needed to be changed to HideControls.
// 9/19/97 - Allow multi-selection checkbox to be toggled even when editing is
//           not allowed
// 10/24/97- Only toggle checkboxes if can edit grid or multi-selection checkbox
// 12/02/97- Added try block on gotobookmark to catch exception when bkmrk2 is invalid
//
// 1/9/98  - Only set focus if canFocus is true
// 1/25/98 - Add EditControlOptions | DisableCustomControls so record-panel
//           and grid will not both be using the same edit control.
// 1/28/97 - Allow Change of text when there is a protected flag in richtext to handle
//           TRichEdit bug.
// 3/11/98 - Auto-invalidate if grid rowcount or colcount changes
// 3/20/98 - Prevent flicker when control becomes visible by only calling update
//           for control
// 3/20/98 - Rely on edit control to selectAll when control is made visible
//           with dgAlwaysShowEditor as True
// 4/9/98 -  Clear currentcustomedit when table is made active
// 5/13/98 - Fix memory leak for ShiftSelectBookmark
// 8/13/98 - Fix for datetimepicker disabling bug
// 10/6/98 - Support display of simple text even when field is defined as a rich
//           edit text.
// 10/27/98 -Update MouseCoord method to support bdRightToLeft - Delphi's
//           version does not support fixed columns.
// 11/26/98 - Respect readonly property of related field for default datetimepicker
// 12/7/98 - Correct OnColWidthChanged event passing the wrong column
// 1/26/99 - Prevent clearing of grid when hiding controls
// 2/19/99 - Default datetimepicker should go through default datetimepicker
//           specfic code when changing columns.  Fixes Readonly problem for
//           default datetimepicker
// 3/17/99 - Fire OnMultiSelectRecord with ShiftSelect
// 6/28/99 - Fire OnKeyPress event even when rowselect/edit=false on custom control field
// 9/30/99 - Handle INI file issues with datamodule and FormCreate. (PYW)
// 2/19/00 - Create RefreshActiveControl method to call from ApplySelected
//           This removes the dependency upon the column changing for the control
//           information to be updated.
// 3/6/00 - Add new fields to dynamic selected property from selected property generated by iniattributes
// 3/9/00 - OnColEnter being fired twice
// 4/24/00 - Don't toggle checkbox when dataset is readonly
// 5/4/00 - publish OnStartDrag property
// 8/11/00 - Make LoadFromIniFile and SaveToIniFile virtual
// 4/12/01 - Don't load from ini when design-time
// 4/12/01 - Added Grid exporting capability.
// 8/22/01 - Don't set focus if active form is not for this grid
//           For instance, in case there was validation in the tfield.onvalidate event
//           which showed a message
// 9/26/01 - Added new event to allow formating of SYLK data export when exporting to a file. -PYW
// 10/28/01 - Otherwise mapped values not respected
// 12/11/01 - RSW - Don't pass to inherited KeyDown as then focus can get lost causing datetimepicker to not dropdown
// 1/9/2002 - Added patch[5] for backwards compatibility when exiting the grid error messages from onvalidate were not
//            displayed. Using a Patch variable to provide solution while studying impact.
// 3/14/2002- PYW - Only SelectRecord/UnSelectRecord if multiselect and RowSelect enabled and space is pressed.
//            Otherwise space on a checkbox will not be respected thus breaking backwards compatibility.
// 4/16/2002 - If an exception is raised in HideControls when a customedit loses focus and the grid gets it.
// 5/8/2002 - PYW - Corrected some TCustomGrid ColSizing bugs.
// 5/16/02 - Add test to see if the grid is the activecontrol before setting focus.
// 4/15/03 - Publish DittoAttributes
// 9/24/03 - When toggling checkbox in righttoleft, extra painting was done.
// 7/29/04 - Fix bug when expanded with multi-select. It checks wrong row before
}

interface
{$i wwIfDef.pas}

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, StdCtrls,
  Forms, Grids, {DsgnIntf, }dialogs, dbtables, db, wwstr,
  wwtable, wwMemo, wwcommon, wwdbigrd, wwdbdatetimepicker, wwexport,
  {$ifdef win32}
  comctrls, wwriched,
  {$endif}
  Menus, wwdatsrc, wwdbedit, wwtypes, dbctrls, inifiles, registry;

{$C PRELOAD}

type
  TwwFieldControlType = (fctNone, fctField, fctCheckBox, fctCustom, fctBitmap,
                         fctLookupCombo, fctComboBox, fctRichEdit, fctImageIndex,
                         fctURLLink);
  TwwOnInitMemoDlgEvent = procedure(Dialog : TwwMemoDlg) of object;
  TwwMemoUserButtonEvent = procedure(Dialog: TwwMemoDlg; Memo: TMemo) of object;
  TwwCreateDTPEvent = procedure(Sender: TObject;
       ADateTimePicker: TwwDBCustomDateTimePicker) of object;
  TwwDBGrid = class;

  TwwIniAttributes = class(TPersistent)
  private
     FFormName:string;
     FFileName, FSectionName, FDelimiter: string;
     FEnabled:Boolean;
     FSaveToRegistry : Boolean;
     FCheckNewFields: boolean;
     procedure SetFileName(val: string);
     procedure SetSectionName(val: string);
     procedure SetDelimiter(val: string);
     procedure SetEnabled(val: boolean);
     function GetSectionName : string;
     function GetFileName : string;
  public
     Owner: TComponent;
     property FormName:string read FFormName;
  published
     property Enabled: boolean read FEnabled write SetEnabled default False;
     property SaveToRegistry: boolean read FSaveToRegistry write FSaveToRegistry default False;
     property FileName: string read GetFileName write SetFileName;
     property SectionName: string read GetSectionName write SetSectionName;
     property Delimiter: string read FDelimiter write SetDelimiter;
     property CheckNewFields: boolean read FCheckNewFields write FCheckNewFields default false;
  end;

  TwwMemoDialog = class(TComponent)
  private
     FFont: TFont;
     FDataLink: TFieldDataLink;
     FMemoAttributes: TwwMemoAttributes;
     FCaption: String;
     FLeft, FTop, FWidth, FHeight: integer;

     { IP 2.0 additions }
     FUserButton1Click: TwwMemoUserButtonEvent;
     FUserButton2Click: TwwMemoUserButtonEvent;
     FOnInitDialog: TwwOnInitMemoDlgEvent;
     FOnCloseDialog: TwwOnInitMemoDlgEvent;
     FUserButton1Caption: string;
     FUserButton2Caption: string;
     FLines: TStrings;
     procedure SetLines(val: TStrings);
  protected
     procedure SetDataField(value: String);
     procedure SetDataSource(value : TDataSource);
     Function GetDataSource: TDataSource;
     Function GetDataField: String;
     procedure SetwwMemoAttributes(sel: TwwMemoAttributes);
     procedure SetFont(Value: TFont);
     procedure SetCaption(Value: String);
  public
     Form: TwwMemoDlg;  { Used by TwwMemoDlg }
     Patch: Variant;
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure DoInitDialog; virtual;  { called by wwmemo }
     procedure DoCloseDialog; virtual;  { called by wwmemo }

  published
     property DataSource: TDataSource read getDataSource write setDataSource;
     property DataField: String read getDataField write setDataField;
     function Execute: boolean; virtual;
     property Font: TFont read FFont write SetFont;
     property MemoAttributes : TwwMemoAttributes
        read FMemoAttributes write setwwMemoAttributes
        default [mSizeable, mWordWrap];
     property Caption: string read FCaption write setCaption;
     property Lines: TStrings read FLines write SetLines;

     property DlgLeft: integer read FLeft write FLeft;
     property DlgTop: integer read FTop write FTop;
     property DlgWidth: integer read FWidth write FWidth;
     property DlgHeight: integer read FHeight write FHeight;

     property OnInitDialog: TwwOnInitMemoDlgEvent read FOnInitDialog write FOnInitDialog;
     property OnCloseDialog: TwwOnInitMemoDlgEvent read FOnCloseDialog write FOnCloseDialog;
     property OnUserButton1Click: TwwMemoUserButtonEvent read FUserButton1Click write FUserButton1Click;
     property OnUserButton2Click: TwwMemoUserButtonEvent read FUserButton2Click write FUserButton2Click;
     property UserButton1Caption: string read FUserButton1Caption write FUserButton1Caption;
     property UserButton2Caption: string read FUserButton2Caption write FUserButton2Caption;

  end;


  TwwMemoOpenEvent =
     procedure (Grid: TwwDBGrid; MemoDialog: TwwMemoDialog) of object;

  TwwMemoCloseEvent =
     procedure (Grid: TwwDBGrid; Cancel: boolean) of object;

  TwwSelectRecordEvent =
     procedure (Grid: TwwDBGrid; Selecting: boolean; var Accept: boolean) of object;

  TwwSelectAllRecordEvent =
     procedure (Grid: TwwDBGrid; Selecting: boolean; var Accept: boolean) of object;

  TwwExportFieldEvent =
     procedure (Grid: TwwDBGrid; Field: TField; var Accept: boolean) of object;

  TwwExportSYLKFormatEvent =
     procedure (Grid: TwwDBGrid; Field: TField; var SYLKFormat:String) of object;

//PwwCustomControlItem = ^TwwCustomControlItem;

TwwDBGrid = class(TwwCustomDBGrid)
  private
    FSizingIndex, FSizingPos, FSizingOfs: integer;
    FMemoAttributes : TwwMemoAttributes;
    FIniAttributes : TwwIniAttributes;
    FExportOptions : TwwExportOptions;
    redrawingGrid: Boolean;
    initialized: Boolean;
    doneInitControls: boolean;
    drawingCell: Boolean;
//    currentComboBoxRow, currentComboBoxCol: integer;
    FOnMemoOpen: TwwMemoOpenEvent;
    FOnMemoClose: TwwMemoCloseEvent;
    FFixedCols: integer;
    FDirtyIni: boolean;
    inLinkActive: boolean;
    inTopLeftChanged: boolean;
    GridIsLoaded: boolean;
    FOnSelectRecord : TwwSelectRecordEvent;
    FOnSelectAllRecords : TwwSelectAllRecordEvent;
    FOnExportField : TwwExportFieldEvent;
    FOnExportSYLKFormat : TwwExportSYLKFormatEvent;
    FOnCreateDateTimePicker: TwwCreateDTPEvent;
    FLoadAllRTF: boolean;
    OrigSelected: TStrings;

    { Multi-selection support variables}
    Bookmarks: TList;
    FDependentComponents: Tlist;
    MakeCustomControlVisible: boolean;
    FDisableThemes: boolean;

//    FCustomControls: array of TwwCustomControlItem;
    Function GetTitleColor: TColor;
    procedure SetTitleColor(sel: TColor);
//    Function GetDataLineColor: TColor;
//    procedure SetDatalineColor(sel: TColor);

    Function GetDataSource: TDataSource;
    Procedure SetDataSource(val: TDataSource);

    procedure SetwwMemoAttributes(sel: TwwMemoAttributes);
    procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
    procedure WMLButtonDblClk(var Msg: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    procedure WMChar(var Msg: TWMChar); message WM_CHAR;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;

    procedure UpdateSelectedProperty;
    function GetDateTimePicker: TwwDBCustomDateTimePicker;
    procedure DrawSizingLine(const DrawInfo: TGridDrawInfo);

  protected
    SelectedRecordList: TStrings; { Internal buffers selected value }

    procedure ShowCurrentControl; virtual;
    procedure AdjustLeftCol; virtual;
    procedure CalcSizingState(X, Y: Integer; var State: TGridState;
      var Index: Longint; var SizingPos, SizingOfs: Integer;
      var FixedInfo: TGridDrawInfo); override;
    procedure CreateWnd; override;

    function CreateDateTimePicker: TwwDBCustomDateTimePicker; virtual;
    procedure DoCreateDateTimePicker(ADateTimePicker: TwwDBCustomDateTimePicker); virtual;

    procedure CalcRowHeight; override;

    procedure DoExit; override;
    procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
    procedure ColWidthsChanged; override;
    procedure LinkActive(value: boolean); override;
    procedure SetFieldValue(ACol: Integer; val: string);
    function CanEditShow: Boolean; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure ColExit; override;
    procedure TopLeftChanged; override;
    Function AllowCancelOnExit: boolean; override;

    procedure ToggleCheckBox(col, row: integer);
    procedure InitControls;
    procedure SetFixedCols(val: integer);
    function GetFixedCols: integer;
    procedure Paint; override;
    function IsWWControl(ACol, ARow: integer): boolean; override;
    procedure CallMemoDialog;
    Function findBookmark: TBookmark;

    Function CellColor(ACol, ARow: integer): TColor; override;
    procedure RefreshBookmarkList; override;
    procedure Scroll(Distance: Integer); override;
    procedure Loaded; override;
    procedure SelectRecordRange(bkmrk1, bkmrk2: TBookmark); virtual;
    Procedure RemoveSelected(bkmrk1, bkmrk2: TBookmark); virtual;
    Function IsSelectedRow(DataRow: integer): boolean; override;
    procedure RefreshActiveControl; virtual;
    function IsActiveControl: Boolean;

//    procedure PaintWindow(DC: HDC); override;

  public
    Patch: Variant;

    Function IsSelected: boolean; override;
    Function IsSelectedRecord: boolean;
    Procedure SelectRecord; override;
    Procedure UnselectRecord; override;
    Procedure SelectAll;
    Procedure UnselectAll; override;
    Procedure LoadFromIniFile; virtual;
    Procedure SaveToIniFile; virtual;
    procedure ClearControls;

    procedure FlushChanges; override;
    procedure KeyDown(var Key: word; Shift: TShiftState); override;
    Function GetRowCount: integer;
    Function GetColCount: integer;
    Function GetActiveRow: integer;
    Function GetActiveCol: integer;
    Procedure SetActiveRow(val: integer); {10/24/96 }
    procedure ScrollCurrentToTop(currentRow: integer=0); // Scroll's current record to top if possible

    Function GetActiveField: TField;
    Procedure SetActiveField(AFieldName: string);

    function IsRichEditCell(col, row: integer; var customEdit: TWinControl) : boolean;

    //4/19/2001-Make following procedures public for export unit.
    procedure GetControlInfo(AFieldName: string;
        var AControlType: string; var AParameters: string); override;
    Function GetFieldValue(ACol: integer): string; override;
    procedure DoExportField(Grid:TwwDBGrid; AField:TField; var Accept:Boolean); virtual;
    procedure DoExportSYLKFormat(Grid:TwwDBGrid; AField:TField; var SYLKFormat:String); virtual;
    procedure SetScrollBars(scrollVal: TScrollStyle);
    procedure RedrawGrid;
    procedure SetColumnAttributes; override;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;  AState: TGridDrawState); override;
    procedure HideControls; override;                          { InfoPower documented method }
    function MouseCoord(X, Y: Integer): TGridCoord;           { InfoPower documented method }
//    procedure SetControlType(AFieldName: string;
//        AComponentType: TwwFieldControlType;
//        AParameters: string; AAlwaysPaints: boolean = False);
    procedure SetControlType(AFieldName: string;
        AComponentType: TwwFieldControlType;
        AParameters: string); //; AAlwaysPaints: boolean = False);
    procedure RefreshDisplay;                                 { InfoPower documented method }
    procedure SortSelectedList;                               { IP 2 documented method }
    procedure RestoreDesignSelected;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ColEnter; override; { 3/29/97}

    property DateTimePicker: TwwDBCustomDateTimePicker read GetDateTimePicker;
    property InplaceEditor;  { Support in-cell editing events }
    property ColWidths;
    property GridLineWidth;
    property Canvas;
    property SelectedList: TList read Bookmarks;
    property TabStops;
    Procedure AddDependent(value: TComponent);
    Procedure RemoveDependent(value: TComponent);
    procedure ApplySelected; override;