wwdbigrdtest.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.
}
unit WWDBIGRDtest;

{$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;

  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);
  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;
  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)
    private
      FwwPicture: TwwDBPicture;
      FWordWrap: boolean;
      ParentGrid: TwwCustomDBGrid;
      FUsePictureMask: boolean;

      procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
      procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
      procedure WMPaste(var Message: TMessage); message WM_PASTE;  {10/28/96 }

    protected
      procedure BoundsChanged; override;
      procedure KeyDown(var Key: Word; Shift: TShiftState); override;
      procedure CreateParams(var Params: TCreateParams); override;
      procedure KeyUp(var Key: Word; Shift: TShiftState); override;
      procedure KeyPress(var Key: Char); override;
      procedure SetWordWrap(val: boolean);
      procedure UpdateContents; override;
    public
      constructor wwCreate(AOwner: TComponent; dummy: integer); virtual;
      destructor Destroy; override;
      function IsValidPictureValue(s: string): boolean;
      Function HavePictureMask: boolean;

      property Picture: TwwDBPicture read FwwPicture write FwwPicture;
      property WordWrap: boolean read FWordWrap write SetWordWrap;
      property Color;
      property Font;
    end;

  TwwColumn = class
  private
//     FReadOnly: boolean;
//     FDisplayLabel: string;
//     FDisplayWidth: integer;

     FFieldName: string;
     Grid: TwwCustomDBGrid;
     FFooterValue: string;
     FGroupName: string;
     function GetReadOnly: boolean;
     function GetDisplayLabel: string;
     function GetDisplayWidth: integer;
     function GetGroupName: string;
     procedure SetReadOnly(val: boolean);
     procedure SetDisplayLabel(val: string);
     procedure SetDisplayWidth(val: integer);
     procedure SetFooterValue(val: string);
     procedure SetGroupName(val: string);
  public
     property FieldName: string read FFieldName;
     property ReadOnly : boolean read GetReadOnly write SetReadOnly;
     property DisplayLabel: string read GetDisplayLabel write SetDisplayLabel;
     property DisplayWidth: integer read GetDisplayWidth write SetDisplayWidth;
     property FooterValue: string read FFooterValue write SetFooterValue;
     property GroupName: string read GetGroupName write SetGroupName;
     constructor Create(AOwner: TComponent; AFieldName: string);
  end;

  TwwGridURLOpenEvent = procedure(
     Sender : TObject; var URLLink: string; Field: TField;
     var UseDefault: boolean) of object;
  TwwPadColumnStyle = (pcsPlain, pcsPadHeader, pcsPadHeaderAndData);

  TwwCacheColInfoItem = class
    CustomControl: TWinControl;
    ControlType: string;
    ControlData: string;
    AlwaysPaints: boolean;
    IsWhiteBackground: boolean;
//    PaintedBrushColor: TColor;
  end;
  TwwGridLineStyle= (glsSingle, gls3D, glsDynamic);

  TwwGridLineColors = class(TPersistent)
  private
     FDataColor: TColor;
     FHighlightColor: TColor;
     FShadowColor: TColor;
     FFixedColor: TColor;
  published
     property DataColor: TColor read FDataColor write FDataColor default clSilver;
     property HighlightColor: TColor read FHighlightColor write FHighlightColor default clBtnHighlight;
     property ShadowColor: TColor read FShadowColor write FShadowColor default clBtnShadow;
     property FixedColor: TColor read FFixedColor write FFixedColor default clBlack;
  end;

  TwwCustomDBGrid = class(TCustomGrid)
  private
    FShowHorzScrollBar: boolean;
    FOnBeforePaint: TNotifyEvent;
    FSelected : TStrings;
    FLineColors: TwwGridLineColors;
//    FDataLineColor:TColor;
    FTitleFont: TFont;
    FTitleColor: TColor;
    FFooterColor: TColor;
    FFooterCellColor: TColor;
    FFooterHeight: integer;
    FReadOnly: Boolean;
    FUserChange: Boolean;
//    FDataChanged: Boolean;
//    FEditRequest: Boolean;
    FUpdatingColWidths: integer;