unit VAComponent3;

interface
uses classes,grids,DsgnIntf,Forms,Graphics,stdctrls,Controls,
     extctrls,windows,dialogs,sysutils,messages,quickrpt,Qrctrls,
     VATypes, Clipbrd;

{$R-}

Const
    DefaultPanelWidth=17;
    DefaultListBoxHeight=192;
{--------------------------------------------------------------------------}
    ReservedRowData=1; //1 Byte         00000001 = 1
       rtHiden = 1;    //1-   -    (1)/  (0)

       rtRowFlag = 6;      { = 00000110 -     (Exemple:  if (value: byte) and rtRowFlag = rtChanged then ...)}
       rtNoChanged = 0;      //
       rtChanged = 2;        //-- 2,3          
       rtDeleted = 4;        //-- rtNoChanged (00), rtChanged (01), rtDeleted (10), rtAdded (11)
       rtAdded = 6;        {}

       rtReadOnly = 16; //4 -   (true=1, false=0)
                        {5,..,8   }
{--------------------------------------------------------------------------}

type
   TArrayValueSize = array[0..255] of Cardinal;
   TArrayValueAccuracy = array[0..255] of Integer;
   TArrayValueType = array[0..255] of TVAValueType;
   TByteArray = array[0..MaxInt mod 2] of Byte;
   TPPArray = ^TByteArray;
   PString = ^String;
   TSortArray = array[0..5] of integer;

   TOnValidate = procedure(Sender: TObject; ACol,ARow: integer) of object;
   TOnTitleClick = procedure(ACol: integer) of object;
   TOnAcceptAddRow = procedure(ARow: integer; var Accept: boolean) of object;

