wwdatainspector.pas

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

unit wwDataInspector;
{$R-}
{
//
// Components : TwwDataInspector
//
// Copyright (c) 1999 by Woll2Woll Software
//
// 11/15/99 - Fix problem for active cell updating in detail query
// 11/18/99 - Make sure this is a valid row when resizing row
// 12/2/99 - Dbl-click should be passed to base class to handle, and
//           dbl-click in customcombo when it does not have focus originally
//           should still work.
// 1/21/2000-Check for nil pointer in SetEditText
// 1/28/2000 - Send to parent form, not parent
// 2/24/00 - Fire OnItemChanged event when exiting control
// 3/6/2000 - Flush changes when expanding
// 3/6/00 - Check for nil active control
// 3/11/00 - Clear modified for inplaceeditor
// 3/21/00 - Honor setting of text for cbsEllipsis combo style when it is bound
// 4/21/00 - Fix expand/collapse button click problem when cell font changed during painting
// 4/25/00 - Make sure Obj is not nil.  This can happen when reassigning the datasource. (PYW)
// 4/26/00 - Check for nil obj in GetField method
// 5/3/00 - Make sure obj.edittext is updated to inplaceeditor's value
//          This is only necessary because when a picture mask is assigned, the obj.edittext
//          is not updated for some reason
// 5/4/00   Unbound with custom control item was losing original text
// 6/23/00 - Handle needs to be created to avoid blank display in some cases
// 7/19/00 - RSW - Don't remove inplaceeditor painting if it has the focus
// 7/19/00 - Richedit paint problem when dragging dialog in front
// 7/20/00 - ovTabToVisibleOnly should use 2nd paramater, not first
// 8/1/00 - ValidateRect put back in to avoid flicker when expanding all
// 8/5/00 - Add method Flush contents to force cell to flush its changes
// 12/4/00 - Support EditText to update inplaceeditor
// 12/17/00 - Already updated when toggling checkbox
// 1/22/00 - Add support for ActionLists (PYW)
// 5/11/2001 - PYW - Make sure that obj <> nil.
// 6/11/2001 - PYW - Fixed ToolTip Cell Hint Issues.
// 7/21/01 - Fix invisible inplaceeditor bug when
//           running in 120 pixels per inch
// 8/7/01 - Fix problem where unbound default combobox was having text
//          cleared.  Also fix problem with painting of combobox
//
// 8/9/01 - If no active item then have GetActiveEdit method return nil
// 09/04/01 - Set row to 1st not-fixed row when resetActiveitem tab style
// 1/21/02 - Add new event CalcCustomEdit to allow developer to prevent customedit
//           for selected records when the dataset moves to the record
// 3/18/2002-Call OnMouseUp event if assigned.
// 4/11/2002 - Verify control is focused if calling setfocuscell (PYW)
// 5/7/2002-PYW-Handles problem with main menu and return key when datainspector has focus.
// 5/8/2002 -PYW- Handled column Sizing bug when clicking on edge of Datainspector when embedded in grid.
// 6/13/02 - RSW Fix editor.text uipdating when inspector first receives focus
// 6/13/02 - Inspector in Grid problem where right/left arrows exited inspector during editing of inspector cell
//           It should instead just move within the edit control
// 10/7/02 - DefaultCombobox not using display text before
// 10/22/02 - Maplist not initialized correctly unless we use obj.displaytext
// 11/24/02 - if background is clnone, then use grid's choice of font since we are transparent
//            otherwise reset captionfont color
// 12/30/02 - Initialize caption font
// 4/4/03 - Don't process key if different window is open in hook
// 4/19/03 - Logic incorrect before causing problem in unbound case
// 5/19/03 - Fix bug which causes caption column to be hidden in certain cases
// 6/20/03 - Should have been removed as in IP 3000
// 7/10/03 - Allow IME editor to handle keystrokes
// 9/16/03 - in case no items visible
// 3/18/05 - Undo sizing line so it behaves the same as sizing in data rows
}
{$i wwIfDef.pas}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, db, dbtables, dbctrls, wwstr, stdctrls, wwcommon, wwdbedit, wwpict, wwsystem,
  wwdbdatetimepicker, wwdbcomb, wwdblook, wwdotdot, wwframe, wwriched, extctrls,
  wwbitmap, wwpaintoptions, imm;

