home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sibdemo3.zip / SOURCE.DAT / SOURCE / SPCC / GRIDS.PAS < prev    next >
Pascal/Delphi Source File  |  1998-05-19  |  85KB  |  2,647 lines
  1.  
  2. {╔══════════════════════════════════════════════════════════════════════════╗
  3.  ║                                                                          ║
  4.  ║     Sibyl Portable Component Classes                                     ║
  5.  ║                                                                          ║
  6.  ║     Copyright (C) 1995,97 SpeedSoft Germany,   All rights reserved.      ║
  7.  ║                                                                          ║
  8.  ╚══════════════════════════════════════════════════════════════════════════╝}
  9.  
  10. Unit Grids;
  11.  
  12.  
  13. Interface
  14.  
  15. {$IFDEF OS2}
  16. Uses Os2Def,BseDos,PmWin,PmGpi,PmDev,PmStdDlg;
  17. {$ENDIF}
  18.  
  19. {$IFDEF Win95}
  20. Uses WinDef,WinBase,WinNt,WinUser,WinGDI,CommCtrl;
  21. {$ENDIF}
  22.  
  23. Uses Dos,Classes,Forms,Graphics,Buttons,StdCtrls,DBBase,Dialogs,Mask;
  24.  
  25.  
  26. Type
  27.     {$M+}
  28.     TGridOptions=Set Of (goBorder,goRowSizing,goColSizing,goEditing,
  29.                          goAlwaysShowEditor,goShowSelection,goAlwaysShowSelection,
  30.                          goMouseSelect);
  31.  
  32.     TSelectCell=Procedure(Sender:TObject;Col,Row:LongInt) Of Object;
  33.     {$M-}
  34.  
  35.     PGridWidthArray=^TGridWidthArray;
  36.     TGridWidthArray=Array[0..$0FFFFFFF] Of LongInt;
  37.  
  38.  
  39.     TGridDrawState=Set Of (gdSelected,gdFocused,gdFixed);
  40.  
  41.     TGridCoord=Record
  42.                     X:LongInt;
  43.                     Y:LongInt;
  44.     End;
  45.  
  46.     TGridRect=Record
  47.        Case Integer Of
  48.          0:(Left, Top, Right, Bottom:LongInt);
  49.          1:(TopLeft, BottomRight:TGridCoord);
  50.     End;
  51.  
  52.     {custom Grid}
  53.     TGrid=Class(TControl)
  54.       Private
  55.          FUpdateLocked:Boolean;
  56.          FFixedColor:TColor;
  57.          FFixedRows:LongInt;
  58.          FFixedCols:LongInt;
  59.          FDefaultColWidth:LongInt;
  60.          FDefaultRowHeight:LongInt;
  61.          FColCount:LongInt;
  62.          FRowCount:LongInt;
  63.          FColWidths:PGridWidthArray;
  64.          FRowHeights:PGridWidthArray;
  65.          FColList:TList;  {List Of TColEntry}
  66.          FScrollBars:TScrollStyle;
  67.          FSizeCol:LongInt;
  68.          FSizeRow:LongInt;
  69.          FSizeShape:TCursor;
  70.          FSizeStartX,FSizeStartY,FSizeX,FSizeY:LongInt;
  71.          FOptions:TGridOptions;
  72.          FEntryColor:TColor;
  73.          FGridUpdateLocked:Boolean;
  74.          FSelectCol,FSelectRow:LongInt;
  75.          FOnSelectCell:TSelectCell;
  76.          FVertScrollBar:TScrollBar;
  77.          FHorzScrollBar:TScrollBar;
  78.       Protected
  79.          FLeftExtent,FUpExtent:LongInt;
  80.          FLeftScrolled,FUpScrolled:LongInt;
  81.       Private
  82.          Procedure SetFixedColor(NewColor:TColor);
  83.          Procedure SetFixedRows(NewRows:LongInt);
  84.          Procedure SetFixedCols(NewCols:LongInt);
  85.          Procedure SetDefaultColWidth(NewWidth:LongInt);
  86.          Procedure SetDefaultRowHeight(NewHeight:LongInt);
  87.          Procedure SetColCount(NewCount:LongInt);
  88.          Procedure SetRowCount(NewCount:LongInt);
  89.          Procedure SetScrollBars(NewValue:TScrollStyle);
  90.          Procedure CreateHScrollBar;
  91.          Procedure CreateVScrollBar;
  92.          Procedure UpdateScrollBars;
  93.          Function GetSizeItem(Const pt:TPoint;Var Col,Row:LongInt):TCursor;
  94.          Procedure SetOptions(NewOptions:TGridOptions);
  95.          Procedure SetEntryColor(NewColor:TColor);
  96.          Procedure SetColWidth(Col:LongInt;NewWidth:LongInt);
  97.          Function GetColWidth(Col:LongInt):LongInt;
  98.          Procedure SetRowHeight(Row:LongInt;NewHeight:LongInt);
  99.          Function GetRowHeight(Row:LongInt):LongInt;
  100.          Procedure SetUpdateLocked(NewValue:Boolean);
  101.          Procedure GetGridExtent(Var CX,CY:LongInt);
  102.          Procedure ClearFocus;Virtual;
  103.          Function GetVisibleRowCount:LongInt;
  104.          Function GetVisibleColCount:LongInt;
  105.          Procedure SetTopRow(NewValue:LongInt);
  106.          Procedure SetLeftCol(NewValue:LongInt);
  107.          Function GetGridWidth:LongInt;
  108.          Function GetGridHeight:LongInt;
  109.          Procedure SetCol(NewValue:LongInt);
  110.          Procedure SetRow(NewValue:LongInt);
  111.          Procedure SetCellColors(Col,Row:LongInt;AState:TGridDrawState);
  112.          Function GetSelection:TGridRect;
  113.          Procedure SetSelection(NewValue:TGridRect);
  114.          Function ScrollHorzTrack(ScrollBar:TScrollBar;NewPosition:LongInt):LongInt;
  115.          Function ScrollVertTrack(ScrollBar:TScrollBar;NewPosition:LongInt):LongInt;
  116.          Procedure SetScrollBar(ScrollBar:TScrollBar;NewValue:LongInt);Virtual;
  117.       Protected
  118.          Procedure SetupComponent;Override;
  119.          Procedure Resize;Override;
  120.          Procedure Scroll(ScrollBar:TScrollBar;ScrollCode:TScrollCode;Var ScrollPos:LongInt);Override;
  121.          Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
  122.          Procedure MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
  123.          Procedure MouseMove(ShiftState:TShiftState;X,Y:LongInt);Override;
  124.          Procedure KillFocus;Override;
  125.          Procedure SetFocus;Override;
  126.          Procedure ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);Override;
  127.          Function SelectCell(Col,Row:LongInt):Boolean;Virtual;
  128.          Function CellRect(Col,Row:LongInt):TRect;
  129.          Procedure UpdateGridContents(NewCols,NewRows:LongInt);Virtual;
  130.          Procedure DrawCell(Col,Row:LongInt;rec:TRect;AState:TGridDrawState);Virtual;
  131.          Procedure SetupCellColors(Col,Row:LongInt;AState:TGridDrawState;Var background,ForeGround:TColor);Virtual;
  132.          Procedure RowHeightChanged(Row:LongInt);Virtual;
  133.          Procedure ColWidthChanged(Col:LongInt);Virtual;
  134.       Public
  135.          Procedure Redraw(Const rec:TRect);Override;
  136.          Destructor Destroy;Override;
  137.          Procedure Show;Override;
  138.          Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
  139.          Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
  140.          Procedure BeginUpdate;
  141.          Procedure EndUpdate;
  142.       Public
  143.          Property GridRects[Col,Row:LongInt]:TRect Read CellRect;
  144.          Property ColWidths[Col:LongInt]:LongInt Read GetColWidth Write SetColWidth;
  145.          Property RowHeights[Row:LongInt]:LongInt Read GetRowHeight Write SetRowHeight;
  146.          Property GridUpdateLocked:Boolean Read FGridUpdateLocked Write SetUpdateLocked;
  147.          Property Col:LongInt Read FSelectCol Write SetCol;
  148.          Property Row:LongInt Read FSelectRow Write SetRow;
  149.          Property Selection:TGridRect Read GetSelection Write SetSelection;
  150.          Property VisibleRowCount:LongInt Read GetVisibleRowCount;
  151.          Property VisibleColCount:LongInt Read GetVisibleColCount;
  152.          Property TopRow:LongInt Read FUpScrolled Write SetTopRow;
  153.          Property LeftCol:LongInt Read FLeftScrolled Write SetLeftCol;
  154.          Property GridWidth:LongInt Read GetGridWidth;
  155.          Property GridHeight:LongInt Read GetGridHeight;
  156.          Property FixedColor:TColor Read FFixedColor Write SetFixedColor;
  157.          Property FixedRows:LongInt Read FFixedRows Write SetFixedRows;
  158.          Property FixedCols:LongInt Read FFixedCols Write SetFixedCols;
  159.          Property DefaultColWidth:LongInt Read FDefaultColWidth Write SetDefaultColWidth;
  160.          Property DefaultRowHeight:LongInt Read FDefaultRowHeight Write SetDefaultRowHeight;
  161.          Property ColCount:LongInt Read FColCount Write SetColCount;
  162.          Property RowCount:LongInt Read FRowCount Write SetRowCount;
  163.          Property ScrollBars:TScrollStyle Read FScrollBars Write SetScrollBars;
  164.          Property Options:TGridOptions Read FOptions Write SetOptions;
  165.          Property EntryColor:TColor Read FEntryColor Write SetEntryColor;
  166.          Property VertScrollBar:TScrollBar Read FVertScrollBar;
  167.          Property HorzScrollBar:TScrollBar Read FHorzScrollBar;
  168.  
  169.          Property OnSelectCell:TSelectCell Read FOnSelectCell Write FOnSelectCell;
  170.          Property OnClick;
  171.       Published
  172.          Property PopupMenu;
  173.     End;
  174.  
  175.  
  176.     TStringGridData=Class
  177.          Data:PString;
  178.     End;
  179.  
  180.     TStringGrid=Class;
  181.  
  182.     {$M+}
  183.     TGetCellEvent=Procedure(Grid:TStringGrid;Col,Row:LongInt;Var Result:String) Of Object;
  184.     TSetCellEvent=Procedure(Grid:TStringGrid;Col,Row:LongInt;Var NewContent:String) Of Object;
  185.     TCanEditEvent=Procedure(Grid:TStringGrid;Col,Row:LongInt;Var AllowEdit:Boolean) Of Object;
  186.     {$M-}
  187.  
  188.     TInplaceEdit=Class
  189.         Private
  190.             Procedure SetInternalText(Const NewValue:String);
  191.             Function GetInternalControl:TControl;
  192.             Constructor Create(Grid:TGrid;Col,Row:LongInt);Virtual;
  193.         Private
  194.             FGrid:TGrid;
  195.             FCol,FRow:LongInt;
  196.         Protected
  197.             Function GetText:String;Virtual;Abstract;
  198.             Procedure SetText(Const NewValue:String);Virtual;Abstract;
  199.             Function GetControl:TControl;Virtual;Abstract;
  200.             Procedure SetWindowPos(X,Y,W,H:LongInt);Virtual;Abstract;
  201.             Procedure Show;Virtual;Abstract;
  202.             Procedure Hide;Virtual;Abstract;
  203.         Public
  204.             Procedure SetupEdit(Grid:TGrid);Virtual;Abstract;
  205.             Destructor Destroy;Virtual;
  206.         Public
  207.             Property Text:String read GetText write SetInternalText;
  208.             Property Control:TControl read GetInternalControl;
  209.             Property Grid:TGrid read FGrid;
  210.             Property Col:LongInt read FCol;
  211.             Property Row:LongInt read FRow;
  212.     End;
  213.     TInplaceEditClass=Class Of TInplaceEdit;
  214.  
  215.     {$M+}
  216.     TOnShowEditor=Function(Sender:TGrid;Col,Row:LongInt):TInplaceEditClass Of Object;
  217.  
  218.     TGetEditEvent=Procedure(Sender:TObject;ACol,ARow:Longint;Var Value:String) Of Object;
  219.     TSetEditEvent=Procedure(Sender:TObject;ACol,ARow:Longint;Const Value:String) Of Object;
  220.     {$M-}
  221.  
  222.     TStringGrid=Class(TGrid)
  223.       Private
  224.          FEdit:TInplaceEdit;
  225.          FColumns:TList;
  226.          FOnGetCell:TGetCellEvent;
  227.          FOnSetCell:TSetCellEvent;
  228.          FOnCanEdit:TCanEditEvent;
  229.          FEditorMode:Boolean;
  230.          FOnShowEditor:TOnShowEditor;
  231.          FOnGetEditMask:TGetEditEvent;
  232.          FOnGetEditText:TGetEditEvent;
  233.          FOnSetEditText:TSetEditEvent;
  234.          Procedure EvEntryKillFocus(Sender:TObject);
  235.          Procedure ShowEntry(S:String);
  236.          Procedure ClearFocus;Override;
  237.          Procedure ShowEditorIntern;
  238.          Procedure HideEditorIntern;
  239.          Procedure SetEditorMode(NewValue:Boolean);
  240.       Protected
  241.          Procedure SetupComponent;Override;
  242.          Function GetCell(Col,Row:LongInt):String;Virtual;
  243.          Procedure SetCell(Col,Row:LongInt;Const NewContent:String);Virtual;
  244.          Procedure DrawCell(Col,Row:LongInt;rec:TRect;AState:TGridDrawState);Override;
  245.          Procedure SetupCellDrawing(Col,Row:LongInt;AState:TGridDrawState;
  246.                                     Var Alignment:TAlignment;Var Font:TFont);Virtual;
  247.          Function SelectCell(Col,Row:LongInt):Boolean;Override;
  248.          Procedure CharEvent(Var key:Char;RepeatCount:Byte);Override;
  249.          Procedure ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);Override;
  250.          Procedure Resize;Override;
  251.          Function ShowEditor(Col,Row:LongInt):TInplaceEditClass;Virtual;
  252.       Public
  253.          Destructor Destroy;Override;
  254.          Property Cells[Col,Row:LongInt]:String Read GetCell Write SetCell;
  255.          Property XAlign;
  256.          Property XStretch;
  257.          Property YAlign;
  258.          Property YStretch;
  259.          Property EditorMode:Boolean Read FEditorMode Write SetEditorMode;
  260.          Property InplaceEdit:TInplaceEdit read FEdit;
  261.       Published
  262.          Property Align;
  263.          Property Color;
  264.          Property ColCount;
  265.          Property PenColor;
  266.          Property DefaultColWidth;
  267.          Property DefaultRowHeight;
  268.          Property DragCursor;
  269.          Property DragMode;
  270.          Property Enabled;
  271.          Property EntryColor;
  272.          Property Font;
  273.          Property FixedColor;
  274.          Property FixedCols;
  275.          Property FixedRows;
  276.          Property Options;
  277.          Property ParentColor;
  278.          Property ParentPenColor;
  279.          Property ParentFont;
  280.          Property ParentShowHint;
  281.          Property RowCount;
  282.          Property ScrollBars;
  283.          Property ShowHint;
  284.          Property TabOrder;
  285.          Property TabStop;
  286.          Property Visible;
  287.          Property ZOrder;
  288.  
  289.          Property OnCanDrag;
  290.          Property OnCanEdit:TCanEditEvent Read FOnCanEdit Write FOnCanEdit;
  291.          Property OnCommand;
  292.          Property OnDragDrop;
  293.          Property OnDragOver;
  294.          Property OnEndDrag;
  295.          Property OnEnter;
  296.          Property OnExit;
  297.          Property OnFontChange;
  298.          Property OnGetCell:TGetCellEvent Read FOnGetCell Write FOnGetCell;
  299.          Property OnSetCell:TSetCellEvent Read FOnSetCell Write FOnSetCell;
  300.          Property OnKeyPress;
  301.          Property OnMouseClick;
  302.          Property OnMouseDblClick;
  303.          Property OnMouseDown;
  304.          Property OnMouseMove;
  305.          Property OnMouseUp;
  306.          Property OnResize;
  307.          Property OnScan;
  308.          Property OnSelectCell;
  309.          Property OnSetupShow;
  310.          Property OnStartDrag;
  311.          Property OnShowEditor:TOnShowEditor read FOnShowEditor write FOnShowEditor;
  312.          Property OnGetEditMask:TGetEditEvent read FOnGetEditMask write FOnGetEditMask;
  313.          Property OnGetEditText:TGetEditEvent read FOnGetEditText write FOnGetEditText;
  314.          Property OnSetEditText:TSetEditEvent read FOnSetEditText write FOnSetEditText;
  315.     End;
  316.  
  317.     {$M+}
  318.     TDrawCellEvent=Procedure(Sender:TObject;ACol,ARow:LongInt;
  319.                              rc:TRect;State:TGridDrawState) Of Object;
  320.     TOpenEditorEvent=Procedure(Sender:TObject;ACol,ARow:LongInt) Of Object;
  321.     {$M-}
  322.  
  323.     TDrawGrid=Class(TGrid)
  324.       Private
  325.          FOnDrawCell:TDrawCellEvent;
  326.          FDefaultDrawing:Boolean;
  327.          FEditorMode:Boolean;
  328.          FOnOpenEditor:TOpenEditorEvent;
  329.          FOnCloseEditor:TNotifyEvent;
  330.       Private
  331.          Procedure SetDefaultDrawing(NewValue:Boolean);
  332.          Procedure SetEditorMode(NewValue:Boolean);
  333.          Procedure ShowEditor;
  334.          Procedure HideEditor;
  335.       Protected
  336.          Procedure SetupComponent;Override;
  337.          Procedure DrawCell(Col,Row:LongInt;rec:TRect;AState:TGridDrawState);Override;
  338.          Function SelectCell(Col,Row:LongInt):Boolean;Override;
  339.          Procedure CloseEditor;Virtual;
  340.          Procedure OpenEditor(Col,Row:LongInt);Virtual;
  341.       Public
  342.          Procedure SetupCellColors(Col,Row:LongInt;AState:TGridDrawState;Var background,ForeGround:TColor);Override;
  343.          Procedure MouseToCell(X,Y:LongInt;Var ACol,ARow:LongInt);
  344.       Public
  345.          Property EditorMode:Boolean Read FEditorMode Write SetEditorMode;
  346.       Published
  347.          Property FixedColor;
  348.          Property FixedRows;
  349.          Property FixedCols;
  350.          Property DefaultColWidth;
  351.          Property DefaultRowHeight;
  352.          Property ColCount;
  353.          Property RowCount;
  354.          Property ScrollBars;
  355.          Property Options;
  356.          Property EntryColor;
  357.  
  358.          Property OnSelectCell;
  359.          Property OnClick;
  360.          Property OnDrawCell:TDrawCellEvent Read FOnDrawCell Write FOnDrawCell;
  361.          Property OnOpenEditor:TOpenEditorEvent Read FOnOpenEditor Write FOnOpenEditor;
  362.          Property OnCloseEditor:TNotifyEvent Read FOnCloseEditor Write FOnCloseEditor;
  363.          Property DefaultDrawing:Boolean Read FDefaultDrawing Write SetDefaultDrawing;
  364.     End;
  365.  
  366. Implementation
  367.  
  368. {
  369. ╔═══════════════════════════════════════════════════════════════════════════╗
  370. ║                                                                           ║
  371. ║ Speed-Pascal/2 Version 2.0                                                ║
  372. ║                                                                           ║
  373. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  374. ║                                                                           ║
  375. ║ This section: TInplaceEdit Class Implementation                           ║
  376. ║                                                                           ║
  377. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  378. ║                                                                           ║
  379. ╚═══════════════════════════════════════════════════════════════════════════╝
  380. }
  381.  
  382. Constructor TInplaceEdit.Create(Grid:TGrid;Col,Row:LongInt);
  383. Begin
  384.      Inherited Create;
  385.      FGrid:=Grid;
  386.      FCol:=Col;
  387.      FRow:=Row;
  388.      SetupEdit(Grid);
  389. End;
  390.  
  391. Destructor TInplaceEdit.Destroy;
  392. Begin
  393.     FGrid:=Nil;
  394.     Inherited Destroy;
  395. End;
  396.  
  397. Procedure TInplaceEdit.SetInternalText(Const NewValue:String);
  398. Begin
  399.      SetText(NewValue);
  400. End;
  401.  
  402. Function TInplaceEdit.GetInternalControl:TControl;
  403. Begin
  404.      Result:=GetControl;
  405. End;
  406.  
  407. {
  408. ╔═══════════════════════════════════════════════════════════════════════════╗
  409. ║                                                                           ║
  410. ║ Speed-Pascal/2 Version 2.0                                                ║
  411. ║                                                                           ║
  412. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  413. ║                                                                           ║
  414. ║ This section: TDefaultEdit Class Implementation                           ║
  415. ║                                                                           ║
  416. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  417. ║                                                                           ║
  418. ╚═══════════════════════════════════════════════════════════════════════════╝
  419. }
  420.  
  421.  
  422. Type
  423.   TDefaultEdit=Class(TInplaceEdit)
  424.         Protected
  425.             FEdit:TEdit;
  426.             FEditMask:String;
  427.         Protected
  428.             Function GetText:String;Override;
  429.             Function GetControl:TComponent;Override;
  430.             Procedure SetText(Const NewValue:String);Override;
  431.             Procedure SetWindowPos(X,Y,W,H:LongInt);Override;
  432.             Procedure SetupEdit(Grid:TGrid);Override;
  433.             Destructor Destroy;Override;
  434.             Procedure Show;Override;
  435.             Procedure Hide;Override;
  436.     End;
  437.  
  438. Function TDefaultEdit.GetText:String;
  439. Begin
  440.      Result:=FEdit.Text;
  441. End;
  442.  
  443. Function TDefaultEdit.GetControl:TControl;
  444. Begin
  445.      Result:=FEdit;
  446. End;
  447.  
  448. Procedure TDefaultEdit.SetText(Const NewValue:String);
  449. Begin
  450.      FEdit.Text:=NewValue;
  451. End;
  452.  
  453. Procedure TDefaultEdit.SetWindowPos(X,Y,W,H:LongInt);
  454. Begin
  455.      FEdit.SetWindowPos(X,Y,W,H);
  456. End;
  457.  
  458. Procedure TDefaultEdit.SetupEdit(Grid:TGrid);
  459. Var EditMask:String;
  460. Begin
  461.      EditMask:='';
  462.      If TStringGrid(Grid).OnGetEditMask<>Nil Then TStringGrid(Grid).OnGetEditMask(Self,Col,Row,EditMask);
  463.  
  464.      If FEdit=Nil Then
  465.      Begin
  466.         If EditMask<>'' Then
  467.         Begin
  468.              FEdit:=TMaskEdit.Create(Grid);
  469.              TMaskEdit(FEdit).EditMask:=EditMask;
  470.         End
  471.         Else FEdit.Create(Grid);
  472.         FEdit.BorderStyle:=bsNone;
  473.      End
  474.      Else If ((EditMask<>'')And(not (FEdit Is TMaskEdit))) Then
  475.      Begin
  476.           FEdit.Destroy;
  477.           FEdit:=TMaskEdit.Create(Grid);
  478.           TMaskEdit(FEdit).EditMask:=EditMask;
  479.      End
  480.      Else If ((FEditMask='')And(FEdit Is TMaskEdit)) Then
  481.      Begin
  482.           FEdit.Destroy;
  483.           FEdit.Create(Nil);
  484.      End;
  485. End;
  486.  
  487. Destructor TDefaultEdit.Destroy;
  488. Begin
  489.      FEdit.Destroy;
  490.      Inherited Destroy;
  491. End;
  492.  
  493. Procedure TDefaultEdit.Show;
  494. Begin
  495.      FEdit.SelLength := 0; // clear selection
  496.      FEdit.SelStart:=0;
  497.      FEdit.Show;
  498. End;
  499.  
  500. Procedure TDefaultEdit.Hide;
  501. Begin
  502.      FEdit.Hide;
  503. End;
  504.  
  505. {
  506. ╔═══════════════════════════════════════════════════════════════════════════╗
  507. ║                                                                           ║
  508. ║ Speed-Pascal/2 Version 2.0                                                ║
  509. ║                                                                           ║
  510. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  511. ║                                                                           ║
  512. ║ This section: TGrid Class Implementation                                  ║
  513. ║                                                                           ║
  514. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  515. ║                                                                           ║
  516. ╚═══════════════════════════════════════════════════════════════════════════╝
  517. }
  518.  
  519. Procedure TGrid.BeginUpdate;
  520. Begin
  521.      FUpdateLocked:=True;
  522. End;
  523.  
  524. Procedure TGrid.EndUpdate;
  525. Begin
  526.      FUpdateLocked:=False;
  527.      Invalidate;
  528. End;
  529.  
  530. Procedure TGrid.ClearFocus;
  531. Var rc:TRect;
  532. Begin
  533.      If ((FSelectCol>=0)And(FSelectRow>=0)) Then
  534.      Begin
  535.           rc:=GridRects[FSelectCol,FSelectRow];
  536.           FSelectCol:=-1;
  537.           FSelectRow:=-1;
  538.           InvalidateRect(rc);
  539.           Update;
  540.      End;
  541. End;
  542.  
  543. Procedure TGrid.KillFocus;
  544. Var rc:TRect;
  545. Begin
  546.      If ((FSelectCol>=0)And(FSelectRow>=0)) Then
  547.      Begin
  548.           rc:=GridRects[FSelectCol,FSelectRow];
  549.           InvalidateRect(rc);
  550.           Update;
  551.      End;
  552.      Inherited KillFocus;
  553. End;
  554.  
  555. Procedure TGrid.SetFocus;
  556. Var rc:TRect;
  557. Begin
  558.      If ((FSelectCol>=0)And(FSelectRow>=0)) Then
  559.      Begin
  560.           rc:=GridRects[FSelectCol,FSelectRow];
  561.           InvalidateRect(rc);
  562.           Update;
  563.      End;
  564.      Inherited SetFocus;
  565. End;
  566.  
  567.  
  568. Procedure TGrid.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
  569. Type PGridSizes=^TGridSizes;
  570.      TGridSizes=Record
  571.          EntryType:Byte;
  572.          Index:LongInt;
  573.          Value:LongInt;
  574.      End;
  575. Var  sizes:PGridSizes;
  576.      T:LongInt;
  577. Begin
  578.      If ResName = rnGridSizes Then
  579.      Begin
  580.           sizes:=@Data;
  581.           T:=0;
  582.           While T<DataLen Do
  583.           Begin
  584.                If sizes^.EntryType=1
  585.                Then ColWidths[sizes^.Index]:=sizes^.Value {Col entry}
  586.                Else RowHeights[sizes^.Index]:=sizes^.Value;
  587.                Inc(T,SizeOf(TGridSizes));
  588.                Inc(sizes,SizeOf(TGridSizes));
  589.           End;
  590.      End
  591.      Else Inherited ReadSCUResource(ResName,Data,DataLen);
  592. End;
  593.  
  594.  
  595. Function TGrid.WriteSCUResource(Stream:TResourceStream):Boolean;
  596. Const
  597.      ColEntry:Byte=1;
  598.      RowEntry:Byte=0;
  599. Var  MemStream:TMemoryStream;
  600.      T,t1:LongInt;
  601.      Col:LongInt;
  602.      Row:LongInt;
  603. Begin
  604.      Result := Inherited WriteSCUResource(Stream);
  605.      If Not Result Then Exit;
  606.  
  607.      MemStream.Create;
  608.      For T:=0 To FColCount-1 Do
  609.      Begin
  610.           Col:=FColWidths^[T];
  611.           If Col<>FDefaultColWidth Then
  612.           Begin
  613.                MemStream.Write(ColEntry,1);
  614.                MemStream.Write(T,4);
  615.                MemStream.Write(Col,4);
  616.           End;
  617.      End;
  618.      For t1:=0 To FRowCount-1 Do
  619.      Begin
  620.           Row:=FRowHeights^[t1];
  621.           If Row<>FDefaultRowHeight Then
  622.           Begin
  623.                MemStream.Write(RowEntry,1);
  624.                MemStream.Write(t1,4);
  625.                MemStream.Write(Row,4);
  626.           End;
  627.      End;
  628.      If MemStream.Size>0
  629.      Then Result:=Stream.NewResourceEntry(rnGridSizes,
  630.                                           MemStream.Memory^,MemStream.Size);
  631.      MemStream.Destroy;
  632. End;
  633.  
  634. Procedure TGrid.SetColWidth(Col:LongInt;NewWidth:LongInt);
  635. Begin
  636.      If ((Col<0)Or(Col>=FColCount)) Then Exit;
  637.      If NewWidth<=0 Then NewWidth:=FDefaultColWidth;
  638.      If FColWidths^[Col]=NewWidth Then Exit;
  639.      FColWidths^[Col]:=NewWidth;
  640.      //ClearFocus;
  641.      If Not FUpdateLocked Then Invalidate;
  642. End;
  643.  
  644. Function TGrid.GetColWidth(Col:LongInt):LongInt;
  645. Begin
  646.      Result:=0;
  647.      If ((Col<0)Or(Col>=FColCount)) Then Exit;
  648.      Result:=FColWidths^[Col];
  649. End;
  650.  
  651. Procedure TGrid.SetRowHeight(Row:LongInt;NewHeight:LongInt);
  652. Begin
  653.      If ((Row<0)Or(Row>=FRowCount)) Then Exit;
  654.      If NewHeight<=0 Then NewHeight:=FDefaultRowHeight;
  655.      If FRowHeights^[Row]=NewHeight Then Exit;
  656.      FRowHeights^[Row]:=NewHeight;
  657.      //ClearFocus;
  658.      If Not FUpdateLocked Then Invalidate;
  659. End;
  660.  
  661. Function TGrid.GetRowHeight(Row:LongInt):LongInt;
  662. Begin
  663.      Result:=0;
  664.      If ((Row<0)Or(Row>=FRowCount)) Then Exit;
  665.      Result:=FRowHeights^[Row];
  666. End;
  667.  
  668. Procedure TGrid.SetEntryColor(NewColor:TColor);
  669. Begin
  670.      FEntryColor:=NewColor;
  671.      //ClearFocus;
  672.      If Not FUpdateLocked Then Invalidate;
  673. End;
  674.  
  675. Procedure TGrid.SetFixedColor(NewColor:TColor);
  676. Begin
  677.      FFixedColor:=NewColor;
  678.      If Not FUpdateLocked Then Invalidate;
  679. End;
  680.  
  681. Procedure TGrid.SetFixedRows(NewRows:LongInt);
  682. Begin
  683.      If ((NewRows<0)Or(NewRows>=FRowCount)) Then Exit;
  684.      FFixedRows:=NewRows;
  685.      If FSelectRow=-1 Then If FFixedRows<FRowCount Then FSelectRow:=FFixedRows
  686.      Else FSelectRow:=-1;
  687.      //ClearFocus;
  688.      If Not FUpdateLocked Then Invalidate;
  689. End;
  690.  
  691. Procedure TGrid.SetFixedCols(NewCols:LongInt);
  692. Begin
  693.      If ((NewCols<0)Or(NewCols>=FColCount)) Then Exit;
  694.      FFixedCols:=NewCols;
  695.      If FSelectCol=-1 Then If FFixedCols<FColCount Then FSelectCol:=FFixedCols
  696.      Else FSelectCol:=-1;
  697.      //ClearFocus;
  698.      If Not FUpdateLocked Then Invalidate;
  699. End;
  700.  
  701. Procedure TGrid.SetDefaultColWidth(NewWidth:LongInt);
  702. Var T:LongInt;
  703.     P:Pointer;
  704. Begin
  705.      If NewWidth<1 Then Exit;
  706.      P:=FColWidths;
  707.      T:=FColCount;
  708.      Asm
  709.         MOV EDI,P
  710.         MOV ECX,T
  711.         MOV EAX,NewWidth
  712.         REP STOSD
  713.      End;
  714.      //ClearFocus;
  715.      FDefaultColWidth:=NewWidth;
  716.      If Not FUpdateLocked Then Invalidate;
  717. End;
  718.  
  719. Procedure TGrid.SetOptions(NewOptions:TGridOptions);
  720. Begin
  721.      FOptions:=NewOptions;
  722.      If Not FUpdateLocked Then Invalidate;
  723. End;
  724.  
  725. Procedure TGrid.SetDefaultRowHeight(NewHeight:LongInt);
  726. Var T:LongInt;
  727.     P:Pointer;
  728. Begin
  729.      If NewHeight<1 Then Exit;
  730.      P:=FRowHeights;
  731.      T:=FRowCount;
  732.      Asm
  733.         MOV EDI,P
  734.         MOV ECX,T
  735.         MOV EAX,NewHeight
  736.         CLD
  737.         REP STOSD
  738.      End;
  739.      FDefaultRowHeight:=NewHeight;
  740.      //ClearFocus;
  741.      If Not FUpdateLocked Then Invalidate;
  742. End;
  743.  
  744. Procedure TGrid.SetColCount(NewCount:LongInt);
  745. Begin
  746.      If ((NewCount<1)Or(NewCount<FFixedCols)) Then Exit;
  747.      If NewCount=FColCount Then Exit;
  748.      FLeftScrolled:=0;
  749.      FUpScrolled:=0;
  750.      FLeftExtent:=0;
  751.      FUpExtent:=0;
  752.      UpdateGridContents(NewCount,FRowCount);
  753. End;
  754.  
  755. Procedure TGrid.SetRowCount(NewCount:LongInt);
  756. Begin
  757.      If ((NewCount<1)Or(NewCount<FFixedRows)) Then Exit;
  758.      If NewCount=FRowCount Then Exit;
  759.      FLeftScrolled:=0;
  760.      FUpScrolled:=0;
  761.      FLeftExtent:=0;
  762.      FUpExtent:=0;
  763.      UpdateGridContents(FColCount,NewCount);
  764. End;
  765.  
  766. Procedure TGrid.UpdateScrollBars;
  767. Var MaxWidth,MaxHeight:LongInt;
  768.     viewarea:LongInt;
  769. Begin
  770.      GetGridExtent(MaxWidth,MaxHeight);
  771.  
  772.      If ((FVertScrollBar<>Nil)And(FHorzScrollBar<>Nil)) Then
  773.      Begin
  774.           If MaxWidth>Width Then
  775.           Begin
  776.                Inc(MaxHeight,FHorzScrollBar.Height);
  777.                If MaxHeight>Height Then Inc(MaxWidth,FVertScrollBar.Width);
  778.           End
  779.           Else If MaxHeight>Height Then
  780.           Begin
  781.                Inc(MaxWidth,FVertScrollBar.Width);
  782.                If MaxWidth>Width Then Inc(MaxHeight,FHorzScrollBar.Height);
  783.           End;
  784.      End;
  785.  
  786.      If FHorzScrollBar<>Nil Then
  787.      Begin
  788.           If MaxWidth>Width Then
  789.           Begin
  790.               viewarea:=Width;
  791.               If FVertScrollBar<>Nil Then If MaxHeight>Height Then Dec(viewarea,FVertScrollBar.Width);
  792.               FHorzScrollBar.SetScrollRange(0,MaxWidth,viewarea);
  793.               FHorzScrollBar.Position:=FLeftExtent;
  794.               If FVertScrollBar<>Nil Then
  795.               Begin
  796.                    If MaxHeight>Height Then FHorzScrollBar.Width:=Width-FVertScrollBar.Width
  797.                    Else FHorzScrollBar.Width:=Width;
  798.               End
  799.               Else FHorzScrollBar.Width:=Width;
  800.               If FHorzScrollBar.Handle<>0 Then FHorzScrollBar.Show
  801.               Else FHorzScrollBar.Visible:=True;
  802.           End
  803.           Else FHorzScrollBar.Hide;
  804.      End;
  805.  
  806.      If FVertScrollBar<>Nil Then
  807.      Begin
  808.           If MaxHeight>Height Then
  809.           Begin
  810.                viewarea:=Height;
  811.                If FHorzScrollBar<>Nil Then If MaxWidth>Width Then Dec(viewarea,FHorzScrollBar.Height);
  812.                FVertScrollBar.SetScrollRange(0,MaxHeight,viewarea);
  813.                FVertScrollBar.Position:=FUpExtent;
  814.                If FHorzScrollBar<>Nil Then
  815.                Begin
  816.                     If MaxWidth>Width Then FVertScrollBar.Height:=Height-FHorzScrollBar.Height
  817.                     Else FVertScrollBar.Height:=Height;
  818.                End
  819.                Else FVertScrollBar.Height:=Height;
  820.                If FVertScrollBar.Handle<>0 Then FVertScrollBar.Show
  821.                Else FVertScrollBar.Visible:=True;
  822.           End
  823.           Else FVertScrollBar.Hide;
  824.      End;
  825.      //ClearFocus;
  826. End;
  827.  
  828.  
  829.  
  830. Procedure TGrid.Show;
  831. Begin
  832.      Inherited Show;
  833.  
  834.      UpdateScrollBars;
  835. End;
  836.  
  837. Procedure TGrid.Resize;
  838. Begin
  839.      Inherited Resize;
  840.  
  841.      If FHorzScrollBar<>Nil Then
  842.      Begin
  843.           If FVertScrollBar<>Nil
  844.           Then FHorzScrollBar.Width:=Width-FHorzScrollBar.Height
  845.           Else FHorzScrollBar.Width:=Width;
  846.      End;
  847.  
  848.      If FVertScrollBar<>Nil Then
  849.      Begin
  850.           If FHorzScrollBar<>Nil
  851.           Then FVertScrollBar.Height:=Height-FVertScrollBar.Width
  852.           Else FVertScrollBar.Height:=Height;
  853.      End;
  854.  
  855.      FLeftScrolled:=0;
  856.      FUpScrolled:=0;
  857.      FLeftExtent:=0;
  858.      FUpExtent:=0;
  859.  
  860.      UpdateScrollBars;
  861. End;
  862.  
  863.  
  864. Procedure TGrid.CreateHScrollBar;
  865. Begin
  866.      If FHorzScrollBar<>Nil Then Exit;
  867.  
  868.      FHorzScrollBar.Create(Nil);
  869.      FHorzScrollBar.Hide;
  870.      InsertControl(FHorzScrollBar);
  871.      FHorzScrollBar.Kind:=sbHorizontal;
  872.      FHorzScrollBar.SetWindowPos(0,0,Width-FHorzScrollBar.Height,FHorzScrollBar.Height);
  873.      FHorzScrollBar.XAlign:=xaLeft;
  874.      FHorzScrollBar.YAlign:=yaBottom;
  875.      Include(FHorzScrollBar.ComponentState, csDetail);
  876.      FHorzScrollBar.HandlesDesignMouse:=True;
  877.      FHorzScrollBar.SetDesigning(False); {!}
  878. End;
  879.  
  880.  
  881. Procedure TGrid.CreateVScrollBar;
  882. Begin
  883.      If FVertScrollBar<>Nil Then Exit;
  884.  
  885.      FVertScrollBar.Create(Nil);
  886.      FVertScrollBar.Hide;
  887.      InsertControl(FVertScrollBar);
  888.      FVertScrollBar.Kind:=sbVertical;
  889.      FVertScrollBar.SetWindowPos(Width-FVertScrollBar.Width,FVertScrollBar.Width,
  890.                                  FVertScrollBar.Width,Height-FVertScrollBar.Width);
  891.      FVertScrollBar.XAlign:=xaRight;
  892.      FVertScrollBar.YAlign:=yaTop;
  893.      Include(FVertScrollBar.ComponentState, csDetail);
  894.      FVertScrollBar.HandlesDesignMouse:=True;
  895.      FVertScrollBar.SetDesigning(False); {!}
  896. End;
  897.  
  898.  
  899. Procedure TGrid.SetScrollBars(NewValue:TScrollStyle);
  900. Begin
  901.      FScrollBars:=NewValue;
  902.      Case NewValue Of
  903.         ssBoth:
  904.         Begin
  905.              CreateHScrollBar;
  906.              CreateVScrollBar;
  907.         End;
  908.         ssHorizontal:
  909.         Begin
  910.              CreateHScrollBar;
  911.              If FVertScrollBar<>Nil Then FVertScrollBar.Destroy;
  912.              FVertScrollBar:=Nil;
  913.              FHorzScrollBar.Width:=FHorzScrollBar.Width+FHorzScrollBar.Height;
  914.              If FLeftScrolled>0 Then
  915.              Begin
  916.                   FLeftScrolled:=0;
  917.                   FLeftExtent:=0;
  918.                   Invalidate;
  919.              End;
  920.         End;
  921.         ssVertical:
  922.         Begin
  923.              CreateVScrollBar;
  924.              If FHorzScrollBar<>Nil Then FHorzScrollBar.Destroy;
  925.              FHorzScrollBar:=Nil;
  926.              FVertScrollBar.Height:=FVertScrollBar.Height+FVertScrollBar.Width;
  927.              If FUpScrolled>0 Then
  928.              Begin
  929.                   FUpScrolled:=0;
  930.                   FUpExtent:=0;
  931.                   Invalidate;
  932.              End;
  933.         End;
  934.         ssNone:
  935.         Begin
  936.              If FVertScrollBar<>Nil Then FVertScrollBar.Destroy;
  937.              FVertScrollBar:=Nil;
  938.              If FHorzScrollBar<>Nil Then FHorzScrollBar.Destroy;
  939.              FHorzScrollBar:=Nil;
  940.              If ((FLeftScrolled>0)Or(FUpScrolled>0)) Then
  941.              Begin
  942.                   FLeftScrolled:=0;
  943.                   FUpScrolled:=0;
  944.                   FLeftExtent:=0;
  945.                   FUpExtent:=0;
  946.                   Invalidate;
  947.              End;
  948.         End;
  949.      End; {Case}
  950.      UpdateScrollBars;
  951. End;
  952.  
  953. {$HINTS OFF}
  954. Procedure TGrid.SetupCellColors(Col,Row:LongInt;AState:TGridDrawState;Var background,ForeGround:TColor);
  955. Begin
  956.      ForeGround:=PenColor;
  957.  
  958.      If AState*[gdFixed]<>[] Then
  959.      Begin
  960.           background:=FFixedColor;
  961.      End
  962.      Else
  963.      Begin
  964.           background:=FEntryColor;
  965.  
  966.           If AState*[gdSelected]<>[] Then If Options*[goShowSelection,goEditing]<>[] Then
  967.           Begin
  968.                If AState*[gdFocused]=[] Then
  969.                Begin
  970.                     If Options*[goAlwaysShowSelection]<>[] Then
  971.                     Begin
  972.                          background:=clHighlight;
  973.                          ForeGround:=clHighlightText;
  974.                     End;
  975.                End
  976.                Else
  977.                Begin
  978.                     If Options*[goAlwaysShowEditor]=[] Then
  979.                     Begin
  980.                          background:=clHighlight;
  981.                          ForeGround:=clHighlightText;
  982.                     End;
  983.                End;
  984.           End;
  985.      End;
  986. End;
  987. {$HINTS ON}
  988.  
  989. Procedure TGrid.SetCellColors(Col,Row:LongInt;AState:TGridDrawState);
  990. Var back,Fore:TColor;
  991. Begin
  992.      SetupCellColors(Col,Row,AState,back,Fore);
  993.      Canvas.Brush.color:=back;
  994.      Canvas.Pen.color:=Fore;
  995. End;
  996.  
  997. {$HINTS OFF}
  998. Procedure TGrid.DrawCell(Col,Row:LongInt;rec:TRect;AState:TGridDrawState);
  999. Var rc:TRect;
  1000. Begin
  1001.      If Canvas=Nil Then Exit;
  1002.  
  1003.      SetCellColors(Col,Row,AState);
  1004.  
  1005.      If AState*[gdFixed]<>[] Then
  1006.      Begin
  1007.           Dec(rec.Top);
  1008.           If Col>0 Then Inc(rec.Left);
  1009.           {??????+-1}
  1010.           Dec(rec.Right);
  1011.           Dec(rec.Top);
  1012.           Canvas.FillRect(rec,Canvas.Brush.color);
  1013.           rc:=Canvas.ClipRect;
  1014.           Dec(rc.Bottom);
  1015.           If Col=0 Then Dec(rc.Left);
  1016.           Canvas.ClipRect:=rc;
  1017.  
  1018.           Dec(rec.Bottom);
  1019.           Dec(rec.Left);
  1020.           Canvas.ShadowedBorder(rec,clWhite,clDkGray);
  1021.  
  1022.           Inc(rc.Bottom);
  1023.           Inc(rc.Left);
  1024.           Canvas.ClipRect:=rc;
  1025.      End
  1026.      Else
  1027.      Begin
  1028.           {??????+-1}
  1029.           Dec(rec.Right);
  1030.           Dec(rec.Top);
  1031.           Canvas.FillRect(rec,Canvas.Brush.color);
  1032.           If AState*[gdFocused]<>[] Then
  1033.           Begin
  1034.                //InflateRect(rec,-1,-1);
  1035.                Dec(rec.Right);
  1036.                Dec(rec.Top);
  1037.                Canvas.DrawFocusRect(rec);
  1038.           End;
  1039.      End;
  1040. End;
  1041. {$HINTS ON}
  1042.  
  1043. Procedure TGrid.Redraw(Const rec:TRect);
  1044. Var T,t1:LongInt;
  1045.     X,Y:LongInt;
  1046.     RowHeight:LongInt;
  1047.     ColWidth:LongInt;
  1048.     rc1,rc2,rec1,rcSave:TRect;
  1049.     MaxWidth,MaxHeight:LongInt;
  1050.     LeftCount,UpCount:LongInt;
  1051.     DrawIt:Boolean;
  1052.     AState:TGridDrawState;
  1053. Label Ende;
  1054. Begin
  1055.      If Canvas=Nil Then Exit;
  1056.      If FGridUpdateLocked Then Exit;
  1057.      Dec(rec.Left);
  1058.      Inc(rec.Top);
  1059.      rec1:=rec;
  1060.      If Options*[goBorder]<>[] Then If rec1.Right>Width-1 Then rec1.Right:=Width-1;
  1061.      If ((FHorzScrollBar<>Nil)And(FHorzScrollBar.Visible)) Then
  1062.        If rec1.Bottom<FHorzScrollBar.Height Then rec1.Bottom:=FHorzScrollBar.Height;
  1063.      If ((FVertScrollBar<>Nil)And(FVertScrollBar.Visible)) Then
  1064.        If rec1.Right>Width-FVertScrollBar.Width Then rec1.Right:=Width-FVertScrollBar.Width;
  1065.      Canvas.SetClipRegion([rec1]);
  1066.  
  1067.      {Draw contents}
  1068.      If Options*[goBorder]<>[] Then X:=1
  1069.      Else X:=0;
  1070.      MaxWidth:=0;
  1071.      MaxHeight:=0;
  1072.      LeftCount:=1;
  1073.      For T:=0 To FColCount-1 Do
  1074.      Begin
  1075.           If Options*[goBorder]<>[] Then Y:=Height-1
  1076.           Else Y:=Height;
  1077.           ColWidth:=FColWidths^[T];
  1078.           UpCount:=1;
  1079.           For t1:=0 To FRowCount-1 Do
  1080.           Begin
  1081.                If Y>0 Then
  1082.                Begin
  1083.                     If ((T+1<=FFixedCols)And(t1+1<=FFixedRows)) Then DrawIt:=True {Ecke(N) links oben}
  1084.                     Else
  1085.                     Begin
  1086.                          If ((T+1<=FFixedCols)And(UpCount>FUpScrolled)) Then DrawIt:=True
  1087.                          Else If ((t1+1<=FFixedRows)And(LeftCount>FLeftScrolled)) Then DrawIt:=True
  1088.                          Else If ((UpCount>FUpScrolled)And(LeftCount>FLeftScrolled)) Then DrawIt:=True
  1089.                          Else DrawIt:=False;
  1090.                     End;
  1091.  
  1092.                     If DrawIt Then
  1093.                     Begin
  1094.                          RowHeight:=FRowHeights^[t1];
  1095.                          rc1.Left:=X;
  1096.                          rc1.Right:=X+ColWidth;
  1097.                          If Options*[goBorder]<>[] Then If rc1.Right>=Width Then rc1.Right:=Width-1;
  1098.                          rc1.Top:=Y;
  1099.                          If t1=0 Then Inc(rc1.Top);
  1100.                          rc1.Bottom:=(Y-RowHeight);
  1101.  
  1102.                          rc2:=IntersectRect(rc1,rec1);
  1103.                          If Not IsRectEmpty(rc2) Then
  1104.                          Begin
  1105.                               If rc2.Bottom>0 Then Dec(rc2.Bottom);
  1106.                               If Options*[goBorder]<>[] Then If rc2.Bottom<=0 Then rc2.Bottom:=1;
  1107.                               Dec(rc2.Right);
  1108.                               Dec(rc2.Top);
  1109.                               If Options*[goBorder]<>[] Then If rc2.Right>=Width-1 Then rc2.Right:=Width-2;
  1110.                               rcSave:=Canvas.ClipRect;
  1111.                               Canvas.ClipRect:=rc2;
  1112.                               If Options*[goBorder]<>[] Then
  1113.                               Begin
  1114.                                    If t1=0 Then Inc(rc1.Left)
  1115.                                    Else If ((rc1.Left>0)And(((FixedCols>0)Or(T>0)))) Then Inc(rc1.Left);
  1116.                               End
  1117.                               Else
  1118.                               Begin
  1119.                                    If ((FixedCols>0)Or(T>0)) Then Inc(rc1.Left);
  1120.                               End;
  1121.                               Inc(rc1.Bottom);
  1122.                               If Options*[goBorder]<>[] Then If rc1.Bottom<=0 Then rc1.Bottom:=1;
  1123.                               Canvas.Brush.color:=FEntryColor;
  1124.                               Canvas.Pen.color:=PenColor;
  1125.                               AState:=[];
  1126.                               If ((T+1<=FFixedCols)Or(t1+1<=FFixedRows)) Then Include(AState,gdFixed);
  1127.                               If ((T=FSelectCol)And(t1=FSelectRow)) Then
  1128.                               Begin
  1129.                                    Include(AState,gdSelected);
  1130.                                    If HasFocus Then Include(AState,gdFocused);
  1131.                               End;
  1132.                               DrawCell(T,t1,rc1,AState);
  1133.                               Canvas.ClipRect:=rcSave;
  1134.                          End;
  1135.                          Dec(Y,RowHeight);
  1136.                     End;
  1137.                End;
  1138.                If t1+1>FFixedRows Then Inc(UpCount); {Next Row}
  1139.           End;
  1140.           If ((T+1<=FFixedCols)Or(LeftCount>FLeftScrolled)) Then Inc(X,ColWidth);
  1141.           If X>Width Then Goto Ende;  {invisible}
  1142.           If T+1>FFixedCols Then Inc(LeftCount);  {Next Column}
  1143.      End;
  1144.  
  1145. Ende:
  1146.      MaxWidth:=X;
  1147.      MaxHeight:=Y;
  1148.  
  1149.      Canvas.DeleteClipRegion;
  1150.  
  1151.      {Draw Grid}
  1152.      If Options*[goBorder]<>[] Then
  1153.      Begin
  1154.           Y:=Height-1;
  1155.           X:=1;
  1156.      End
  1157.      Else
  1158.      Begin
  1159.           Y:=Height;
  1160.           X:=0;
  1161.      End;
  1162.  
  1163.      For T:=0 To FFixedRows-1 Do Dec(Y,FRowHeights^[T]);
  1164.      Canvas.Pen.color:=clDkGray;
  1165.      LeftCount:=1;
  1166.      For T:=0 To FColCount-1 Do
  1167.      Begin
  1168.           ColWidth:=FColWidths^[T];
  1169.           If ((T+1<=FFixedCols)Or(LeftCount>FLeftScrolled)) Then
  1170.           Begin
  1171.                Canvas.Line(X+ColWidth,Height,X+ColWidth,MaxHeight);
  1172.  
  1173.                Canvas.Pen.color:=clWhite;
  1174.                Canvas.Line(X+ColWidth+1,Y,X+ColWidth+1,Height);
  1175.                Canvas.Pen.color:=clDkGray;
  1176.  
  1177.                Inc(X,ColWidth);
  1178.           End;
  1179.           If T+1>FFixedCols Then Inc(LeftCount); {Next Row}
  1180.           If X>MaxWidth Then break;
  1181.      End;
  1182.  
  1183.      UpCount:=1;
  1184.      Canvas.Pen.color:=clDkGray;
  1185.      If Options*[goBorder]<>[] Then
  1186.      Begin
  1187.           Y:=Height-1;
  1188.           X:=1;
  1189.      End
  1190.      Else
  1191.      Begin
  1192.           Y:=Height;
  1193.           X:=0;
  1194.      End;
  1195.  
  1196.      For T:=0 To FFixedCols-1 Do Inc(X,FColWidths^[T]);
  1197.      For T:=0 To FRowCount-1 Do
  1198.      Begin
  1199.           RowHeight:=FRowHeights^[T];
  1200.           If ((T+1<=FFixedRows)Or(UpCount>FUpScrolled)) Then
  1201.           Begin
  1202.                Canvas.Line(X,Y-RowHeight,MaxWidth,Y-RowHeight);
  1203.  
  1204.                Canvas.Pen.color:=clWhite;
  1205.                Canvas.Line(0,Y-RowHeight-1,X,Y-RowHeight-1);
  1206.                Canvas.Pen.color:=clDkGray;
  1207.  
  1208.                Dec(Y,RowHeight);
  1209.           End;
  1210.           If T+1>FFixedRows Then Inc(UpCount);
  1211.           If Y<0 Then break;
  1212.      End;
  1213.  
  1214.      If MaxHeight>0 Then
  1215.      Begin
  1216.           rc1.Left:=0;
  1217.           If Options*[goBorder]<>[] Then Inc(rc1.Left);
  1218.           rc1.Right:=Width-1;
  1219.           If Options*[goBorder]<>[] Then Dec(rc1.Right);
  1220.           rc1.Bottom:=0;
  1221.           If Options*[goBorder]<>[] Then Inc(rc1.Bottom);
  1222.           rc1.Top:=MaxHeight-1;
  1223.           Canvas.FillRect(rc1,color);
  1224.      End;
  1225.  
  1226.      If MaxWidth<Width Then
  1227.      Begin
  1228.           rc1.Left:=MaxWidth+1;
  1229.           rc1.Right:=Width-1;
  1230.           If Options*[goBorder]<>[] Then Dec(rc1.Right);
  1231.           rc1.Bottom:=MaxHeight;
  1232.           rc1.Top:=Height-1;
  1233.           If Options*[goBorder]<>[] Then Dec(rc1.Top);
  1234.           Canvas.FillRect(rc1,color);
  1235.      End;
  1236.  
  1237.      Canvas.DeleteClipRegion;
  1238.  
  1239.      If Options*[goBorder]<>[] Then
  1240.      Begin
  1241.           rc1.Left:=0;
  1242.           rc1.Right:=Width-1;
  1243.           rc1.Bottom:=0;
  1244.           rc1.Top:=Height-1;
  1245.           Canvas.Pen.color:=clBlack;
  1246.           Canvas.Rectangle(rc1);
  1247.      End;
  1248.  
  1249.      If ((FVertScrollBar<>Nil)And(FHorzScrollBar<>Nil)And(FVertScrollBar.Visible)And
  1250.          (FHorzScrollBar.Visible)) Then
  1251.      Begin
  1252.           rc1.Left:=FHorzScrollBar.Width;
  1253.           rc1.Right:=Width-1;
  1254.           rc1.Bottom:=0;
  1255.           rc1.Top:=FHorzScrollBar.Height-1;
  1256.           Canvas.FillRect(rc1,color);
  1257.      End;
  1258. End;
  1259.  
  1260. Procedure TGrid.UpdateGridContents(NewCols,NewRows:LongInt);
  1261. Var T:LongInt;
  1262.     P:Pointer;
  1263.     Def:LongInt;
  1264. Begin
  1265.      If FColWidths=Nil Then
  1266.      Begin
  1267.           {no List was previously Active}
  1268.           GetMem(FColWidths,NewCols*4);
  1269.           P:=FColWidths;
  1270.           Def:=FDefaultColWidth;
  1271.           Asm
  1272.              MOV EDI,p
  1273.              MOV ECX,NewCols
  1274.              MOV EAX,Def
  1275.              CLD
  1276.              REP
  1277.              STOSD
  1278.           End;
  1279.           GetMem(FRowHeights,NewRows*4);
  1280.           P:=FRowHeights;
  1281.           Def:=FDefaultRowHeight;
  1282.           Asm
  1283.              MOV EDI,p
  1284.              MOV ECX,NewRows
  1285.              MOV EAX,Def
  1286.              CLD
  1287.              REP
  1288.              STOSD
  1289.           End;
  1290.           FColCount:=NewCols;
  1291.           FRowCount:=NewRows;
  1292.      End
  1293.      Else
  1294.      Begin
  1295.           If NewCols<FColCount Then
  1296.           Begin
  1297.               {Delete Columns}
  1298.               GetMem(P,NewCols*4);
  1299.               System.Move(FColWidths^,P^,NewCols*4);
  1300.               FreeMem(FColWidths,FColCount*4);
  1301.               FColWidths:=P;
  1302.           End
  1303.           Else If NewCols>FColCount Then
  1304.           Begin
  1305.                {Add Columns}
  1306.                GetMem(P,NewCols*4);
  1307.                System.Move(FColWidths^,P^,FColCount*4);
  1308.                FreeMem(FColWidths,FColCount*4);
  1309.                FColWidths:=P;
  1310.                Inc(P,FColCount*4);
  1311.                T:=NewCols-FColCount;
  1312.                Def:=FDefaultColWidth;
  1313.                Asm
  1314.                   MOV EDI,p
  1315.                   MOV ECX,t
  1316.                   MOV EAX,Def
  1317.                   CLD
  1318.                   REP
  1319.                   STOSD
  1320.                End;
  1321.           End;
  1322.           FColCount:=NewCols;
  1323.  
  1324.           If NewRows<FRowCount Then
  1325.           Begin
  1326.                {Delete Rows}
  1327.                GetMem(P,NewRows*4);
  1328.                System.Move(FRowHeights^,P^,NewRows*4);
  1329.                FreeMem(FRowHeights,FRowCount*4);
  1330.                FRowHeights:=P;
  1331.           End
  1332.           Else If NewRows>FRowCount Then
  1333.           Begin
  1334.                {Add Rows}
  1335.                GetMem(P,NewRows*4);
  1336.                System.Move(FRowHeights^,P^,FRowCount*4);
  1337.                FreeMem(FRowHeights,FRowCount*4);
  1338.                FRowHeights:=P;
  1339.                Inc(P,FRowCount*4);
  1340.                T:=NewRows-FRowCount;
  1341.                Def:=FDefaultRowHeight;
  1342.                Asm
  1343.                   MOV EDI,p
  1344.                   MOV ECX,t
  1345.                   MOV EAX,Def
  1346.                   CLD
  1347.                   REP
  1348.                   STOSD
  1349.                End;
  1350.           End;
  1351.           FRowCount:=NewRows;
  1352.      End;
  1353.  
  1354.      If Not FUpdateLocked Then Invalidate;
  1355.      UpdateScrollBars;
  1356. End;
  1357.  
  1358. Destructor TGrid.Destroy;
  1359. Begin
  1360.      ScrollBars:=ssNone;    {Destroy the ScrollBars}
  1361.  
  1362.      If FColCount>0 Then FreeMem(FColWidths,FColCount*4);
  1363.      FColWidths:=Nil;
  1364.      If FRowCount>0 Then FreeMem(FRowHeights,FRowCount*4);
  1365.      FRowHeights:=Nil;
  1366.  
  1367.      Inherited Destroy;
  1368. End;
  1369.  
  1370. Procedure TGrid.SetupComponent;
  1371. Begin
  1372.      Inherited SetupComponent;
  1373.  
  1374.      Name:='Grid';
  1375.      Width:=200;
  1376.      Height:=200;
  1377.      ParentPenColor:=True;
  1378.      ParentColor:=True;
  1379.      HandlesDesignMouse:=True;
  1380.      FSelectCol:=-1;
  1381.      FSelectRow:=-1;
  1382.  
  1383.      FFixedColor:=clLtGray;
  1384.      FEntryColor:=clWhite;
  1385.      FFixedRows:=1;
  1386.      FFixedCols:=1;
  1387.      FDefaultRowHeight:=24; //40;
  1388.      FDefaultColWidth:=64; //50;
  1389.      FRowCount:=4;
  1390.      FColCount:=5;
  1391.      UpdateGridContents(FColCount,FRowCount);
  1392.      ScrollBars:=ssBoth;
  1393.      FSizeShape:=crDefault;
  1394.      FOptions:=[goBorder,goShowSelection,goMouseSelect];
  1395.      If not Designed Then Include(ComponentState,csAcceptsControls);
  1396. End;
  1397.  
  1398. Procedure TGrid.SetScrollBar(ScrollBar:TScrollBar;NewValue:LongInt);
  1399. Begin
  1400.      ScrollBar.Position:=NewValue;
  1401.      //ClearFocus;
  1402.      If Not FUpdateLocked Then Invalidate;
  1403. End;
  1404.  
  1405. Procedure TGrid.SetTopRow(NewValue:LongInt);
  1406. Begin
  1407.      FVertScrollBar.Position:=NewValue;
  1408. End;
  1409.  
  1410. Procedure TGrid.SetLeftCol(NewValue:LongInt);
  1411. Begin
  1412.      FHorzScrollBar.Position:=NewValue;
  1413. End;
  1414.  
  1415. Procedure TGrid.Scroll(ScrollBar:TScrollBar;ScrollCode:TScrollCode;Var ScrollPos:LongInt);
  1416. Begin
  1417.      Case ScrollCode Of
  1418.          scLineUp:       ScrollPos:=ScrollVertTrack(ScrollBar,FUpExtent-FRowHeights^[FFixedRows+FUpScrolled]);
  1419.          scLineDown:     ScrollPos:=ScrollVertTrack(ScrollBar,FUpExtent+FRowHeights^[FFixedRows+FUpScrolled]);
  1420.          scPageUp:       ScrollPos:=ScrollVertTrack(ScrollBar,FUpExtent-Height);
  1421.          scPageDown:     ScrollPos:=ScrollVertTrack(ScrollBar,FUpExtent+Height);
  1422.          scVertTrack:    ScrollPos:=ScrollVertTrack(ScrollBar,ScrollPos);
  1423.          scVertPosition: ScrollPos:=ScrollVertTrack(ScrollBar,ScrollPos);
  1424.          scColumnLeft:   ScrollPos:=ScrollHorzTrack(ScrollBar,FLeftExtent-FColWidths^[FFixedCols+FLeftScrolled-1]);
  1425.          scColumnRight:  ScrollPos:=ScrollHorzTrack(ScrollBar,FLeftExtent+FColWidths^[FFixedCols+FLeftScrolled]);
  1426.          scPageLeft:     ScrollPos:=ScrollHorzTrack(ScrollBar,FLeftExtent-Width);
  1427.          scPageRight:    ScrollPos:=ScrollHorzTrack(ScrollBar,FLeftExtent+Width);
  1428.          scHorzTrack:    ScrollPos:=ScrollHorzTrack(ScrollBar,ScrollPos);
  1429.          scHorzPosition: ScrollPos:=ScrollHorzTrack(ScrollBar,ScrollPos);
  1430.      End;
  1431.      ScrollBar.Update;
  1432.      Invalidate;
  1433. End;
  1434.  
  1435. Procedure TGrid.GetGridExtent(Var CX,CY:LongInt);
  1436. Var T:LongInt;
  1437. Begin
  1438.      CX:=0;
  1439.      CY:=0;
  1440.      For T:=0 To FColCount-1 Do Inc(CX,FColWidths^[T]);
  1441.      For T:=0 To FRowCount-1 Do Inc(CY,FRowHeights^[T]);
  1442. End;
  1443.  
  1444. Function TGrid.GetVisibleRowCount:LongInt;
  1445. Var T,H,MinHeight:LongInt;
  1446. Begin
  1447.      Result:=0;
  1448.      H:=Height;
  1449.  
  1450.      MinHeight:=0;
  1451.      If FHorzScrollBar<>Nil Then
  1452.        If FHorzScrollBar.Visible Then Inc(MinHeight,FHorzScrollBar.Height);
  1453.  
  1454.      For T:=0 To FFixedRows-1 Do
  1455.      Begin
  1456.           Dec(H,FRowHeights^[T]);
  1457.           Inc(Result);
  1458.           If H<=MinHeight Then Exit;
  1459.      End;
  1460.  
  1461.      For T:=FUpScrolled+FFixedRows To FRowCount-1 Do
  1462.      Begin
  1463.           Dec(H,FRowHeights^[T]);
  1464.           Inc(Result);
  1465.           If H<=MinHeight Then Exit;
  1466.      End;
  1467. End;
  1468.  
  1469. Function TGrid.GetVisibleColCount:LongInt;
  1470. Var T,W,MaxWidth:LongInt;
  1471. Begin
  1472.      Result:=0;
  1473.      W:=0;
  1474.  
  1475.      MaxWidth:=Width;
  1476.      If FVertScrollBar<>Nil Then
  1477.        If FVertScrollBar.Visible Then Dec(MaxWidth,FVertScrollBar.Width);
  1478.  
  1479.      For T:=0 To FFixedCols-1 Do
  1480.      Begin
  1481.           Inc(W,FColWidths^[T]);
  1482.           Inc(Result);
  1483.           If W>=MaxWidth Then Exit;
  1484.      End;
  1485.  
  1486.      For T:=FLeftScrolled+FFixedCols To FColCount-1 Do
  1487.      Begin
  1488.           Inc(W,FColWidths^[T]);
  1489.           Inc(Result);
  1490.           If W>=MaxWidth Then Exit;
  1491.      End;
  1492. End;
  1493.  
  1494. Function TGrid.GetGridWidth:LongInt;
  1495. Var T:LongInt;
  1496. Begin
  1497.      Result:=0;
  1498.      For T:=0 To FColCount-1 Do Inc(Result,FColWidths^[T]);
  1499. End;
  1500.  
  1501. Function TGrid.GetGridHeight:LongInt;
  1502. Var T:LongInt;
  1503. Begin
  1504.      Result:=0;
  1505.      For T:=0 To FRowCount-1 Do Inc(Result,FRowHeights^[T]);
  1506. End;
  1507.  
  1508. {$HINTS OFF}
  1509. Function TGrid.ScrollHorzTrack(ScrollBar:TScrollBar;NewPosition:LongInt):LongInt;
  1510. Var MaxWidth,MaxHeight,Value:LongInt;
  1511.     T:LongInt;
  1512. Begin
  1513.      If NewPosition<0 Then NewPosition:=0;
  1514.      GetGridExtent(MaxWidth,MaxHeight);
  1515.      If NewPosition>MaxWidth Then NewPosition:=MaxWidth;
  1516.      Value:=Width;
  1517.      If FVertScrollBar<>Nil Then If FVertScrollBar.Visible Then Dec(Value,FVertScrollBar.Width);
  1518.  
  1519.      FLeftScrolled:=0;
  1520.      FLeftExtent:=0;
  1521.      For T:=FFixedCols To FColCount-1 Do
  1522.      Begin
  1523.           If FLeftExtent>=NewPosition Then break;
  1524.           If FLeftExtent+Value>=MaxWidth Then break;  {rest fits In Window}
  1525.           Inc(FLeftExtent,FColWidths^[T]);
  1526.           Inc(FLeftScrolled);
  1527.      End;
  1528.  
  1529.      Result:=FLeftExtent;
  1530. End;
  1531.  
  1532. Function TGrid.ScrollVertTrack(ScrollBar:TScrollBar;NewPosition:LongInt):LongInt;
  1533. Var MaxWidth,MaxHeight,Value:LongInt;
  1534.     T:LongInt;
  1535. Begin
  1536.      If NewPosition<0 Then NewPosition:=0;
  1537.      GetGridExtent(MaxWidth,MaxHeight);
  1538.      If NewPosition>MaxHeight Then NewPosition:=MaxHeight;
  1539.      Value:=Height;
  1540.      If FHorzScrollBar<>Nil Then If FHorzScrollBar.Visible Then Dec(Value,FHorzScrollBar.Height);
  1541.  
  1542.      FUpScrolled:=0;
  1543.      FUpExtent:=0;
  1544.      For T:=FFixedRows To FRowCount-1 Do
  1545.      Begin
  1546.           If FUpExtent>=NewPosition Then break;
  1547.           If FUpExtent+Value>=MaxHeight Then break;  {rest fits In Window}
  1548.           Inc(FUpExtent,FRowHeights^[T]);
  1549.           Inc(FUpScrolled);
  1550.      End;
  1551.  
  1552.      Result:=FUpExtent;
  1553. End;
  1554. {$HINTS ON}
  1555.  
  1556. Function TGrid.CellRect(Col,Row:LongInt):TRect;
  1557. Var X,Y:LongInt;
  1558.     LeftCount,UpCount:LongInt;
  1559.     T,t1:LongInt;
  1560.     TheRowHeight:LongInt;
  1561.     TheColWidth:LongInt;
  1562.     DrawIt:Boolean;
  1563. Begin
  1564.      FillChar(Result,SizeOf(TRect),0);
  1565.      If ((Row<0)Or(Row>FRowCount-1)Or(Col<0)Or(Col>FColCount-1)) Then Exit;
  1566.  
  1567.      If Options*[goBorder]<>[] Then X:=1
  1568.      Else X:=0;
  1569.      LeftCount:=1;
  1570.      For T:=0 To FColCount-1 Do
  1571.      Begin
  1572.           If Options*[goBorder]<>[] Then Y:=Height-1
  1573.           Else Y:=Height;
  1574.           TheColWidth:=FColWidths^[T];
  1575.           UpCount:=1;
  1576.           For t1:=0 To FRowCount-1 Do
  1577.           Begin
  1578.                If Y>0 Then
  1579.                Begin
  1580.                     If ((T+1<=FFixedCols)And(t1+1<=FFixedRows)) Then DrawIt:=True {Ecke(N) links oben}
  1581.                     Else
  1582.                     Begin
  1583.                          If ((T+1<=FFixedCols)And(UpCount>FUpScrolled)) Then DrawIt:=True
  1584.                          Else If ((t1+1<=FFixedRows)And(LeftCount>FLeftScrolled)) Then DrawIt:=True
  1585.                          Else If ((UpCount>FUpScrolled)And(LeftCount>FLeftScrolled)) Then DrawIt:=True
  1586.                          Else DrawIt:=False;
  1587.                     End;
  1588.  
  1589.                     If DrawIt Then
  1590.                     Begin
  1591.                          TheRowHeight:=FRowHeights^[t1];
  1592.                          If T=Col Then If t1=Row Then
  1593.                          Begin
  1594.                               Result.Left:=X+1;
  1595.                               Result.Right:=X+TheColWidth;
  1596.                               Result.Top:=Y;
  1597.                               Result.Bottom:=(Y-TheRowHeight)+1;
  1598.                               Exit;
  1599.                          End;
  1600.                          Dec(Y,TheRowHeight);
  1601.                     End;
  1602.                End;
  1603.                If t1+1>FFixedRows Then Inc(UpCount); {Next Column}
  1604.           End;
  1605.           If ((T+1<=FFixedCols)Or(LeftCount>FLeftScrolled)) Then Inc(X,TheColWidth);
  1606.           If T+1>FFixedCols Then Inc(LeftCount);  {Next Row}
  1607.      End;
  1608. End;
  1609.  
  1610.  
  1611. Function TGrid.GetSizeItem(Const pt:TPoint;Var Col,Row:LongInt):TCursor;
  1612. Var T,t1:LongInt;
  1613.     LeftCount,UpCount:LongInt;
  1614.     DrawIt:Boolean;
  1615.     ColWidth,RowHeight:LongInt;
  1616.     X,Y:LongInt;
  1617. Begin
  1618.      Result:=crDefault;
  1619.      If Options*[goBorder]<>[] Then X:=1
  1620.      Else X:=0;
  1621.      Col:=-1;
  1622.      Row:=-1;
  1623.  
  1624.      LeftCount:=1;
  1625.      For T:=0 To FColCount-1 Do
  1626.      Begin
  1627.           Col:=T;
  1628.           ColWidth:=FColWidths^[T];
  1629.           If Options*[goBorder]<>[] Then Y:=Height-1
  1630.           Else Y:=Height;
  1631.           UpCount:=1;
  1632.           If ((T+1<=FFixedCols)Or(LeftCount>FLeftScrolled)) Then Inc(X,ColWidth);
  1633.           If T+1>FFixedCols Then Inc(LeftCount);  {Next Row}
  1634.           For t1:=0 To FRowCount-1 Do
  1635.           Begin
  1636.                If Y>0 Then
  1637.                Begin
  1638.                     If ((T+1<=FFixedCols)And(t1+1<=FFixedRows)) Then DrawIt:=True {Ecke(N) links oben}
  1639.                     Else
  1640.                     Begin
  1641.                          If ((T+1<=FFixedCols)And(UpCount>FUpScrolled)) Then DrawIt:=True
  1642.                          Else If ((t1+1<=FFixedRows)And(LeftCount>FLeftScrolled)) Then DrawIt:=True
  1643.                          Else If ((UpCount>FUpScrolled)And(LeftCount>FLeftScrolled)) Then DrawIt:=True
  1644.                          Else DrawIt:=False;
  1645.                     End;
  1646.  
  1647.                     If DrawIt Then
  1648.                     Begin
  1649.                          Row:=t1;
  1650.                          RowHeight:=FRowHeights^[t1];
  1651.                          Dec(Y,RowHeight);
  1652.  
  1653.                          If ((Options*[goRowSizing]<>[])Or(Designed)) Then
  1654.                          Begin
  1655.                               If ((pt.Y>=Y-1)And(pt.Y<=Y+1)And(pt.X<X)And(pt.X>X-ColWidth)And
  1656.                                   (T+1<=FFixedCols)) Then
  1657.                               Begin
  1658.                                    Result:=crVSplit;
  1659.                                    Exit;
  1660.                               End;
  1661.                          End;
  1662.  
  1663.                          If ((Options*[goColSizing]<>[])Or(Designed)) Then
  1664.                          Begin
  1665.                               If ((pt.X>=X-1)And(pt.X<=X+1)And(pt.Y>Y)And(pt.Y<Y+RowHeight)And
  1666.                                   (t1+1<=FFixedRows)) Then
  1667.                               Begin
  1668.                                    Result:=crHSplit;
  1669.                                    Inc(Y,RowHeight);
  1670.                                    Exit;
  1671.                               End;
  1672.                          End;
  1673.  
  1674.                          If ((pt.Y>=Y+1)And(pt.Y<=Y+(RowHeight-1))And(pt.X>=X-(ColWidth-1))And(pt.X<=X-1)) Then
  1675.                            If ((T+1>FFixedCols)And(t1+1>FFixedRows)) Then {FIXED entries cannot be Selected}
  1676.                          Begin
  1677.                               {entry Focused}
  1678.                               Exit;
  1679.                          End;
  1680.                     End; {If DrawIt}
  1681.                     If t1+1>FFixedRows Then Inc(UpCount); {Next Column}
  1682.                End;
  1683.           End;
  1684.      End;
  1685.  
  1686.      Col:=-1;
  1687.      Row:=-1;
  1688. End;
  1689.  
  1690.  
  1691. {$HINTS OFF}
  1692. Procedure TGrid.MouseMove(ShiftState:TShiftState;X,Y:LongInt);
  1693. Var
  1694.     Row:LongInt;
  1695.     Col:LongInt;
  1696.     Shape:TCursor;
  1697.     X1,y1:LongInt;
  1698. Begin
  1699.      Inherited MouseMove(ShiftState,X,Y);
  1700.  
  1701.      If FSizeShape<>crDefault Then {Sizing}
  1702.      Begin
  1703.           LastMsg.Handled:=True;
  1704.           Canvas.Pen.Mode:=pmNot;
  1705.           Canvas.Pen.color:=clBlack;
  1706.           {Delete old rubberline}
  1707.           If FSizeShape=crVSplit Then Canvas.Line(0,FSizeY,Width,FSizeY)
  1708.           Else Canvas.Line(FSizeX,0,FSizeX,Height);
  1709.           {Draw New Line}
  1710.           FSizeX:=X;
  1711.           If FSizeX<=FSizeStartX+5 Then FSizeX:=FSizeStartX+5;
  1712.           If FSizeX>=Width-5 Then FSizeX:=Width-5;
  1713.           FSizeY:=Y;
  1714.           If FSizeY>=FSizeStartY-5 Then FSizeY:=FSizeStartY-5;
  1715.           If FSizeY<=5 Then FSizeY:=5;
  1716.           If FSizeShape=crVSplit Then Canvas.Line(0,FSizeY,Width,FSizeY)
  1717.           Else Canvas.Line(FSizeX,0,FSizeX,Height);
  1718.           Canvas.Pen.Mode:=pmCopy;
  1719.           Exit;
  1720.      End;
  1721.  
  1722.      Shape:=GetSizeItem(Point(X,Y),Col,Row);
  1723.      {$IFDEF OS2}
  1724.      WinSetPointer(HWND_DESKTOP,Screen.Cursors[Shape]);
  1725.      {$ENDIF}
  1726.      {$IFDEF Win95}
  1727.      SetClassWord(Handle,-12{GCW_HCURSOR},0);
  1728.      SetCursor(Screen.Cursors[Shape]);
  1729.      {$ENDIF}
  1730.      If Shape<>crDefault Then LastMsg.Handled:=True; {dont pass To Form Editor}
  1731. End;
  1732.  
  1733. Procedure TGrid.RowHeightChanged(Row:LongInt);
  1734. Begin
  1735. End;
  1736.  
  1737. Procedure TGrid.ColWidthChanged(Col:LongInt);
  1738. Begin
  1739. End;
  1740.  
  1741. Procedure TGrid.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
  1742. Var  Row:LongInt;
  1743.      Col:LongInt;
  1744.      Shape:TCursor;
  1745. Begin
  1746.      Inherited MouseDown(Button,ShiftState,X,Y);
  1747.  
  1748.      If Button <> mbLeft Then Exit;
  1749.      Focus;
  1750.  
  1751.      Shape:=GetSizeItem(Point(X,Y),Col,Row);
  1752.      {$IFDEF OS2}
  1753.      WinSetPointer(HWND_DESKTOP,Screen.Cursors[Shape]);
  1754.      {$ENDIF}
  1755.      {$IFDEF Win95}
  1756.      SetClassWord(Handle,-12{GCW_HCURSOR},0);
  1757.      SetCursor(Screen.Cursors[Shape]);
  1758.      {$ENDIF}
  1759.      If Shape<>crDefault Then
  1760.      Begin
  1761.           LastMsg.Handled:=True; {dont pass To Form Editor}
  1762.           Canvas.Pen.Mode:=pmNot;
  1763.           Canvas.Pen.color:=clBlack;
  1764.           FSizeCol:=Col;
  1765.           FSizeRow:=Row;
  1766.           FSizeShape:=Shape;
  1767.           FSizeStartX:=X-FColWidths^[Col];
  1768.           FSizeStartY:=Y+FRowHeights^[Row];
  1769.           FSizeX:=X;
  1770.           FSizeY:=Y;
  1771.           If FSizeShape=crVSplit Then Canvas.Line(0,FSizeY,Width,FSizeY)
  1772.           Else Canvas.Line(FSizeX,0,FSizeX,Height);
  1773.           MouseCapture:=True;
  1774.           Canvas.Pen.Mode:=pmCopy;
  1775.           //ClearFocus;
  1776.      End
  1777.      Else
  1778.      Begin
  1779.           If Designed Then Exit;
  1780.  
  1781.           If ((Row<>-1)And(Col<>-1)) Then
  1782.             If Options*[goMouseSelect]<>[] Then
  1783.           Begin
  1784.                {entry Focused}
  1785.                If Not SelectCell(Col,Row) Then Exit;
  1786.                If OnSelectCell<>Nil Then OnSelectCell(Self,Col,Row);
  1787.           End;
  1788.           //Else ClearFocus;
  1789.      End;
  1790. End;
  1791.  
  1792. Procedure TGrid.MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
  1793. Var T:LongInt;
  1794.     Col:LongInt;
  1795.     Row:LongInt;
  1796.     DNS:TDesignerNotifyStruct;
  1797. Begin
  1798.      Inherited MouseUp(Button,ShiftState,X,Y);
  1799.  
  1800.      If Button <> mbLeft Then Exit;
  1801.  
  1802.      If FSizeShape<>crDefault Then
  1803.      Begin
  1804.           LastMsg.Handled:=True; {dont pass To Form Editor}
  1805.           Canvas.Pen.Mode:=pmNot;
  1806.           Canvas.Pen.color:=clBlack;
  1807.           {Delete old rubberline}
  1808.           If FSizeShape=crVSplit Then Canvas.Line(0,FSizeY,Width,FSizeY)
  1809.           Else Canvas.Line(FSizeX,0,FSizeX,Height);
  1810.           MouseCapture:=False;
  1811.           Canvas.Pen.Mode:=pmCopy;
  1812.  
  1813.           If FSizeX<=FSizeStartX+5 Then FSizeX:=FSizeStartX+5;
  1814.           If FSizeY>=FSizeStartY-5 Then FSizeY:=FSizeStartY-5;
  1815.  
  1816.           FSizeX:=FSizeX-FSizeStartX;
  1817.           FSizeY:=FSizeStartY-FSizeY;
  1818.  
  1819.           If FSizeShape=crVSplit Then
  1820.           Begin
  1821.                {Row Height Sizing}
  1822.                FRowHeights^[FSizeRow]:=FSizeY;
  1823.                RowHeightChanged(FSizeRow);
  1824.           End
  1825.           Else
  1826.           Begin
  1827.                {Column Width Sizing}
  1828.                FColWidths^[FSizeCol]:=FSizeX;
  1829.                ColWidthChanged(FSizeCol);
  1830.           End;
  1831.  
  1832.           DNS.Sender := Self;
  1833.           DNS.Code := dncSCUModified;
  1834.           DNS.return := 0;
  1835.           DesignerNotification(DNS);
  1836.  
  1837.           FSizeShape:=crDefault;
  1838.           UpdateScrollBars;
  1839.           Invalidate;
  1840.      End;
  1841. End;
  1842.  
  1843. Function TGrid.GetSelection:TGridRect;
  1844. Begin
  1845.      Result.Left:=Col;
  1846.      Result.Top:=Row;
  1847.  
  1848.      //we only Do support Single Selection For now...
  1849.      Result.Right:=Result.Left;
  1850.      Result.Bottom:=Result.Top;
  1851. End;
  1852.  
  1853. Procedure TGrid.SetSelection(NewValue:TGridRect);
  1854. Begin
  1855.      //we only Do support Single Selection For now...
  1856.      SelectCell(NewValue.Left,NewValue.Top);
  1857. End;
  1858.  
  1859. Function TGrid.SelectCell(Col,Row:LongInt):Boolean;
  1860. Var rc:TRect;
  1861.     T:LongInt;
  1862.     Count:LongInt;
  1863.     ActualCol,ActualRow:LongInt;
  1864.     DoRefresh:Boolean;
  1865.  
  1866.     Function ColMatch:Boolean;
  1867.     Var T:LongInt;
  1868.         X:LongInt;
  1869.         MaxWidth:LongInt;
  1870.     Begin
  1871.          Result:=False;
  1872.          X:=0;
  1873.          MaxWidth:=Width;
  1874.          If FVertScrollBar<>Nil Then
  1875.            If FVertScrollBar.Visible Then Dec(MaxWidth,FVertScrollBar.Width);
  1876.          For T:=0 To FFixedCols-1 Do Inc(X,FColWidths^[T]);
  1877.          For T:=Count To Col Do
  1878.          Begin
  1879.               Inc(X,FColWidths^[T]);
  1880.               If X>=MaxWidth Then If T<>Col Then Exit;
  1881.          End;
  1882.          Result:=True;
  1883.     End;
  1884.  
  1885.     Function RowMatch:Boolean;
  1886.     Var T:LongInt;
  1887.         Y:LongInt;
  1888.         MinHeight:LongInt;
  1889.     Begin
  1890.          Result:=False;
  1891.          Y:=Height;
  1892.          MinHeight:=0;
  1893.          If FHorzScrollBar<>Nil Then
  1894.            If FHorzScrollBar.Visible Then Inc(MinHeight,FHorzScrollBar.Height);
  1895.          For T:=0 To FFixedRows-1 Do Dec(Y,FRowHeights^[T]);
  1896.          For T:=Count To Row Do
  1897.          Begin
  1898.               Dec(Y,FRowHeights^[T]);
  1899.               If Y<=MinHeight Then If T<>Row Then Exit;
  1900.          End;
  1901.          Result:=True;
  1902.     End;
  1903.  
  1904. Begin
  1905.      Result:=True;
  1906.      If ((Col<0)Or(Col>FColCount)Or(Col<FFixedCols)Or
  1907.          (Row<0)Or(Row>FRowCount)Or(Row<FFixedRows)) Then Exit;
  1908.  
  1909.      If ((Col=FSelectCol)And(Row=FSelectRow)) Then Exit;
  1910.  
  1911.      If ((FSelectCol>=0)And(FSelectRow>=0)) Then
  1912.      Begin
  1913.           rc:=GridRects[FSelectCol,FSelectRow];
  1914.           If Options*[goShowSelection]<>[] Then InvalidateRect(rc);
  1915.      End;
  1916.  
  1917.      FSelectCol:=Col;
  1918.      FSelectRow:=Row;
  1919.      DoRefresh:=False;
  1920.  
  1921.      If Col>FLeftScrolled+VisibleColCount-FFixedCols Then
  1922.      Begin
  1923.           T:=FLeftExtent;
  1924.           Count:=FLeftScrolled+FFixedCols;
  1925.           Repeat
  1926.                 Inc(T,FColWidths^[Count]);
  1927.                 Inc(Count);
  1928.           Until ColMatch;
  1929.  
  1930.           If FHorzScrollBar<>Nil Then
  1931.           Begin
  1932.                FHorzScrollBar.Position:=ScrollHorzTrack(FHorzScrollBar,T);
  1933.                FHorzScrollBar.Update;
  1934.           End;
  1935.           DoRefresh:=True;
  1936.      End
  1937.      Else If Col<FLeftScrolled+FFixedCols Then
  1938.      Begin
  1939.           T:=FLeftExtent;
  1940.           Count:=FLeftScrolled;
  1941.           While Count>Col-FFixedCols Do
  1942.           Begin
  1943.                Dec(T,FColWidths^[Count+FFixedCols-1]);
  1944.                Dec(Count);
  1945.           End;
  1946.  
  1947.           If FHorzScrollBar<>Nil Then
  1948.           Begin
  1949.                FHorzScrollBar.Position:=ScrollHorzTrack(FHorzScrollBar,T);
  1950.                FHorzScrollBar.Update;
  1951.           End;
  1952.           DoRefresh:=True;
  1953.      End;
  1954.  
  1955.      If Row>FUpScrolled+VisibleRowCount-FFixedRows Then
  1956.      Begin
  1957.           T:=FUpExtent;
  1958.           Count:=FUpScrolled+FFixedRows;
  1959.           Repeat
  1960.                 Inc(T,FRowHeights^[Count]);
  1961.                 Inc(Count);
  1962.           Until RowMatch;
  1963.  
  1964.           If FVertScrollBar<>Nil Then
  1965.           Begin
  1966.                FVertScrollBar.Position:=ScrollVertTrack(FVertScrollBar,T);
  1967.                FVertScrollBar.Update;
  1968.           End;
  1969.           DoRefresh:=True;
  1970.      End
  1971.      Else If Row<FUpScrolled+FFixedRows Then
  1972.      Begin
  1973.           T:=FUpExtent;
  1974.           Count:=FUpScrolled;
  1975.           While Count>Row-FFixedRows Do
  1976.           Begin
  1977.                Dec(T,FRowHeights^[Count+FFixedRows-1]);
  1978.                Dec(Count);
  1979.           End;
  1980.  
  1981.           If FVertScrollBar<>Nil Then
  1982.           Begin
  1983.               FVertScrollBar.Position:=ScrollVertTrack(FVertScrollBar,T);
  1984.               FVertScrollBar.Update;
  1985.           End;
  1986.           DoRefresh:=True;
  1987.      End;
  1988.  
  1989.      If ((FSelectCol>=0)And(FSelectRow>=0)) Then
  1990.      Begin
  1991.           rc:=GridRects[FSelectCol,FSelectRow];
  1992.           If Options*[goShowSelection]<>[] Then InvalidateRect(rc);
  1993.      End;
  1994.  
  1995.      If DoRefresh Then Refresh
  1996.      Else Update;
  1997. End;
  1998.  
  1999. Procedure TGrid.SetUpdateLocked(NewValue:Boolean);
  2000. Begin
  2001.      If NewValue=FGridUpdateLocked Then Exit;
  2002.      FGridUpdateLocked:=NewValue;
  2003.      If Not FGridUpdateLocked Then If Handle<>0 Then Invalidate;
  2004. End;
  2005.  
  2006. Procedure TGrid.SetCol(NewValue:LongInt);
  2007. Begin
  2008.      If ((NewValue>=0)And(NewValue<FColCount)And(NewValue<>FSelectCol)) Then
  2009.      Begin
  2010.           If ((FSelectRow>=0)And(FSelectRow<FRowCount)) Then
  2011.           Begin
  2012.                If Not SelectCell(NewValue,FSelectRow) Then Exit;
  2013.                If OnSelectCell<>Nil Then OnSelectCell(Self,NewValue,FSelectRow);
  2014.           End
  2015.           Else FSelectCol:=NewValue;
  2016.      End;
  2017. End;
  2018.  
  2019. Procedure TGrid.SetRow(NewValue:LongInt);
  2020. Begin
  2021.      If ((NewValue>=0)And(NewValue<FRowCount)And(NewValue<>FSelectRow)) Then
  2022.      Begin
  2023.           If ((FSelectCol>=0)And(FSelectCol<FColCount)) Then
  2024.           Begin
  2025.                If Not SelectCell(FSelectCol,NewValue) Then Exit;
  2026.                If OnSelectCell<>Nil Then OnSelectCell(Self,FSelectCol,NewValue);
  2027.           End
  2028.           Else FSelectRow:=NewValue;
  2029.      End;
  2030. End;
  2031.  
  2032. Procedure TGrid.ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);
  2033. Var Visible:LongInt;
  2034. Begin
  2035.      If ((FSelectCol>=0)And(FSelectRow>=0)) Then
  2036.      Begin
  2037.           Case KeyCode Of
  2038.              kbCLeft:If Col>FFixedCols Then Col:=Col-1;
  2039.              kbCRight:If Col<FColCount-1 Then Col:=Col+1;
  2040.              kbCUp:If Row>FFixedRows Then Row:=Row-1;
  2041.              kbCDown:If Row<FRowCount-1 Then Row:=Row+1;
  2042.              kbPageDown:
  2043.              Begin
  2044.                   Visible:=VisibleRowCount;
  2045.                   If FSelectRow+Visible<FRowCount-1 Then Row:=FSelectRow+Visible
  2046.                   Else Row:=FRowCount-1;
  2047.              End;
  2048.              kbPageUp:
  2049.              Begin
  2050.                   Visible:=VisibleRowCount;
  2051.                   If FSelectRow-FFixedRows>Visible Then Row:=FSelectRow-Visible
  2052.                   Else Row:=FFixedRows;
  2053.              End;
  2054.              Else Inherited ScanEvent(KeyCode,RepeatCount);
  2055.           End;
  2056.      End
  2057.      Else Inherited ScanEvent(KeyCode,RepeatCount);
  2058. End;
  2059.  
  2060. {
  2061. ╔═══════════════════════════════════════════════════════════════════════════╗
  2062. ║                                                                           ║
  2063. ║ Speed-Pascal/2 Version 2.0                                                ║
  2064. ║                                                                           ║
  2065. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2066. ║                                                                           ║
  2067. ║ This section: TStringGrid Class Implementation                            ║
  2068. ║                                                                           ║
  2069. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2070. ║                                                                           ║
  2071. ╚═══════════════════════════════════════════════════════════════════════════╝
  2072. }
  2073.  
  2074.  
  2075. Procedure TStringGrid.SetupCellDrawing(Col,Row:LongInt;AState:TGridDrawState;
  2076.                                        Var Alignment:TAlignment;Var Font:TFont);
  2077. Begin
  2078.      Alignment:=taLeftJustify;
  2079.      Font:=Self.Font;
  2080. End;
  2081.  
  2082.  
  2083. Procedure TStringGrid.DrawCell(Col,Row:LongInt;rec:TRect;AState:TGridDrawState);
  2084. Var
  2085.     X,Y:LongInt;
  2086.     S:String;
  2087.     OldClip:TRect;
  2088.     Exclude:TRect;
  2089.     CX,CY:LongInt;
  2090.     Alignment:TAlignment;
  2091.     TheFont,OldFont:TFont;
  2092. Begin
  2093.      If ((FEdit<>Nil)And(FEdit.Control.Visible)) Then AState:=AState-[gdSelected,gdFocused];
  2094.      SetCellColors(Col,Row,AState);
  2095.      SetupCellDrawing(Col,Row,AState,Alignment,TheFont);
  2096.  
  2097.      If TheFont<>Canvas.Font Then
  2098.      Begin
  2099.           OldFont:=Canvas.Font;
  2100.           Canvas.Font:=TheFont;
  2101.      End
  2102.      Else OldFont:=Nil;
  2103.  
  2104.      S:=Cells[Col,Row];
  2105.      X:=rec.Left+2;
  2106.      Y:=rec.Top-2-Canvas.Font.Height;
  2107.  
  2108.      Canvas.GetTextExtent(S,CX,CY);
  2109.  
  2110.      Case Alignment Of
  2111.         taLeftJustify:;
  2112.         taRightJustify:If CX<(rec.Right-rec.Left)-2 Then X:=rec.Right-2-CX;
  2113.         taCenter:If CX<(rec.Right-rec.Left)-2 Then X:=(((rec.Right-rec.Left)-2)-CX) Div 2;
  2114.      End; {Case}
  2115.  
  2116.      Canvas.TextOut(X,Y,S);
  2117.      OldClip:=Canvas.ClipRect;
  2118.  
  2119.      Exclude.Left:=X;
  2120.      Exclude.Right:=X+CX;
  2121.      {$IFDEF OS2}
  2122.      dec(Exclude.Right);
  2123.      {$ENDIF}
  2124.      Exclude.Bottom:=Y;
  2125.      Exclude.Top:=Y+CY-1;
  2126.      Canvas.ClipRect:=rec;
  2127.      Canvas.ExcludeClipRect(Exclude);
  2128.      Inherited DrawCell(Col,Row,rec,AState);
  2129.      Canvas.ClipRect:=OldClip;
  2130.  
  2131.      If OldFont<>Nil Then Canvas.Font:=OldFont;
  2132. End;
  2133.  
  2134. {$HINTS OFF}
  2135. Procedure TStringGrid.EvEntryKillFocus(Sender:TObject);
  2136. Begin
  2137.      ClearFocus;
  2138. End;
  2139. {$HINTS ON}
  2140.  
  2141.  
  2142. Function TStringGrid.SelectCell(Col,Row:LongInt):Boolean;
  2143. Var rc:TRect;
  2144.     Ok:Boolean;
  2145. Label L;
  2146. Begin
  2147.      Result:=True;
  2148.      If ((FOptions*[goEditing]<>[])And(FOptions*[goAlwaysShowEditor]<>[])) Then
  2149.      Begin
  2150. L:
  2151.           If ((FSelectCol>=0)And(FSelectRow>=0)And(FEdit<>Nil)And(FEdit.Control.Visible)And
  2152.               (FEdit.Text<>Cells[FSelectCol,FSelectRow])) Then
  2153.           Begin
  2154.              If ((FSelectCol=Col)And(FSelectRow=Row)) Then Exit;
  2155.  
  2156.              Try
  2157.                 If OnSetEditText<>Nil Then OnSetEditText(Self,FSelectCol,FSelectRow,FEdit.Text);
  2158.                 Cells[FSelectCol,FSelectRow]:=FEdit.Text;
  2159.              Except
  2160.                 ON E:ESQLError Do ErrorBox(E.Message);
  2161.                 Else Raise;
  2162.              End;
  2163.           End;
  2164.  
  2165.           If ((FSelectCol=Col)And(FSelectRow=Row)And
  2166.               (FEdit<>Nil)And(FEdit.Control.Visible)) Then Exit;
  2167.  
  2168.           If FOptions*[goAlwaysShowEditor]<>[] Then Inherited SelectCell(Col,Row);
  2169.  
  2170.           ShowEntry(Cells[FSelectCol,FSelectRow]);
  2171.  
  2172.           If FOptions*[goAlwaysShowEditor]=[] Then
  2173.           Begin
  2174.               rc:=GridRects[FSelectCol,FSelectRow];
  2175.               InvalidateRect(rc);
  2176.               Update;
  2177.           End;
  2178.      End
  2179.      Else
  2180.      Begin
  2181.           If ((FSelectCol=Col)And(FSelectRow=Row)And(FOptions*[goEditing]<>[])) Then
  2182.           Begin
  2183.                Ok:=True;
  2184.                If OnCanEdit<>Nil Then OnCanEdit(Self,Col,Row,Ok);
  2185.                If Ok Then Goto L;
  2186.           End;
  2187.  
  2188.           If ((Col<>FSelectCol)Or(Row<>FSelectRow)) Then
  2189.             If ((FSelectCol>=0)And(FSelectRow>=0)) Then
  2190.             Begin
  2191.                  HideEditorIntern;
  2192.             End;
  2193.           Inherited SelectCell(Col,Row);
  2194.      End;
  2195. End;
  2196.  
  2197. Procedure TStringGrid.SetCell(Col,Row:LongInt;Const NewContent:String);
  2198. Var Rows:TList;
  2199.     ps:PString;
  2200.     T:LongInt;
  2201.     NewValue:String;
  2202. Begin
  2203.      If ((Row<0)Or(Row>FRowCount-1)Or(Col<0)Or(Col>FColCount-1)) Then Exit;
  2204.  
  2205.      {entry exists}
  2206.      If FColumns=Nil Then FColumns.Create;
  2207.      For T:=0 To Col-FColumns.Count Do //Append Columns
  2208.      Begin
  2209.           Rows.Create;
  2210.           FColumns.Add(Rows);
  2211.      End;
  2212.  
  2213.      Rows:=FColumns.Items[Col];
  2214.      If Rows=Nil Then
  2215.      Begin
  2216.           Rows.Create;
  2217.           FColumns.Items[Col]:=Rows;
  2218.      End;
  2219.  
  2220.      For T:=0 To Row-Rows.Count Do Rows.Add(Nil);   //Append Rows ??
  2221.  
  2222.      NewValue:=NewContent;
  2223.      If OnSetCell<>Nil Then OnSetCell(Self,Col,Row,NewValue);
  2224.  
  2225.      ps:=Rows.Items[Row];
  2226.      If ps<>Nil Then FreeMem(ps,Length(ps^)+1);
  2227.  
  2228.      If NewValue='' Then ps:=Nil
  2229.      Else
  2230.      Begin
  2231.           GetMem(ps,Length(NewValue)+1);
  2232.           ps^:=NewValue;
  2233.      End;
  2234.      Rows.Items[Row]:=ps;
  2235. End;
  2236.  
  2237. Function TStringGrid.GetCell(Col,Row:LongInt):String;
  2238. Var Rows:TList;
  2239.     ps:PString;
  2240. Begin
  2241.      Result:='';
  2242.      If ((Row<0)Or(Row>FRowCount-1)Or(Col<0)Or(Col>FColCount-1)) Then Exit;
  2243.  
  2244.      {entry exists}
  2245.      If FColumns<>Nil Then
  2246.        If Col<=FColumns.Count-1 Then //Not Assigned
  2247.      Begin
  2248.          Rows:=FColumns.Items[Col];
  2249.          If Rows<>Nil Then
  2250.          Begin
  2251.               If Row<=Rows.Count-1 Then //Not Assigned
  2252.               Begin
  2253.                    ps:=Rows.Items[Row];
  2254.                    If ps=Nil Then Result:=''
  2255.                    Else Result:=ps^;
  2256.               End;
  2257.          End;
  2258.      End;
  2259.      If OnGetCell<>Nil Then OnGetCell(Self,Col,Row,Result);
  2260. End;
  2261.  
  2262. Procedure TStringGrid.SetupComponent;
  2263. Begin
  2264.      Inherited SetupComponent;
  2265.  
  2266.      Name:='StringGrid';
  2267. End;
  2268.  
  2269. Destructor TStringGrid.Destroy;
  2270. Var T,t1:LongInt;
  2271.     Rows:TList;
  2272.     ps:PString;
  2273. Begin
  2274.      //Destroy Columns/Rows that had been Assigned
  2275.      If FEdit<>Nil Then FEdit.Destroy;
  2276.      FEdit := Nil;
  2277.      If FColumns<>Nil Then
  2278.      Begin
  2279.           For T:=0 To FColumns.Count-1 Do
  2280.           Begin
  2281.                Rows:=FColumns.Items[T];
  2282.                If Rows<>Nil Then
  2283.                Begin
  2284.                     For t1:=0 To Rows.Count-1 Do
  2285.                     Begin
  2286.                          ps:=Rows.Items[t1];
  2287.                          If ps<>Nil Then FreeMem(ps,Length(ps^)+1);
  2288.                     End;
  2289.                     Rows.Destroy;
  2290.                End;
  2291.           End;
  2292.           FColumns.Destroy;
  2293.           FColumns := Nil;
  2294.      End;
  2295.  
  2296.      Inherited Destroy;
  2297. End;
  2298.  
  2299. Procedure TStringGrid.ClearFocus;
  2300. Var rc:TRect;
  2301.     S:String;
  2302. Begin
  2303.      If ((FSelectCol>=0)And(FSelectRow>=0)And(FEdit<>Nil)And(FEdit.Control.Visible)) Then
  2304.      Begin
  2305.           Try
  2306.              If FEdit.Text<>Cells[FSelectCol,FSelectRow] Then
  2307.              Begin
  2308.                   If OnSetEditText<>Nil Then OnSetEditText(Self,FSelectCol,FSelectRow,FEdit.Text);
  2309.                   Cells[FSelectCol,FSelectRow]:=FEdit.Text;
  2310.              End;
  2311.           Except
  2312.              ON E:ESQLError Do
  2313.              Begin
  2314.                   s:=Cells[FSelectCol,FSelectRow];
  2315.                   If OnGetEditText<>Nil Then OnGetEditText(Self,FSelectCol,FSelectRow,s);
  2316.                   FEdit.Text:=s;
  2317.                   ErrorBox(E.Message);
  2318.              End;
  2319.              Else Raise;
  2320.           End;
  2321.  
  2322.           FEdit.Hide;
  2323.           rc:=GridRects[FSelectCol,FSelectRow];
  2324.           InvalidateRect(rc);
  2325.           Update;
  2326.      End;
  2327.  
  2328.      Inherited ClearFocus;
  2329. End;
  2330.  
  2331. Procedure TStringGrid.ShowEntry(S:String);
  2332. Var rc:TRect;
  2333.     W,H:LongInt;
  2334.     back,Fore:TColor;
  2335.     Control:TControl;
  2336.     FEditClass:TInplaceEditClass;
  2337.     EditMask:String;
  2338. Begin
  2339.      rc:=GridRects[FSelectCol,FSelectRow];
  2340.      Inc(rc.Left);
  2341.      Dec(rc.Top,3);
  2342.      Dec(rc.Right);
  2343.      Inc(rc.Bottom,2);
  2344.  
  2345.      FEditClass:=ShowEditor(FSelectCol,FSelectRow);
  2346.      If FEditClass=Nil Then FEditClass:=TDefaultEdit;
  2347.  
  2348.      If ((FEdit<>Nil)And(FEditClass<>FEdit.ClassType)) Then
  2349.      Begin
  2350.           Focus;   //FEdit darf beim Destroy nicht den Fokus haben
  2351.           FEdit.Hide;
  2352.           FEdit.Destroy;
  2353.           FEdit:=Nil;
  2354.      End;
  2355.  
  2356.      If FEdit=Nil Then FEdit:=FEditClass.Create(Self,FSelectCol,FSelectRow)
  2357.      Else
  2358.      Begin
  2359.           FEdit.Hide;
  2360.           FEdit.FCol:=FSelectCol;
  2361.           FEdit.FRow:=FSelectRow;
  2362.           Focus;
  2363.           FEdit.SetupEdit(Self);
  2364.      End;
  2365.  
  2366.      Control:=FEdit.Control;
  2367.      Include(Control.ComponentState, csDetail);
  2368.      FEdit.Hide;
  2369.      FEdit.Control.Parent:=Self;
  2370.      FEdit.Control.OnExit:=EvEntryKillFocus;
  2371.  
  2372.      FEdit.Control.Font:=Font;
  2373.      W:=(rc.Right-rc.Left);
  2374.      H:=Canvas.Font.Height;
  2375.      If rc.Left+W>=Width Then W:=(Width-rc.Left)-1;
  2376.      If ((FVertScrollBar<>Nil)And(FVertScrollBar.Visible)) Then
  2377.         If rc.Left+W>=FVertScrollBar.Left Then W:=FVertScrollBar.Left-rc.Left;
  2378.      If rc.Top-H<=0 Then H:=rc.Top-1;
  2379.      FEdit.SetWindowPos(rc.Left,rc.Top-H,W,H);
  2380.      If OnGetEditText<>Nil Then OnGetEditText(Self,FSelectCol,FSelectRow,S);
  2381.      FEdit.Text:=S;
  2382.      SetupCellColors(FSelectCol,FSelectRow,[],back,Fore);
  2383.      FEdit.Control.Color:=Back;
  2384.      FEdit.Control.PenColor:=Fore;
  2385.      FEdit.Control.Focus;
  2386.      FEdit.Show;
  2387. End;
  2388.  
  2389. Function TStringGrid.ShowEditor(Col,Row:LongInt):TInplaceEditClass;
  2390. Begin
  2391.      If @FOnShowEditor<>Nil Then
  2392.        Result:=FOnShowEditor(Self,FSelectCol,FSelectRow)
  2393.      Else
  2394.        Result:=TDefaultEdit;
  2395. End;
  2396.  
  2397. Procedure TStringGrid.ShowEditorIntern;
  2398. Var rc:TRect;
  2399. Begin
  2400.      If ((FSelectCol<0)Or(FSelectRow<0)Or(((FEdit<>Nil)And(FEdit.Control.Visible)))) Then Exit;
  2401.  
  2402.      ShowEntry(Cells[FSelectCol,FSelectRow]);
  2403.  
  2404.      rc:=GridRects[FSelectCol,FSelectRow];
  2405.      InvalidateRect(rc);
  2406.      Update;
  2407. End;
  2408.  
  2409.  
  2410. Procedure TStringGrid.HideEditorIntern;
  2411. Var  rc:TRect;
  2412.      SelCol,SelRow:LongInt;
  2413.      Error:Boolean;
  2414.      ErrorText:String;
  2415. Begin
  2416.      If ((FSelectCol>=0)And(FSelectRow>=0)And(FEdit<>Nil)And(FEdit.Control.Visible)) Then
  2417.      Begin
  2418.           Try
  2419.              If FEdit.Text<>Cells[FSelectCol,FSelectRow] Then
  2420.              Begin
  2421.                   If OnSetEditText<>Nil Then OnSetEditText(Self,FSelectCol,FSelectRow,FEdit.Text);
  2422.                   Cells[FSelectCol,FSelectRow]:=FEdit.Text;
  2423.              End;
  2424.              Error:=False;
  2425.           Except
  2426.              ON E:ESQLError Do
  2427.              Begin
  2428.                   ErrorText:=Cells[FSelectCol,FSelectRow];
  2429.                   If OnGetEditText<>Nil Then OnGetEditText(Self,FSelectCol,FSelectRow,ErrorText);
  2430.                   FEdit.Text:=ErrorText;
  2431.                   ErrorText:=E.Message;
  2432.                   Error:=True;
  2433.              End;
  2434.              Else Raise;
  2435.           End;
  2436.  
  2437.           SelCol := FSelectCol;
  2438.           SelRow := FSelectRow;
  2439.           Focus;   //FEdit darf beim Destroy nicht den Fokus haben
  2440.           FEdit.Hide;
  2441.           FEdit.Destroy;
  2442.           FEdit:=Nil;
  2443.           TGrid.SelectCell(SelCol,SelRow); //Selection erneuern
  2444.           rc:=GridRects[FSelectCol,FSelectRow];
  2445.           CaptureFocus;
  2446.           InvalidateRect(rc);
  2447.           Update;
  2448.           If Error Then ErrorBox(ErrorText);
  2449.      End
  2450.      Else If FEdit<>Nil Then FEdit.Hide;
  2451. End;
  2452.  
  2453. Procedure TStringGrid.CharEvent(Var key:Char;RepeatCount:Byte);
  2454. Var rc:TRect;
  2455.     S:String;
  2456.     Ok:Boolean;
  2457. Begin
  2458.      If ((FOptions*[goEditing]<>[])And(FSelectCol>=0)And(FSelectRow>=0)) Then
  2459.      Begin
  2460.           Ok:=True;
  2461.           If OnCanEdit<>Nil Then OnCanEdit(Self,Col,Row,Ok);
  2462.           If Ok Then
  2463.           Begin
  2464.                S:=key;
  2465.                ShowEntry(S);
  2466.                rc:=GridRects[FSelectCol,FSelectRow];
  2467.                InvalidateRect(rc);
  2468.                Update;
  2469.                exit;
  2470.           End;
  2471.      End;
  2472.  
  2473.      Inherited CharEvent(key,RepeatCount);
  2474. End;
  2475.  
  2476. Procedure TStringGrid.ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);
  2477. Var
  2478.     Ok:Boolean;
  2479. Begin
  2480.      If ((FSelectCol>=0)And(FSelectRow>=0)And(FOptions*[goEditing]<>[])) Then
  2481.      Begin
  2482.           Case KeyCode Of
  2483.              {$IFDEF OS2}
  2484.              kbCR,kbEnter:
  2485.              {$ENDIF}
  2486.              {$IFDEF Win95}
  2487.              kbCR:
  2488.              {$ENDIF}
  2489.              Begin
  2490.                   If ((FEdit<>Nil)And(FEdit.Control.Visible)) Then HideEditorIntern
  2491.                   Else
  2492.                   Begin
  2493.                        Ok:=True;
  2494.                        If OnCanEdit<>Nil Then OnCanEdit(Self,Col,Row,Ok);
  2495.                        If Ok Then ShowEditorIntern;
  2496.                   End;
  2497.                   KeyCode := kbNull;
  2498.              End;
  2499.              Else Inherited ScanEvent(KeyCode,RepeatCount);
  2500.           End;
  2501.      End
  2502.      Else Inherited ScanEvent(KeyCode,RepeatCount);
  2503. End;
  2504.  
  2505.  
  2506. Procedure TStringGrid.Resize;
  2507. Var rc:TRect;
  2508.     W,H:LongInt;
  2509. Begin
  2510.      Inherited Resize;
  2511.      If ((FSelectCol>=0)And(FSelectRow>=0)And(FOptions*[goEditing]<>[])And(FEdit<>Nil)And(FEdit.Control.Visible)) Then
  2512.      Begin
  2513.           rc:=GridRects[FSelectCol,FSelectRow];
  2514.           Inc(rc.Left);
  2515.           Dec(rc.Top,3);
  2516.           Dec(rc.Right);
  2517.           Inc(rc.Bottom,2);
  2518.           W:=(rc.Right-rc.Left)-2;
  2519.           H:=Canvas.Font.Height;
  2520.           If rc.Left+W>=Width Then W:=(Width-rc.Left)-1;
  2521.           If ((FVertScrollBar<>Nil)And(FVertScrollBar.Visible)) Then
  2522.              If rc.Left+W>=FVertScrollBar.Left Then W:=FVertScrollBar.Left-rc.Left;
  2523.           If rc.Top-H<=0 Then H:=rc.Top-1;
  2524.           FEdit.SetWindowPos(rc.Left,rc.Top-H,W,H);
  2525.      End;
  2526. End;
  2527.  
  2528. Procedure TStringGrid.SetEditorMode(NewValue:Boolean);
  2529. Begin
  2530.      If NewValue Then ShowEditorIntern
  2531.      Else HideEditorIntern;
  2532. End;
  2533.  
  2534. {
  2535. ╔═══════════════════════════════════════════════════════════════════════════╗
  2536. ║                                                                           ║
  2537. ║ Speed-Pascal/2 Version 2.0                                                ║
  2538. ║                                                                           ║
  2539. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2540. ║                                                                           ║
  2541. ║ This section: TDrawGrid Class Implementation                              ║
  2542. ║                                                                           ║
  2543. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2544. ║                                                                           ║
  2545. ╚═══════════════════════════════════════════════════════════════════════════╝
  2546. }
  2547.  
  2548.  
  2549. Procedure TDrawGrid.SetupComponent;
  2550. Begin
  2551.      Inherited SetupComponent;
  2552.  
  2553.      Name:='DrawGrid';
  2554.      FDefaultDrawing:=True;
  2555. End;
  2556.  
  2557. Procedure TDrawGrid.MouseToCell(X,Y:LongInt;Var ACol,ARow:LongInt);
  2558. Begin
  2559.      GetSizeItem(Point(X,Y),ACol,ARow);
  2560. End;
  2561.  
  2562. Procedure TDrawGrid.SetDefaultDrawing(NewValue:Boolean);
  2563. Begin
  2564.      FDefaultDrawing:=NewValue;
  2565.      Refresh;
  2566. End;
  2567.  
  2568. Procedure TDrawGrid.DrawCell(Col,Row:LongInt;rec:TRect;AState:TGridDrawState);
  2569. Begin
  2570.      If ((DefaultDrawing)Or(Designed)) Then Inherited DrawCell(Col,Row,rec,AState);
  2571.      If FOnDrawCell<>Nil Then FOnDrawCell(Self,Col,Row,rec,AState);
  2572. End;
  2573.  
  2574. Procedure TDrawGrid.SetEditorMode(NewValue:Boolean);
  2575. Begin
  2576.      If NewValue Then ShowEditor
  2577.      Else HideEditor;
  2578. End;
  2579.  
  2580. Procedure TDrawGrid.ShowEditor;
  2581. Begin
  2582.      If ((FSelectCol>=0)And(FSelectRow>=0)And(FOptions*[goEditing]<>[])) Then
  2583.      Begin
  2584.           FEditorMode:=True;
  2585.           OpenEditor(FSelectCol,FSelectRow);
  2586.      End;
  2587. End;
  2588.  
  2589. Procedure TDrawGrid.HideEditor;
  2590. Begin
  2591.      If Not FEditorMode Then Exit;
  2592.      FEditorMode:=False;
  2593.      CloseEditor;
  2594. End;
  2595.  
  2596. Procedure TDrawGrid.OpenEditor(Col,Row:LongInt);
  2597. Begin
  2598.      If FOnOpenEditor<>Nil Then FOnOpenEditor(Self,Col,Row);
  2599. End;
  2600.  
  2601. Procedure TDrawGrid.CloseEditor;
  2602. Begin
  2603.      If FOnCloseEditor<>Nil Then FOnCloseEditor(Self);
  2604. End;
  2605.  
  2606. Procedure TDrawGrid.SetupCellColors(Col,Row:LongInt;AState:TGridDrawState;Var background,ForeGround:TColor);
  2607. Begin
  2608.      Inherited SetupCellColors(Col,Row,AState,background,ForeGround);
  2609. End;
  2610.  
  2611. Function TDrawGrid.SelectCell(Col,Row:LongInt):Boolean;
  2612. Var rc:TRect;
  2613. Label L;
  2614. Begin
  2615.      Result:=True;
  2616.      If ((FOptions*[goEditing]<>[])And(FOptions*[goAlwaysShowEditor]<>[])) Then
  2617.      Begin
  2618. L:
  2619.           If ((FSelectCol>=0)And(FSelectRow>=0)And(FEditorMode=True)) Then
  2620.           Begin
  2621.              If ((FSelectCol=Col)And(FSelectRow=Row)) Then Exit;
  2622.              HideEditor;
  2623.           End;
  2624.  
  2625.           If FOptions*[goAlwaysShowEditor]<>[] Then Inherited SelectCell(Col,Row);
  2626.  
  2627.           ShowEditor;
  2628.  
  2629.           If FOptions*[goAlwaysShowEditor]=[] Then
  2630.           Begin
  2631.               rc:=GridRects[FSelectCol,FSelectRow];
  2632.               InvalidateRect(rc);
  2633.               Update;
  2634.           End;
  2635.      End
  2636.      Else
  2637.      Begin
  2638.           If ((FSelectCol=Col)And(FSelectRow=Row)And(FOptions*[goEditing]<>[])) Then Goto L;
  2639.           Inherited SelectCell(Col,Row);
  2640.      End;
  2641. End;
  2642.  
  2643. Begin
  2644. End.
  2645.  
  2646.  
  2647.