wwdbgrid.pas

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

  published
    property DisableThemes : boolean read FDisableThemes write FDisableThemes default false;
    property DittoAttributes;
    property DisableThemesInTitle;
    property LineStyle;
    property ControlInfoInDataset;
    property ControlType;
    property PictureMaskFromDataSet;
    property PictureMasks;
    property RegexMasks;
    property Selected;
    property MemoAttributes : TwwMemoAttributes
        read FMemoAttributes write setwwMemoAttributes
        default [mSizeable, mWordWrap];
    property IniAttributes : TwwIniAttributes
        read FIniAttributes write FIniAttributes;
    property ExportOptions : TwwExportOptions read FExportOptions write FExportOptions;
    property TitleColor: TColor read getTitleColor write setTitleColor;
//    property DataLineColor: TColor read getDatalineColor write setDataLineColor;
    property OnExportField : TwwExportFieldEvent read FOnExportField write FOnExportField;
    property OnExportSYLKFormat : TwwExportSYLKFormatEvent read FOnExportSYLKFormat write FOnExportSYLKFormat;
    property OnMemoOpen : TwwMemoOpenEvent read FOnMemoOpen write FOnMemoOpen;
    property OnMemoClose : TwwMemoCloseEvent read FOnMemoClose write FOnMemoClose;
    property OnMultiSelectAllRecords : TwwSelectAllRecordEvent read FOnSelectAllRecords write FOnSelectAllRecords;
    property OnMultiSelectRecord : TwwSelectRecordEvent read FOnSelectRecord write FOnSelectRecord;
    property OnCreateDateTimePicker: TwwCreateDTPEvent
             read FOnCreateDateTimePicker write FOnCreateDateTimePicker;
    property OnLeftColChanged;
    property OnRowChanged;
    property OnCellChanged;

    property FixedCols : integer read getFixedCols write setFixedCols;
    property ShowHorzScrollBar;
    property ShowVertScrollBar;
    property EditControlOptions;
    property IndicatorButton;

    {$ifdef wwDelphi4Up}
    property Anchors;
    property BiDiMode;
    property ParentBiDiMode;
    {$endif}
    property Align;
    property BorderStyle;
    property Color;
    {$ifdef wwDelphi4Up}
    property Constraints;
    {$endif}
    property Ctl3D;
    property DataSource : TDataSource read getDataSource write setDataSource;
    property DefaultDrawing;
    property DragCursor;
    property DragMode;
    property EditCalculated;
    property Enabled;
    property Font;
    {$ifdef wwDelphi3Up}
    property ImeMode;// : TImeMode read getImeMode write setImeMode default imDontCare;
    property ImeName;// : string read getImeName write setImeName;
    {$endif}
    property KeyOptions;
    property MultiSelectOptions;
    property Options;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property RowHeightPercent;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property TitleAlignment;
    property TitleFont;
    property TitleLines;
    property TitleButtons;
    property UseTFields;
    property Visible;
    property LoadAllRTF: boolean read FLoadAllRTF write FLoadAllRTf default False;
    property LineColors;
    property OnCalcCellColors;
    property OnCalcTitleAttributes;
    property OnColWidthChanged;
    property OnDrawGroupHeaderCell;
    property OnTitleButtonClick;
    property OnColEnter;
    property OnColExit;
    property OnDrawDataCell;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnStartDrag; // 5/4/00 - publish OnStartDrag property
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnCreateHintWindow;
//    property OnValidationErrorUsingMask;

    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property IndicatorColor stored False;  // obsolete property
    property IndicatorIconColor;
    property OnCheckValue;
    property OnColumnMoved;
    property OnTopRowChanged;
    property OnCalcTitleImage;
    property OnDrawFooterCell;
    property OnDrawTitleCell;
    property OnFieldChanged;
    property OnUpdateFooter;
    property OnBeforePaint;
    property ImageList;
    property TitleImageList;
    property FooterColor;
    property FooterCellColor;
    property FooterHeight;
    property DragVertOffset;
    property PadColumnStyle;
    property PaintOptions;
    property OnURLOpen;
    property HideAllLines;

    property OnBeforeDrawCell;
    property OnAfterDrawCell;
    property OnDitto;
    property GroupFieldName;

protected
    Function WideGetFieldValue(ACol: integer): WideString; override;
end;

implementation

uses wwdbcomb,
{$ifdef wwDelphi6Up}
variants,
{$endif}
   wwintl,
   {$ifndef wwDelphi6Up}
   filectrl,
   {$Endif}
   wwcheckbox, Clipbrd, bde,
   wwradiogroup;

const wwCRLF = #13#10;

function Find(Grid: TwwDBGrid;
   const Item: TBookmark; var Index: Integer): Boolean;
var
  L, H, I, C: Integer;
  FList: TList;

  function Compare(const Item1, Item2: TBookmark): Integer;
  begin
    with Grid.Datalink.Datasource.Dataset do
      Result := CompareBookmarks(Item1, Item2);
  end;

begin
  FList:= Grid.SelectedList;
  Result := False;
  L := 0;
  H := FList.Count - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    C := Compare(FList[I], Item);
    if C < 0 then L := I + 1 else
    begin
      H := I - 1;
      if C = 0 then
      begin
        Result := True;
        L := I;
      end;
    end;
  end;
  Index := L;
end;


type
  TRichProtectClass = class(TObject)
     procedure RichProtectChange(Sender: TObject; StartPos,
       EndPos: Integer; var AllowChange: Boolean);
  end;

function sameRect(rect1, rect2: TRect): boolean;
begin
   result:=
      (rect1.left = rect2.left) and
      (rect1.right = rect2.right) and
      (rect1.top = rect2.top) and
      (rect1.bottom = rect2.bottom);