type
  TwwInspectorCollection = class;
  TwwDataInspector = class;
  TwwInspectorItem = class;

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

  TwwDataInspectorDataLink = class(TDataLink)
  private
    FObjectView: TwwDataInspector;
    FInUpdateData: Boolean;
    FModified: Boolean;
  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(AObjectView: TwwDataInspector);
    procedure Modified;
    procedure Reset;
    property isFieldModified : boolean read FModified;
  end;

  TwwInspectorPickList = class(TPersistent)
  private
    FItems: TStrings;
    FMapped: boolean;
    FDisplayAsCheckbox: boolean;
    FStyle: TComboBoxStyle;
    FShowMatchText: boolean;
    FAllowClearKey: boolean;
    FButtonStyle: TwwComboButtonStyle;
    FButtonGlyph: TBitmap;
    FButtonWidth: integer;
    procedure SetItems(val: TStrings);
    procedure SetButtonGlyph(Value: TBitmap);
  protected
    procedure AssignTo(Dest: TPersistent); override;
  public
    constructor Create;
    destructor Destroy; override;
  published
    property Items: TStrings read FItems write SetItems;
    property MapList: boolean read FMapped write FMapped default false;
    property Style: TComboBoxStyle read FStyle write FStyle default stdctrls.csDropDown;
    property ShowMatchText: boolean read FShowMatchText write FShowMatchText default true;
    property AllowClearKey: boolean read FAllowClearKey write FAllowClearKey default false;
    property ButtonStyle : TwwComboButtonStyle read FButtonStyle write FButtonStyle default cbsDownArrow;
    property DisplayAsCheckbox : boolean read FDisplayAsCheckbox write FDisplayAsCheckbox default False;
    property ButtonGlyph : TBitmap read FButtonGlyph write SetButtonGlyph;
    property ButtonWidth : integer read FButtonWidth write FButtonWidth default 0;
  end;


  TwwInspectorItemOption = (iioAutoDateTimePicker, iioAutoLookupCombo);
  TwwInspectorItemOptions = set of TwwInspectorItemOption;
  TwwInspectorItemChanged = procedure (
    Sender: TwwDataInspector;
    Item: TwwInspectorItem; NewValue: string) of object;
  TwwInspectorItemNotifyEvent = procedure (
    Sender: TwwDataInspector;
    Item: TwwInspectorItem) of object;
  TwwInspectorNotifyEvent = procedure (Sender: TwwDataInspector) of object;


  TwwInspectorItem = class(TCollectionItem)
  private
    FEditText: string;
    FItems: TwwInspectorCollection;
    FReadOnly: boolean;
    FCustomControlName: TWinControl;
    FCustomControlAlwaysPaints: boolean;
    FCaption: string;
    FCellHeight: integer;
    FDataField: string;
    FDataLink: TFieldDataLink;
    FExpanded: boolean;
    FPickList: TwwInspectorPickList;
    FPicture: TwwDBPicture;
    FParentItem: TwwInspectorItem;
    FResizeable: boolean;
    FVisible: boolean;
    FTag: integer;
    FTagString: string;
    FOptions: TwwInspectorItemOptions;
    FTabStop: boolean;
    FItemChanged: TwwInspectorItemChanged;
    FWordWrap: boolean;
    FDisableDefaultEditor: boolean;
    FActiveRecord: boolean;
//    FWantArrowKeys: boolean;

    FOnEditButtonClick: TwwInspectorItemNotifyEvent;
    FAlignment: TAlignment;
    FCustomControlHighlight: boolean;
    FEnabled: boolean;