type

   TVAGrid = class;
   TVAColumns = class;
   TVAColumn = class;

   TOnDataTransformerSet = procedure(ValueType,ValueTypeSet: TVAValueType; ValueNumber: integer; PData,PValueIs,PValueSet: Pointer) of object;

   TVADataTransformer = class(TObject)
   private
   fOnDataTransformerSet: TOnDataTransformerSet;
   procedure SetString(Value: String);
   function GetString: string;
   procedure SetInteger(Value: LongInt);
   function GetInteger: LongInt;
   procedure SetFloat(Value: Real);
   function GetFloat: Real;
   procedure SetBoolean(Value: boolean);
   function GetBoolean: boolean;
   procedure SetDate(Value: TDateTime);
   function GetDate: TDateTime;
   function GetExist: boolean;

   public
   ValueType: TVAValueType;
   PValue: Pointer;
   PData: Pointer;
   ValueNumber: integer;
   Accuracy: integer;
   property AsString: string Read GetString Write SetString stored false;
   property AsInteger: LongInt Read GetInteger Write SetInteger stored false;
   property AsFloat: Real Read GetFloat Write SetFloat stored false;
   property AsBoolean: boolean Read GetBoolean Write SetBoolean stored false;
   property AsDate: TDateTime Read GetDate Write SetDate stored false;
   property OnDataTransformerSet: TOnDataTransformerSet Read fOnDataTransformerSet Write fOnDataTransformerSet stored false;
   property Exist: boolean Read GetExist;
   end;


   TVAGridDataObject = class(TObject)
   private
   fVAGrid: TVAGrid;
   fList: TList;
   fValueType: TArrayValueType;
   fValueSize: TArrayValueSize;
   fValueDist: TArrayValueSize;
   fValueAccuracy: TArrayValueAccuracy;
   fValueCount: integer;
   fHideRowCount: integer;
   fAllValueSize: Cardinal;
   fDataTransformer: TVADataTransformer;
   fGridRefresh: boolean;
   fShowHiden: boolean;
   fRememberChange: boolean;
   fIsLastSort: boolean;
   fComplexLast: boolean;
   fLastSortCol: integer;
   fLastSortArray: TSortArray;
   fLastSortColCount: integer;
   procedure SetValueType(index: integer; Value: TVAValueType);
   function GetValueType(index: integer): TVAValueType;
   procedure SetValueCount(Count: integer);
   procedure FillValueDistant;
   procedure ClearData(P: TPPArray);
   procedure FreeData(P: TPPArray);
   procedure SetRowCount(RowCount: integer);
   function GetRowCount: integer;
   function NewValue: Pointer;
   function GetValue(Col,Row: integer): TVADataTransformer;
   function GetRowParam(Row: integer): byte;
   procedure SetRowParam(Row: integer; Param: byte);
   procedure SetGridRefresh(Value: boolean);
   procedure ChangeRowParam(ValueType,ValueTypeSet: TVAValueType; ValueNumber: integer; PData,PValueIs,PValueSet: Pointer);
   procedure SetValueAccuracy(index: integer; Value: integer);
   function GetValueAccuracy(index: integer): integer;

   public
   constructor Create; virtual;
   destructor Destroy; override;
   procedure Delete(Row: integer);
   procedure Insert(Row: integer);
   procedure MoveRow(CurIndex,NewIndex: integer);
   procedure ExchangeRow(index1,index2: integer);
   procedure Sort(Col: integer);
   procedure ComplexSort(ColArray: TSortArray; ColCount: integer);
   procedure LastSort;
   function fComplexSort(P1,P2: Pointer): integer;
   procedure Assign(Source: TVAGridDataObject); virtual;
   procedure ClearRowParam;
   property ValueType[index: integer]: TVAValueType Read GetValueType Write SetValueType stored false;
   property ValueAccuracy[index: integer]: Integer Read GetValueAccuracy Write SetValueAccuracy stored false;
   property ValueCount: integer Read fValueCount Write SetValueCount stored false;
   property RowCount: integer Read GetRowCount Write SetRowCount stored false;
   property HideRowCount: integer Read fHideRowCount stored false;
   property Value[Col,Row: integer]: TVADataTransformer Read GetValue; default;
   property RowParam[Row: integer]: byte Read GetRowParam Write SetRowParam stored false;
   property ValueSize: Cardinal Read fAllValueSize;
   property List: TList Read fList;
   property VAGrid: TVAGrid Read fVAGrid Write fVAGrid stored false;
   property GridRefresh: boolean Read fGridRefresh Write SetGridRefresh stored false;
   property ShowHiden: boolean Read fShowHiden Write fShowHiden stored false;
   property RememberChange: boolean Read fRememberChange Write fRememberChange stored false;

   end;




  TVAColTitle = class(TPersistent)
         private
             fOwner: TVAColumn;
             fCaption: string;
             fAlignment: TAlignment;
             fFont: TFont;
             fColor: TColor;
             fPressed: boolean;
             procedure SetCaption(Value: string);
             procedure SetAlignment(Value: TAlignment);
             procedure SetFont(Value: TFont);
             procedure SetColor(Value: TColor);
         public
             constructor Create(AOwner: TVAColumn); virtual;
             destructor Destroy; override;
             procedure Free;
             procedure Assign(Value: TVAColTitle); virtual;
             function GetOwner: TPersistent; override;
             property Owner: TVAColumn Read fOwner;
             property Pressed: boolean Read fPressed Write fPressed stored false;
         published
             property Caption: string Read fCaption Write SetCaption;
             property Alignment: TAlignment Read fAlignment Write SetAlignment;
             property Font: TFont Read fFont Write SetFont;
             property Color: TColor Read fColor Write SetColor;
         end;


    TVAColumn = class(TCollectionItem)
    private
    fWidth: integer;
    fStrings: TStringList;
    fFont: TFont;
    fAlignment: TAlignment;
    fColor: TColor;
    fTitle: TVAColTitle;
    fReadOnly: boolean;
    fVisible: boolean;
    fValueType: TVAValueType;
    fValueAccuracy: Integer;
    fDrawImage: boolean;
    fMask: string;
    fName: string;
    fFieldName: string;
    procedure SetStrings(Value: TStringList);
    procedure SetWidth(Value: integer);
    function GetWidth: integer;
    procedure SetFont(Value: TFont);
    procedure SetAlignment(Value: TAlignment);
    procedure SetColor(Value: TColor);
    procedure SetTitle(Value: TVAColTitle);
    procedure SetReadOnly(Value: boolean);
    procedure SetVisible(Value: boolean);
    procedure SetValueType(Value: TVAValueType);
    procedure SetDrawImage(Value: boolean);
    procedure SetMask(Value: string);
    procedure SetName(Name: string);
    procedure SetAccuracy(Value: integer);

    protected

    public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Update;
    procedure SetIndex(Value: integer); override;

    published
    property Width: integer Read GetWidth Write SetWidth;
    property Strings: TStringList Read fStrings Write SetStrings;
    property Font: TFont Read fFont Write SetFont;
    property Alignment: TAlignment Read fAlignment Write SetAlignment;
    property Color: TColor Read fColor Write SetColor;
    property Title: TVAColTitle Read fTitle Write SetTitle;
    property ReadOnly: boolean Read fReadOnly Write SetReadOnly stored fReadOnly;
    property Visible: boolean Read fVisible Write SetVisible;
    property ValueType: TVAValueType Read fValueType Write SetValueType;
    property DrawImage: boolean Read fDrawImage Write SetDrawImage stored fDrawImage;
    property Mask: string Read fMask Write SetMask;
    property Name: string Read fName Write SetName;
    property FieldName: string Read fFieldName Write fFieldName;
    property Accuracy: integer Read fValueAccuracy Write SetAccuracy stored true;

    end;

    TVAColumns = class(TCollection)
    private
    fOwner: TVAGrid;
    fNeedColUpdate: boolean;
    function GetItem(Index: Integer): TVAColumn;
    procedure SetItem(Index: Integer; Value: TVAColumn);

    protected
    function GetOwner: TPersistent; override;

    public
    constructor Create(AOwner: TVAGrid);
    function Add: TVAColumn;
    property Owner: TVAGrid read fOwner;
    property Items[Index: Integer]: TVAColumn read GetItem write SetItem; default;

    published

    end;

    TVAEditor = class(TInplaceEdit)
    private
    fPanel: TPanel;
    procedure DoEnter; override;

    public
    constructor Create(AOwner: TComponent);override;
    destructor Destroy; override;
    property Color;
    property Font;

    end;

    TButtonPanel = class(TPanel)
    private
    fOwner: TVAGrid;

    protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Click; override;

    public
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;

    end;

    TDropDownList = class(TPanel)
    private
    fOwner: TVAGrid;

    protected
    procedure ListMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure ListMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure ListEnter(Sender: TObject);

    public
    fList: TListBox;
    fEdit: TEdit;
    fStringsPoint: Pointer;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetComponent;

    end;

    TVAGrid = class(TDrawGrid)
    private
    fColumns: TVAColumns;
    fFirstUpdated: boolean;
    fData: TVAGridDataObject;
    fEditor: TVAEditor;
    fOldSetText: string;
    fLastKeyDown: integer;
    fButtonPanel: TButtonPanel;
    fDropDownList: TDropDownList;
    fOnValidate: TOnValidate;
    fOnTitleClick: TOnTitleClick;
    fOnAcceptAddRow: TOnAcceptAddRow;
    fSelectedColor: TColor;
    fSelectedFont: TFont;
    fFixedColor: TColor;
    fFixedFont: TFont;
    fDropDownListColor: TColor;
    fSortArray: TSortArray;
    fSortColCount: integer;
    fAutoSort: boolean;
    fAcceptAddRow: boolean;
    fStartedAddRow: boolean;
    GoNext,GoPrev: integer;
    fImageList: TImageList;
    TabCount: integer;
    fCanFixCol: boolean;
    fCanFixColIs: integer;
    procedure SetColumns(Columns: TVAColumns);
    procedure SetGridDataObject(Data: TVAGridDataObject);
    procedure PeintButtonPanel(ACol,ARow: integer);
    procedure PeintDropDownList(ACol,ARow: integer);
    procedure SortColumn;
    procedure SetDropDownListColor(Color: TColor);
    procedure SetSelectedFont(Font: TFont);
    procedure SetFixedFont(Font: TFont);
    function GetCells(ColName: string; Row: integer): TVADataTransformer;
    function GetColByName(ColName: string): TVAColumn;

    protected
    function CreateEditor: TInplaceEdit; virtual;
    function GetEditText(ACol, ARow: Longint): string; override;
    procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
    procedure SizeChanged(OldColCount, OldRowCount: Longint); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    function CanEditShow: Boolean; override;
    function SelectCell(ACol, ARow: Longint): Boolean; override;
    procedure ColWidthsChanged; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure DblClick; override;
    procedure WndProc(var Message: TMessage); override;
    function CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean; override;
    procedure TopLeftChanged; override;

    public
    MouseDownCol,MouseDownRow: integer;
    DefaultTransformer: TVADataTransformer;
    RefreshGridDataObject: boolean;
    constructor Create(AOwner: TComponent);override;
    destructor Destroy;override;
    procedure UpdateColumns;
    procedure UpdateColumn(index: integer);
    procedure Loaded; override;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
    procedure Sort(ColName: string);
    property GridDataObject: TVAGridDataObject Read fData Write SetGridDataObject stored false;
    property Cells[ColName: string; Row: integer]: TVADataTransformer Read GetCells stored false; default;
    property ColByName[ColName: string]: TVAColumn Read GetColByName stored false;

    published
    property Columns: TVAColumns Read fColumns Write SetColumns;
    property OnValidate: TOnValidate Read fOnValidate Write fOnValidate;
    property SelectedColor: TColor Read fSelectedColor Write fSelectedColor;
    property SelectedFont: TFont Read fSelectedFont Write SetSelectedFont;
    property FixedColor: TColor Read fFixedColor write fFixedColor;
    property FixedFont: TFont Read fFixedFont write SetFixedFont;
    property AutoSort: boolean Read fAutoSort Write fAutoSort;
    property OnTitleClick: TOnTitleClick Read fOnTitleClick Write fOnTitleClick;
    property ImageList: TImageList Read fImageList Write fImageList;
    property DropDownListColor: TColor Read fDropDownListColor Write SetDropDownListColor;
    property AcceptAddRow: boolean Read fAcceptAddRow Write fAcceptAddRow;
    property OnAcceptAddRow: TOnAcceptAddRow Read fOnAcceptAddRow Write fOnAcceptAddRow;

    end;