end;

    constructor TwwDBGrid.create(AOwner: TComponent);
    begin
      inherited Create(AOwner);

      OrigSelected:= Tstringlist.create;

      FIniAttributes:= TwwIniAttributes.create;
      with FIniAttributes do begin
         FileName := '';
         SectionName := '';
         Delimiter := ';;';
         Enabled := False;
         Owner := self;
      end;

      FExportOptions := TwwExportOptions.create(self);

      FDirtyIni:= True;
      redrawingGrid:= False;
      initialized:= False;
      doneInitControls:= False;
      drawingCell:= False;

      MemoAttributes := [mSizeable, mWordWrap];
      FFixedCols:= 0;
      inLinkActive:= False;

      Bookmarks:= TList.create;
      FDependentComponents:= TList.create;
      SelectedRecordList:= TStringList.create;

      GridIsLoaded:= False;
      AlwaysShowControls:= False;
      CurrentCustomEdit:= Nil;
      VirtualView := True;  { 3/11/98 - Auto-invalidate if grid rowcount or colcount changes }

      Patch:= VarArrayCreate([0, 9], varVariant);
      Patch[0]:= False; { 9/2/98 - True means the FieldChanged was already
                          called. Used by TwwDBCustomDBGrid }
      Patch[1]:= False; { If True, then bypass code to workaround Delphi 4 showing bug }
      Patch[2]:= 0;     { 12/7/98 - Contains SizingColumn when resizing a column }
      Patch[3]:= False;
      Patch[4]:= False; { If true, then Hidecontrols called after inheritd ColExit }
                        { This would cause the control's OnExit event to be called after
                          the OnColExit event }
      Patch[5]:= False; {1/9/2002 - Added for backwards compatibility when
                         exiting the grid error messages from onvalidate were not displayed.
                         Using a Patch variable to provide solution while studying impact.}
      Patch[6]:= 0; // Prev Col for CellChanged
      Patch[7]:= 0; // Prev Row for CellChanged
      Patch[8]:= False; // Not in resizing
      Patch[9]:= True;  // Set to false to use new optimized multi-select behavior (sorted list)
    end;

    destructor TwwDBGrid.Destroy;
    var i: integer;
    begin
      if FIniAttributes.Enabled then
        try
           SaveToIniFile;
           FIniAttributes.Enabled:=False; // 10/25/02 - Don't need to save anymore in linkactive
        finally
        end;

      OrigSelected.Free;

      for i:= 0 to bookmarks.count-1 do begin
         if (datasource<>nil) and (datasource.dataset<>nil) then
            datasource.dataset.FreeBookmark(TBookmark(bookmarks.items[i]))
         // 1/21/05 - Call FreeMem if datasource is already released
         else
            FreeMem(TBookmark(bookmarks.items[i]));
      end;
      bookmarks.Free;
      bookmarks:= Nil;

      { 5/13/98 - Free shift select bookmark}
      if ShiftSelectMode and (ShiftSelectBookmark<>Nil) then
      begin
         ShiftSelectMode:= False;

         if (datasource<>nil) and (datasource.dataset<>nil) then
         begin
            datasource.dataset.FreeBookmark(ShiftSelectBookmark);
         end
         // 1/21/05 - Call FreeMem if datasource is already released
         else FreeMem(ShiftSelectBookmark);
      end;


      for i:= 0 to FDependentComponents.count-1 do begin
         TwwCheatCastNotify(FDependentComponents[i]).notification(self, opRemove);
      end;
      FDependentComponents.Free;

//      for i:= 0 to FCustomControls.count-1 do TwwCustomControlItem(FCustomControls[i]).Free;
//      FCustomControls.Free;
//      if FCustomControls<>nil then
//         FreeMem(FCustomControls);
//      FCustomControls:=nil;

      SelectedRecordList.Free;

      FIniAttributes.Free;
      FExportOptions.Free;

      inherited Destroy;
    end;

    procedure TwwDBGrid.SetFixedCols(val: integer);
    begin
       if (csDesigning in ComponentState) then begin
          if ((dataSource<>Nil) and (dataSource.dataSet<>Nil) and
             (dataSource.dataSet.active) and (val+xIndicatorOffset>=ColCount)) or
             (val<0) then
          begin
             MessageDlg('Invalid value for FixedCols', mtWarning, [mbok], 0);
             exit;
          end
       end;

       FFixedCols:= val;
       LayoutChanged;
    end;

    Function TwwDBGrid.GetFixedCols: integer;
    begin
       result:= FFixedCols;
    end;

    Function TwwDBGrid.GetDataSource: TDataSource;
    begin
       if (inherited DataSource) is TDataSource then
          result:= (inherited DataSource) as TDataSource
       else result:= Nil;
    end;

    Procedure TwwDBGrid.SetDataSource(val: TDataSource);
    begin
       Inherited DataSource:= Val;
    end;

    procedure TwwDBGrid.SetwwMemoAttributes(sel : TwwMemoAttributes);
    begin
        FMemoAttributes:= sel;
        redrawGrid;
    end;

    Function TwwDBGrid.GetTitleColor: TColor;
    begin
       result:= inherited TitleColor;
    end;

    procedure TwwDBGrid.SetTitleColor(sel: TColor);
    begin
       if sel<>inherited TitleColor then
       begin
         inherited TitleColor:= sel;
         LayoutChanged;
       end
    end;

{    Function TwwDBGrid.GetDataLineColor: TColor;
    begin
       result:= inherited DataLineColor;
    end;

    procedure TwwDBGrid.SetDataLineColor(sel: TColor);
    begin
       if sel<>inherited TitleColor then