wwdbigrd.pas

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

{
//
// Components : TwwDBCustomGrid
//
// Copyright (c) 1995-2001 by Woll2Woll Software
//
//
//  7/10/97 - Unselect all only if left button is clicked - Allows popupmenu to work.
//  7/10/97 - Support bitmaps with lookup fields - Only 1 field lookups supported
//  7/18/97 - Call hidecontrols in Layoutchanged so displayed embedded control
//            does not remain visible when column order is changed.
//  7/23/97 - Display bitmaps even in insert mode if lookup bitmap
//  7/31/97 - Don't use displaylabel property when useTFields=False
//  8/12/97 - Checkmark checkboxes optimized to use DisplayBitmap canvas
//  8/12/97 - Clear selLength when handling mask in keypress event.  This fixes
//            a bug which updated the text incorrectly.
//  10/15/97- Save and restore pen color later to allow column-moving line to be
//            drawn correctly
//  10/15/97- Allow resize even if titlebuttons is True
//  11/2/97 - Added to take care of wordwrap bug in memos displayed in grid
//  12/8/97 - Use ScrollWindowEx so background isn't cleared before painting
//  12/11/97 - Insert in front instead of switching columns
//  12/15/97 - Paint indicator button now so blank space isn't displayed too long
//  12/21/97 - Use goColMoving instead of dgColumnResize.  Developer can
//             then progmatically set goColMoving to False, while leaving the
//             column sizing as True.  This allows the developer a way of
//             removing the column dragging vertical bar.
//  1/28/98 -  Clear multi-select last record
//  2/4/98 -   Don't call OnCheckValue if character is not accepted
//  2/9/98 -   Only depress currently clicked column
//  3/30/98 -  Support ampersands in titles
//  3/30/98 -  Support imagelist to display bitmaps
//  3/31/98 -  If CenterJustify then allow DrawText to properly center text
//  3/31/98 -  Check to see if this is a single line edit control to
//               determine if we should or should not have word breaks
//  4/28/98 - IsMemoField uses ftMemo
//  5/13/98 - Fix memory leak for ShiftSelectBookmark
//  8/24/98 - Support Delphi 4 ActionLists
//  8/24/98 - Don't allow insert/edit if no records and dgallowinsert is false
//  9/2/98 -  Fixed 2 digit year bug in method UpdateData
//  9/2/98 -  FieldChanged event not fired in some cases.  This problem
//            is corrected by using UpdateData instead when using the
//            default inplaceeditor.  Also previous call to FieldChanged
//            is only called when a customedit is attached.
// 9/2/98 -   Fix bug where footer is not cleared when maximizing grid with
//            no records.
// 9/15/98 - Test for GoFoward when going back to previous row
// 9/21/98 - Make DoCalcTitleImage virtual for Delphi 4
// 9/22/98 - Don't call inherited if fail to set focus as this would
             lead to OnValidate getting called twice
// 9/24/98 - Prevent recursion in OnFieldChanged event by comparing text
// 10/2/98 - Allow editing if editing in CanEditModify
// 10/12/98 - Avoid converting 4 digit years to prevent 1900 from converting to 2000
// 10/26/98 - Truncate to character boundary in SetColumnAttributes.  Prevents problem
//            of column changing size when sizing another column.
// 10/28/98 - Subtract -4 from ColWidths in SetColumnAttributes.  Also undo change made on
//            10/26/98
// 11/11/98 - Invisible grid problem when width=0
// 11/24/98 - Check for nil curbookmark in DoCheckRowChanged
// 12/4/98  - Fix problem when descenders cutoff when dgRowLines=False.  Indirectly
//            fixes problem with lookupcombos with this problem.
// 12/7/98 - Correct OnColWidthChanged event passing the wrong column
// 12/9/98 - Just call RequestAlign in CMShowingChanged
// 1/8/99 - Fix descendor cutoff problem when wordwrap is true
// 1/31/99 - Support OnRowChanged for insert
// 2/17/99 - If append in grid, custom controls were not automatically moved to new row
// 2/17/99 - Added MouseWheel support by overriding virtual methods DoMouseWheelUp and DoMouseWheelDown (Delphi 4 Only)
// 2/21/99 - RSW, Don't highlight if fixed row multi-select cell
// 3/30/99 - Only include Insert if the dataset is not empty
// 4/21/99 - Free ShiftSelectBookmark first to fix memory leak.
// 4/28/99 - Fix problem where fixed column didn't fire event after drag operation
// 6/11/99 - Make sure adding never subtracting
// 1/13/2000 - Updated to use UseRightToLeftAlignment instead to test for Bidi mode
// 2/21/2000 - Fix bug introduced by Delphi 5 Patch 1 -
//             Need to make sure this code is not executed for lookupcombo
// 2/29/00 - subtract 4 to be consistent with above calculation
// 5/2/00 - Add method to clear last bookmark values
// 6/8/00 - Don't need to change grid layout when setting color
// 6/29/00 - PYW - Compute hint position correctly in different screen resolutions
//                 like 800x600 and when setting MaxLength in event.
// 7/2/2000 - Check for nil Screen.ActiveControl
// 9/7/00 - Expand tabs when computing hint window size
// 7/26/01 - Added code to handle abort in OnDrawDataCell event to prevent default customcontrol painting. - PYW
// 7/26/01 - Make sure datalink is active if showing hints. -PYW
// 8/8/2001- PYW - Make sure Datalink is active before going to next or prior record with mouse wheel.
// 9/24/2001 - If UseTFields is True, then have column return the fields displaywidth. -PYW
// 9/27/2001 - OnKeyUp not firing for tab or return key.
// 10/01/2001 - Don't allow setting smaller than defaultrowheight. -PYW
// 11/30/2001 - Made isMemoField virtual method.
// 12/12/01 - Set rowcount to 1+FTitleOffset if recordcount is not valid
// 12/21/01 - Fix hint not showing bug
// 1/4/02 - Don't paint data columns to the left of data area.
// 1/9/2002 - Call raise when patch variable set to allow messages from onvalidate to fire when focus exits grid.
// 1/21/02 - Fix left/right column scrolling problem where it didn't exit column when inplaceeditor being used (RSW)
// 2/11/2002 - Need to place in a begin/end block as following code only applies to above case -PYW
// 2/13/2002 - Don't call InitBlendBitmaps if no background bitmap loaded.
// 2/20/2002-PYW-When displaying bitmap take into account colline and rowlines.
// 3/3/2002-PYW-Don't showeditor if this is the right mouse button.
// 3/18/2002 - Make sure top line is drawn.
// 4/4/2002 -PYW- Check if Scrollbar has moved.  If so, then need to call DoTopROwChanged.
// 4/9/2002 -PYW - Preserve Cursor before URLPaint
// 5/9/2002 - PYW - Need to handle exception or hook raises it and it closes form.
// 6/17/02 - Allow transparent image when using alternating colors in grid
// 7/16/02 - Fixed bug where 1st horintal line in fixed column for 1st row
//           was previously missing when dgTitles was false
// 9/17/02 Allow fixed column to update correctly
// 10/31/02 - Avoid ADO bug in BookmarkValid generating exception when no records
// 4/2/03 - Check toprow and rowchanged as previosly didn't fire these events when paging up/down from navigator
// 4/15/03 - Fix bidi mode alignment problem with footer
// 4/16/03 Start offset at bottom of grouping label in fixed area
// 4/17/03 - Allow IME editor to handle keystrokes
// 4/17/03 - Support righttoleft hint
// 4/25/03 - Ditto direction not previously passed so only supported dittoprior
// 4/25/03 - Ditto Attributes - Not persistent before so didn't show up in object inspector
// 5/9/03 - Prevent index out of range if ACol<0 when Titlebuttons is true with themes
// 5/17/03 - Respect DefaultDrawContents for custom controls
// 9/3/03 - Fix line for grouping where top line was left
// 9/3/03 - Make case insensitive for GroupFieldName
// 9/10/03 - Support bidi-mode with special handling for numerics being reversed
// 3/23/04 - Still paint for checkbox
// 7/8/04 - Check datasource is valid first in DoAfterDrawCell
// 8/20/04 - As suggested by Eyal Zvi
// 4/30/07 - Fix multi-select paint bug with themes enabled (when control has focus).
}
unit Wwdbigrd;

