wwdatainspector.pas

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

         X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
         X, Y: Integer); override;
    procedure CalcSizingState(X, Y: Integer; var State: TGridState;
      var Index: Longint; var SizingPos, SizingOfs: Integer;
      var FixedInfo: TGridDrawInfo); override;
    procedure UpdateDataColumnWidth; virtual;
    procedure CreateParams(var Params: TCreateParams); override;
    function GetEditText(ACol, ARow: Longint): string; override;
    function GetEditMask(ACol, ARow: Longint): string; override;
    procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
    procedure Loaded; override;
    function AcquireFocus: Boolean; virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure Paint; override;
    procedure SetFocusCell(ACol, ARow: integer); virtual;
    function SelectCell(ACol, ARow: Longint): Boolean; override;
    procedure DataChanged; virtual;
    procedure UpdateActive; virtual;
    function GetField(ARow: integer): TField;
    function UseDefaultEditor: boolean; virtual;
    function UseCheckbox(ARow: integer): boolean; virtual;
    function ButtonPt(ARect: TRect; Obj: TwwInspectorItem): TPoint; virtual;
    function CheckboxRect(ARect: TRect; Obj: TwwInspectorItem): TRect; virtual;
    procedure DrawSizingLine(const DrawInfo: TGridDrawInfo);
    procedure RowHeightsChanged; override;
    procedure DoDrawDataCell(ObjItem: TwwInspectorItem;
       ASelected: boolean;
       ACellRect: TRect;
       var DefaultDrawing: boolean); virtual;
//    procedure DoDrawIndicatorCell(ObjItem: TwwInspectorItem;
//       ACellRect: TRect;
//       var DefaultDrawing: boolean); virtual;
    procedure InitCustomEdit(customEdit: TWinControl; Obj: TwwInspectorItem); virtual;
    procedure DoDrawCaptionCell(ObjItem: TwwInspectorItem;
       ASelected: boolean;
       ACellRect: TRect;
       var ACaptionRect: TRect;
       var DefaultTextDrawing: boolean); virtual;
     Function GetCanvas: TCanvas; virtual;
     Function IsDefaultDateTimePicker(Obj: TwwInspectorItem): boolean;
     Function IsDefaultLookupCombo(Obj: TwwInspectorItem): boolean;
     procedure DoCollapse(ObjItem: TwwInspectorItem); virtual;
     procedure DoExpand(ObjItem: TwwInspectorItem); virtual;
    procedure Click; override;
    procedure PaintLines(item: TwwInspectorItem); virtual;
    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    procedure DoCalcDataPaintText(item: TwwInspectorItem; var PaintText: string); virtual;
    procedure ValidationErrorUsingMask(Item: TwwInspectorItem); virtual;
    procedure FillWithFixedBitmap(TempRect: TRect; CurRelRow: integer); virtual;
    procedure FillWithAlternatingRowBitmap(TempRect: TRect); virtual;
    property InactiveFocusColor: TColor read FInactiveFocusColor write FInactiveFocusColor default clNone;
    property TopItem: TwwInspectorItem read GetTopItem; { Currently not implemented so leave as protected }

  public
     property Col;
     property ColWidths;
     property EditorMode;
     property GridHeight;
     property GridWidth;
     property LeftCol;
     property Selection;
     property Row;
     property RowHeights;
     property TabStops;
     property TopRow;
     property RowCount;
     property ActiveEdit: TWinControl read GetActiveEdit;
     {$ifdef wwdelphi4up}
     function ExecuteAction(Action: TBasicAction): Boolean; override;
     function UpdateAction(Action: TBasicAction): Boolean; override;
     {$endif}

     property DataLink: TwwDataInspectorDataLink read FDataLink;
     property DefaultDateTimePicker: TwwDBCustomDateTimePicker read GetDateTimePicker;
     property DefaultCombo: TwwDBComboBox read FCombo;
     property Canvas: TCanvas read GetCanvas;
     property CustomControlKeyMode: boolean read FCustomControlKeyMode write FCustomControlKeyMode;

     Function LevelRect(item: TwwInspectorItem): TRect;
     procedure MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
     function MouseToItem(X, Y: Integer): TwwInspectorItem;
     function RefreshActiveItem: TwwInspectorItem;
     procedure BeginUpdate;
     procedure EndUpdate(Repaint: boolean = false);
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure ApplySettings;
     procedure RefreshItem(Item: TwwInspectorItem); virtual;