//    procedure ComboDropDownEvent(Sender: TObject);
//    OrigEditText: string;

    procedure SetItems(Value: TwwInspectorCollection);
    function GetDataSource: TDataSource;
    procedure SetDataSource(Value: TDataSource);
    function GetDataField: string;
    procedure SetDataField(const Value: string);
    procedure SetCaption(const Value: string);
    Function GetControl: TComponent;
    Function GetField: TField;
    procedure SetCellHeight(const Value: integer);
    function GetLevel: integer;
    procedure SetCustomControl(val: TWinControl);
    procedure SetVisible(val: boolean);
    procedure SetExpanded(val: boolean);
    function GetChecked: boolean;
    procedure SetChecked(val: boolean);
    function GetDataLink: TDataLink;
    function GetDisplayText: string;
    procedure SetDisplayText(val: string);
    procedure SetEditText(val: string);

  protected
    ButtonPoint: TPoint; { 4/21/00 - Save buttonpt as if user changed font during
                         paint events, then buttonpt would not be consistent.  This
                         fixes problem where button click not being recognized. }
    property DataLink: TDataLink read GetDataLink;
    function HaveItems: boolean; virtual;
    Function GetDesigner: TControl;
    procedure DefineProperties(Filer: TFiler); override;
    procedure DoItemTextChanged; virtual;
    Function UseDefaultComboBox: boolean;
    Function GetMappedPaintText(StoredValue: string): string; virtual;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    Function HaveVisibleItem: boolean;
    function GetDisplayName: string; override;
    function GetNamePath: string; override;
    procedure Assign(Source: TPersistent); override;
    property ActiveRecord: boolean read FActiveRecord write FActiveRecord; // Only valid within DrawDataCell and DrawIndicatorCell
    property Field: TField read GetField;
    property Control: TComponent read GetControl;
    property Level: integer read GetLevel;
    property ParentItem : TwwInspectorItem read FParentItem write FParentItem;
    function GetFirstChild(VisibleItemsOnly: boolean = True;
                           ExpandedOnly: boolean = False): TwwInspectorItem;
    function GetLastChild(VisibleItemsOnly: boolean = True;
                          ExpandedOnly: boolean = False): TwwInspectorItem;
    function GetPrior(VisibleItemsOnly: boolean = True;
                      ExpandedOnly: boolean = False): TwwInspectorItem;
    function GetNext(VisibleItemsOnly: boolean = True;
                     ExpandedOnly: boolean = False): TwwInspectorItem;
    function GetNextSibling(VisibleItemsOnly: boolean = True): TwwInspectorItem;
    function GetPriorSibling(VisibleItemsOnly: boolean = True): TwwInspectorItem;
    property Checked: boolean read GetChecked write SetChecked;
    property DisplayText: string read GetDisplayText write SetDisplayText;

  published
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DataField: string read GetDataField write SetDataField;
    property Caption: string read FCaption write SetCaption;
    property CellHeight: integer read FCellHeight write SetCellHeight default 0;
    property EditText: string read FEditText write SetEditText; { Design-time settings only applicable if unbound item }

    property Alignment: TAlignment read FAlignment write FAlignment default taLeftJustify;
    property ReadOnly: boolean read FReadOnly write FReadOnly default false;
    property CustomControl: TWinControl read FCustomControlName write SetCustomControl;
    property CustomControlAlwaysPaints: boolean read FCustomControlAlwaysPaints write FCustomControlAlwaysPaints default True;
    property CustomControlHighlight: boolean read FCustomControlHighlight write FCustomControlHighlight default False;
    property Expanded: boolean read FExpanded write SetExpanded default false;
    property PickList: TwwInspectorPickList read FPickList write FPickList;
    property Picture: TwwDBPicture read FPicture write FPicture;
    property Resizeable: boolean read FResizeable write FResizeable default false;
    property Items: TwwInspectorCollection read FItems write SetItems stored HaveItems;
    property Visible : boolean read FVisible write SetVisible default True;
    property Tag: integer read FTag write FTag default 0;
    property TagString: string read FTagString write FTagString;
    property TabStop: boolean read FTAbStop write FTabStop default True;
    property Options: TwwInspectorItemOptions read FOptions write FOptions default [iioAutoDateTimePicker];
    property WordWrap: boolean read FWordWrap write FWordWrap; { 12/11/99 - Removed default as it did not match constructor before }
    property DisableDefaultEditor: boolean read FDisableDefaultEditor write FDisableDefaultEditor default False;
    property Enabled : boolean read FEnabled write FEnabled default True;

    property OnItemChanged: TwwInspectorItemChanged read
       FItemChanged write FItemChanged;
    property OnEditButtonClick: TwwInspectorItemNotifyEvent read FOnEditButtonClick write FOnEditButtonClick;
  end;

  TwwInspectorCollection = class(TCollection)
  private
    FParentItem: TwwInspectorItem;
    function GetItem(Index: Integer): TwwInspectorItem;
    procedure SetItem(Index: Integer; Value: TwwInspectorItem);
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  public
    Control: TComponent;
    property ParentItem : TwwInspectorItem read FParentItem;

    constructor Create(Control: TComponent);
    destructor Destroy; override;
    function Add: TwwInspectorItem;
    function Insert(index: integer): TwwInspectorItem;
    procedure SaveToStream(s: TStream);
    procedure LoadFromStream(s: TStream);
    procedure SaveToFile(const FileName: string);
    procedure LoadFromFile(const FileName: string);
    property Items[Index: Integer]: TwwInspectorItem read GetItem write SetItem; default;
  end;

  TwwInspectorItemCallback = procedure(obj: TwwInspectorItem;
                           UserData: Pointer; var AContinue: boolean) of object;

  TwwDataInspectorOption = (ovColumnResize, ovRowResize,
     ovTabExits,
     ovEnterToTab, ovHighlightActiveRow,
     ovHideVertDataLines,
     ovCenterCaptionVert, ovTabToVisibleOnly,
     ovShowTreeLines, ovShowCaptionHints, ovShowCellHints,
     ovFillNonCellArea, ovActiveRecord3DLines,
     ovAllowInsert, ovHideCaptionColumn, ovHideVertFixedLines,
     ovUseOwnBackgroundColors);
     // 8/2/02 - When UseOwnBackgroundcolors is true, then
     // inspector fills its background using its color and captioncolor properties.
     // This allows an inspector in a grid to still use its own colors instead of the alternating colors
  TwwDataInspectorOptions = set of TwwDataInspectorOption;

  TwwDataInspectorLineStyle = (ovNoLines, ovDottedLine, ovLight3DLine, ovDark3DLine, ovButtonLine);

  // 1/21/02
  TwwInspectorCalcCustomEditEvent = procedure (
    Sender: TwwDataInspector;
    Item: TwwInspectorItem;
    CustomEdit: TWinControl;
    var AllowCustomEdit: boolean) of object;

  TwwInspectorDrawDataCellEvent = procedure (
    Sender: TwwDataInspector;
    ObjItem: TwwInspectorItem;
    ASelected: boolean;
    ACellRect: TRect;
    var DefaultDrawing: boolean) of object;

  TwwInspectorDrawICellEvent = procedure (
    Sender: TwwDataInspector;
    ACol: integer;
    ACellRect: TRect;
    var DefaultDrawing: boolean) of object;

  TwwInspectorDrawCaptionEvent = procedure (
    Sender: TwwDataInspector;
    ObjItem: TwwInspectorItem;
    ASelected: boolean;
    ACellRect: TRect;
    var ACaptionRect: TRect;
    var DefaultTextDrawing: boolean) of object;