{$R-}

{$i wwIfDef.pas}

interface

uses SysUtils, Windows, Messages, Classes, Controls, Forms,
     Graphics, Menus, StdCtrls, DB, DBTables, Grids, DBCtrls,
     wwTable, wwStr, wwdbedit, wwtypes, buttons, wwlocate, wwsystem, extctrls,
     wwriched, wwdbdatetimepicker, wwpaintoptions;


//const icBlack = clBlack;
//      icYellow = clYellow;
type
  TwwCustomDBGrid = class;

  TwwEditControlOption = (ecoCheckboxSingleClick, ecoSearchOwnerForm,
                          ecoDisableCustomControls, ecoDisableDateTimePicker,
                          ecoDisableEditorIfReadOnly);
  TwwEditControlOptions = set of TwwEditControlOption;

  TwwDittoDirection = (wwDittoPrior, wwDittoNext, wwDittoPriorOrNext);
  TwwDittoOption = (wwdoSkipBlobFields,
                     wwdoSkipReadOnlyFields,
                     wwdoSkipHiddenFields);
  TwwDittoOptions = Set of TwwDittoOption;

  TwwDittoAttributes = class(TPersistent)  // 4/25/03 - Not persistent before so didn't show up in object inspector
  private
    FDittoDirection: TwwDittoDirection;
    FShortCutDittoField: TShortCut;
    FShortCutDittoRecord: TShortCut;
    FOptions: TwwDittoOptions;
  published
    property DittoDirection: TwwDittoDirection read FDittoDirection write FDittoDirection default wwDittoPrior;
    property ShortCutDittoField: TShortCut read FShortCutDittoField write FShortCutDittoField default 0;
    property ShortCutDittoRecord: TShortCut read FShortCutDittoRecord write FShortCutDittoRecord default 0;
    property Options: TwwDittoOptions read FOptions write FOptions default [];
  end;

  TwwGridHintWindow=class(THintWindow)
  private
  protected
     procedure Paint; override;
  public
     Field: TField;
     WordWrap: boolean;
     Alignment: TAlignment;
  end;

  TwwTitleImageAttributes = record
     ImageIndex: integer;
     Alignment: TAlignment;
     Margin: integer;
     IsGroupHeader: boolean;
  end;

  TTitleButtonClickEvent =
     procedure (Sender: TObject; AFieldName: string) of object;
  TCalcCellColorsEvent =
     procedure (Sender: TObject; Field: TField; State: TGridDrawState;
		Highlight: boolean; AFont: TFont; ABrush: TBrush) of object;
  TCalcTitleAttributesEvent =
     procedure (Sender: TObject; AFieldName: string; AFont: TFont; ABrush: TBrush;
		var ATitleAlignment: TAlignment) of object;

  TwwDrawTitleCellEvent =
      procedure (Sender: TObject; Canvas: TCanvas;
       Field: TField; Rect: TRect; var DefaultDrawing: boolean) of object;

  TwwDrawGroupHeaderCellEvent =
      procedure (Sender: TObject; Canvas: TCanvas;
        GroupHeaderName: string;
        Rect: TRect; var DefaultDrawing: boolean) of object;

  TwwCalcTitleImageEvent =
      procedure (Sender: TObject; Field: TField;
         var TitleImageAttributes: TwwTitleImageAttributes) of object;

  TDrawFooterCellEvent =
     procedure (Sender : TObject; Canvas: TCanvas; FooterCellRect: TRect;
                Field: TField;
                FooterText: string; var DefaultDrawing: boolean) of object;

  TColWidthChangedEvent =
     procedure (Sender: TObject; Column: integer) of object;

  TAllowColResizeEvent =
     procedure (Sender: TObject; Column: integer; var Accept:Boolean) of object;

  TwwLeftColChangedEvent =
     procedure (Sender: TObject; NewLeftCol: integer) of object;

  TwwCreateGridHintWindowEvent =
    procedure (Sender: TObject;
      HintWindow: TwwGridHintWindow;
      AField: TField; R: TRect;
      var WordWrap: boolean;
      var MaxWidth, MaxHeight: integer;
      var DoDefault: boolean) of object;

  TwwMultiSelectOption = (msoAutoUnselect, msoShiftSelect);
  TwwMultiSelectOptions = set of TwwMultiSelectOption;
  TwwFieldChangedEvent =
      procedure (Sender: TObject; Field: TField) of object;

  TwwGridDataLink = class(TDataLink)
  private
    FGrid: TwwCustomDBGrid;
    FFieldCount: Integer;
    FFieldMapSize: Integer;
    FModified: Boolean;
    FInUpdateData: Boolean;
    FFieldMap: Pointer;
    function GetDefaultFields: Boolean;
    function GetFields(I: Integer): TField;
  protected
    procedure ActiveChanged; override;
    procedure DataSetChanged; override;
    procedure DataSetScrolled(Distance: Integer); override;
    procedure FocusControl(Field: TFieldRef); override;
    procedure EditingChanged; override;
    procedure LayoutChanged; override;
    procedure RecordChanged(Field: TField); override;
    procedure UpdateData; override;
  public
    constructor Create(AGrid: TwwCustomDBGrid);
    destructor Destroy; override;
    function AddMapping(const FieldName: string): Boolean;
    procedure ClearMapping;
    procedure Modified;
    procedure Reset;
    property DefaultFields: Boolean read GetDefaultFields;
    property FieldCount: Integer read FFieldCount;
    property Fields[I: Integer]: TField read GetFields;
    property isFieldModified : boolean read FModified;
  end;

  TwwDBGridOption = (dgEditing, dgAlwaysShowEditor, dgTitles, dgIndicator,
    dgColumnResize, dgColLines, dgRowLines,
    dgTabs, dgRowSelect, {dgRowSelectEditable,}
    dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit,
    dgWordWrap, dgPerfectRowFit, dgMultiSelect, dgShowFooter, dgFooter3DCells,
    dgNoLimitColSize,  dgTrailingEllipsis, dgShowCellHint, dgTabExitsOnLastCol,
    dgFixedResizable, dgFixedEditable, dgProportionalColResize, dgRowResize,
    dgRowLinesDisableFixed, dgColLinesDisableFixed, dgFixedProportionalResize,
    dgHideBottomDataLine, dgDblClickColSizing);
  TwwDBGridOptions = set of TwwDBGridOption;
  TwwDBGridKeyOption = (dgEnterToTab, dgAllowDelete, dgAllowInsert);
  TwwDBGridKeyOptions = set of TwwDBGridKeyOption;
  TwwDrawDataCellEvent = procedure (Sender: TObject; const Rect: TRect; Field: TField;
    State: TGridDrawState) of object;

  TwwCustomDrawGridCellInfo = class
    Rect: TRect;
    Field: TField;
    State: TGridDrawState;
    DataCol, DataRow: integer;
    DefaultDrawBackground: boolean;
    DefaultDrawHorzTopLine: boolean;
    DefaultDrawHorzBottomLine: boolean;
    DefaultDrawContents: boolean;
  end;

  TwwCustomDrawCellEvent = procedure (
    Sender: TwwCustomDBGrid;
    DrawCellInfo: TwwCustomDrawGridCellInfo) of object;

  TIndicatorColorType = (icBlack, icYellow);
//  TIndicatorColorType = TColor;
  TwwBitmapSizeType = (bsOriginalSize, bsStretchToFit, bsFitHeight, bsFitWidth);
//  TwwWriteTextOption = (wtoAmpersandToUnderline, wtoEllipsis, wtoWordWrap, wtoMergeCanvas);
//  TwwWriteTextOptions = Set of TwwWriteTextOption;

  TwwIButton=class(TSpeedButton)
  public
     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
     procedure Loaded; override;
     procedure Paint; override;
  end;

  TwwInplaceEdit = class(TInplaceEdit)