//     procedure Click; override;
     Function GetRowByItem(AItem: TwwInspectorItem): integer; virtual;
     procedure IterateItems(CallBack: TwwInspectorItemCallback;
                 ExpandedOnly: boolean; UserData: Pointer);
     procedure InvalidateRow(ARow: integer);
     procedure InvalidateRowCol(ARow: integer; ACol: integer = -1);
//     procedure RefreshCustomControl;
     Function GetItemByFieldName(AFieldName: string): TwwInspectorItem;
     Function GetItemByRow(ARow: integer; Optimize: boolean = True): TwwInspectorItem; virtual;
     Function GetItemByCaption(ACaption: string): TwwInspectorItem;
     Function GetItemByTagString(ATagString: string): TwwInspectorItem;
     Function HaveVisibleItem: boolean;
     function GetFirstChild(VisibleItemsOnly: boolean = True): TwwInspectorItem;
     procedure FlushContents; // 8/5/00 New method
     property Designer: TControl read FDesigner write SetDesigner;
     property ActiveRows: integer read GetActiveRows;
     property InplaceEditor;
     property ActiveItem: TwwInspectorItem read GetActiveItem write SetActiveItem;
//     property DefaultDrawing;
     { Perhaps publish later, but this event seems unncessary as the OnItemChanged event can do the job }
     property OnFieldChanged: TwwInspectorFieldChangedEvent read FOnFieldChanged write FOnFieldChanged;

     // FixeddataRows Not published now as it is not fully functional.
     // 1. Need to resolve scrolling down from fixed row as it should not jump 2 2nd row
     // but instead it should jump to the current top row.
     //  2. Some lines are not drawn in their proper location when fixeddatarows is assigned
     property FixedDataRows: integer read FFixedDataRows write SetFixedDataRows default 0;

  published
     property DisableThemes : boolean read FDisableThemes write FDisableThemes;
     property Align;
     property Anchors;
//     property AlternatingRowColor: TColor read FAlternatingRowColor write FAlternatingRowColor default $00B1B1B1;
//     property ActiveColumnColor: TColor read FActiveColumnColor write FActiveColumnColor default clNone;
     property BiDiMode;
     property BorderStyle;
     property Color default clBtnFace;
     property Constraints;
     property Ctl3D;
//     property DefaultDrawing;
     property DragCursor;
     property DragKind;
     property DragMode;
     property Enabled;
     property CaptionColor : TColor read GetCaptionColor write SetCaptionColor default clBtnFace;
     property TreeLineColor : TColor read GetTreeLineColor write SetTreeLineColor default clWhite;
//     property FixedColor;
     property Font;
     property DataColumns: integer read FDataColumns write SetDataColumns default 1;
//     property IndicatorCaption: string read FIndicatorCaption write SetIndicatorCaption;
     property IndicatorRow: TwwInspectorIndicatorRow read FIndicatorRow write FIndicatorRow;
     property ParentBiDiMode;
     property ParentColor;
     property ParentCtl3D;
     property ParentFont;
     property ParentShowHint;
     property PopupMenu;
     property ScrollBars : TScrollStyle read FScrollBars write SetScrollBars default ssVertical;
     property ShowHint;
     property TabOrder;
     property TabStop;
     property PictureMaskFromDataSet: boolean read FPictureMaskFromDataSet write FPictureMaskFromDataSet default False;
     property DataSource: TDataSource read GetDataSource write SetDataSource;
     property Items: TwwInspectorCollection read FItems write SetItems;
     property DefaultRowHeight: integer read FDefaultRowHeight write SetDefaultRowHeight default 0;
     property CaptionWidth: integer read FCaptionWidth write SetCaptionWidth;
//     property WordWrap : boolean read FWordWrap write FWordWrap;
     property Options: TwwDataInspectorOptions read FOptions write SetOptions;
     property PaintOptions: TwwGridPaintOptions read FPaintOptions write FPaintOptions;//SetPaintOptions;
     property CaptionFont: TFont read FCaptionFont write SetCaptionFont;
     property LineStyleCaption: TwwDataInspectorLineStyle read FLineStyleCaption write SetLineStyleCaption default ovDark3DLine;
     property LineStyleData: TwwDataInspectorLineStyle read FLineStyleData write SetLineStyleData default ovDark3DLine;
     property DottedLineColor: TColor read FDottedLineColor write SetDottedLineColor default clBtnShadow;
//     property InactiveFocusColor: TColor read FInactiveFocusColor write FInactiveFocusColor default clNone;
     property ButtonOptions: TwwInspectorButtonOptions read FButtonOptions write FButtonOptions;
     property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
     property CaptionIndent: integer read FCaptionIndent write SetCaptionIndent default 12;
     property SetFocusTabStyle : TwwInspectorTabSetFocusStyle read FSetFocusTabStyle write FSetFocusTabStyle default itsPreserveActiveItem;
     property Visible;

     // 1/21/02
     property OnCalcCustomEdit: TwwInspectorCalcCustomEditEvent read FOnCalcCustomEdit write FOnCalcCustomEdit;
     property OnClick;
     property OnCreateHintWindow : TwwCreateInspectorHintWindowEvent read FOnCreateHintWindow write FOnCreateHintWindow;
     property OnDblClick;
     property OnDragDrop;
     property OnDragOver;
     property OnDrawDataCell: TwwInspectorDrawDataCellEvent read FOnDrawDataCell write FOnDrawDataCell;
     property OnDrawIndicatorCell: TwwInspectorDrawICellEvent read FOnDrawIndicatorCell write FOnDrawIndicatorCell;
     property OnEndDock;
     property OnEndDrag;
     property OnEnter;
     property OnExit;
     property OnKeyDown;
     property OnKeyPress;
     property OnKeyUp;
     property OnMouseDown;
     property OnMouseMove;
     property OnMouseUp;
     property OnMouseWheelDown;
     property OnMouseWheelUp;
     property OnBeforeSelectCell: TwwInspectorBeforeSelectCellEvent read FOnBeforeSelectCell write FOnBeforeSelectCell;
     property OnAfterSelectCell: TwwInspectorAfterSelectCellEvent read FOnAfterSelectCell write FOnAfterSelectCell;
     property OnStartDock;
     property OnStartDrag;
     property OnTopLeftChanged: TNotifyEvent read FOnTopLeftChanged write FOnTopLeftChanged;
     property OnContextPopup;

     property OnCreateDateTimePicker: TwwInspectorCreateDTPEvent
             read FOnCreateDateTimePicker write FOnCreateDateTimePicker;
     property OnCreateDefaultCombo: TwwInspectorCreateComboEvent
             read FOnCreateDefaultCombo write FOnCreateDefaultCombo;
     property OnDrawCaptionCell: TwwInspectorDrawCaptionEvent
        read FOnDrawCaptionCell write FOnDrawCaptionCell;
     property OnBeforePaint : TwwInspectorNotifyEvent read FOnBeforePaint write FOnBeforePaint;
     property OnCanExpand: TwwInspectorCanExpandEvent read FOnCanExpand write FOnCanExpand;
     property OnCanCollapse: TwwInspectorCanCollapseEvent read FOnCanCollapse write FOnCanCollapse;
     property OnExpanded : TwwInspectorExpandedEvent read FOnExpanded write FOnExpanded;
     property OnCollapsed : TwwInspectorCollapsedEvent read FOnCollapsed write FOnCollapsed;
//     property OnCheckValue: TwwValidateEvent read FOnCheckValue write FOnCheckValue;
     property OnItemChanged: TwwInspectorItemChanged read FOnItemChanged write FOnItemChanged;
//     property OnGetEditMask: TGetEditEvent read FOnGetEditMask write FOnGetEditMask;
     property OnCalcDataPaintText: TwwInspectorPaintTextEvent read FOnCalcDataPaintText write FOnCalcDataPaintText;
     property OnValidationErrorUsingMask: TwwInspectorValidationError
               read FOnValidationErrorUsingMask
               write FOnValidationErrorUsingMask;
  end;

 { 12/15/99 - Support dbl-click }
 TwwInspectorComboBox = class(TwwDBComboBox)
   private
     Inspector: TwwDataInspector;
   protected
     FClickTime: integer;
     procedure CloseUp(Accept: boolean); override;
     procedure DblClick; override;
     procedure WndProc(var Message: TMessage); override;
   public
     procedure DropDown; override;
     constructor Create(AOwner: TComponent); override;
 end;

procedure Register;

implementation

uses consts, wwtypes{, wwblend},
     {$ifdef wwDelphi7Up}
     themes,
     {$endif}
     {$ifdef ThemeManager}
     thememgr, themesrv, uxtheme,
     {$endif}
     wwdbgrid;
{$R WWDATAIN.RES}

  procedure TwwInspectorComboBox.WndProc(var Message: TMessage);
  begin
    case Message.Msg of
      WM_LBUTTONDOWN:
        begin
          if UINT(GetMessageTime - FClickTime) < GetDoubleClickTime then
           Message.Msg := WM_LBUTTONDBLCLK;
          FClickTime := 0;
        end;
    end;
    inherited WndProc(Message);
  end;

 procedure TwwInspectorComboBox.DblClick;
 begin
   inherited;
   Inspector.DblClick;
 end;

 constructor TwwInspectorComboBox.Create(AOwner: TComponent);
 begin
    inherited Create(AOwner);
    TabStop:= false;
    Inspector:= AOwner as TwwDataInspector;
 end;

 procedure TwwInspectorComboBox.CloseUp(Accept: boolean);
 var WasDroppedDown: boolean;
     OldEditText: string;
 begin
     WasDroppedDown:= IsDroppedDown;
     if Inspector.ActiveItem<>nil then
        OldEditText:= Inspector.ActiveItem.EditText
     else OldEditText:= '';
     inherited CloseUp(Accept);
     if Accept and WasDroppedDown then begin
       if Inspector.ActiveItem=nil then exit;
       Inspector.ActiveItem.editText:= GetComboValue(Text);
       if OldEditText<>Inspector.ActiveItem.EditText then
         Inspector.ActiveItem.DoItemTextChanged;
     end
 end;

procedure TwwInspectorComboBox.DropDown;
begin
   with Inspector.ActiveItem do begin
     if Assigned(FOnEditButtonClick) then
     begin
       FOnEditButtonClick(Inspector, Inspector.ActiveItem);
       if Inspector.CurrentCustomEdit is TwwDBComboBox then begin
         if (TwwDBComboBox(Inspector.CurrentCustomEdit).buttonStyle=cbsellipsis) then
         begin
            if Inspector.CanEditModify then begin { 3/21/00 - Check text property for cbsEllipsis style }
               EditText:= TwwDBComboBox(Inspector.CurrentCustomEdit).value;
               Inspector.FEditText:=EditText;
            end
         end
         else
            EditText:= TwwDBComboBox(Inspector.CurrentCustomEdit).value;
       end
     end
     else inherited DropDown;
   end
end;

procedure TwwDataInspectorDataLink.DataSetChanged;
begin
  FObjectView.DataChanged;
  FModified := False;
end;

procedure TwwDataInspectorDataLink.Modified;
begin
  FModified := True;
end;

procedure TwwDataInspectorDataLink.Reset;
begin
  if FModified then begin
     RecordChanged(nil);
     FObjectView.InvalidateEditor;
  end
  else exit;
{  else begin
     if ((DataSource.DataSet.State = dsEdit) or (DataSource.DataSet.State = dsInsert)) and
	 dataSet.modified then
     begin
	 if MessageDlg(wwInternational.UserMessages.wwDBGridDiscardChanges,
		    mtConfirmation, [mbYes,mbNo], 0)<>mrYes then exit;
     end;
     Dataset.Cancel;
  end}
end;

procedure TwwDataInspectorDataLink.UpdateData;
begin
  FInUpdateData := True;
  try
    if FModified then FObjectView.UpdateData;
    FModified := False;
  finally