controls/stringgrid/KOLStGrd.pas

   1 unit KOLStGrd;
   2
   3 interface
   4
   5 uses Windows, Messages, KOL;
   6
   7 const
   8   MaxCustomExtents = Maxint div 16;
   9   MaxShortInt = High(ShortInt);
  10
  11 type
  12   PIntArray = ^TIntArray;
  13   TIntArray = array[0..MaxCustomExtents] of Integer;
  14
  15   PStrListArray = ^TStrListArray;
  16   TStrListArray = array of PStrList;
  17
  18   // TMyEvent = procedure(Sender: PControl; Str: String; const Error: Boolean; var Retry: Boolean) of object;
  19
  20   TScrollStyle = (ssNone, ssHorizontal, ssVertical, ssBoth);
  21
  22   TGetExtentsFunc = function(Index: Longint): Integer of object;
  23
  24   TGridAxisDrawInfo = record
  25     EffectiveLineWidth: Integer;
  26     FixedBoundary: Integer;
  27     GridBoundary: Integer;
  28     GridExtent: Integer;
  29     LastFullVisibleCell: Longint;
  30     FullVisBoundary: Integer;
  31     FixedCellCount: Integer;
  32     FirstGridCell: Integer;
  33     GridCellCount: Integer;
  34     GetExtent: TGetExtentsFunc;
  35   end;
  36
  37   TGridDrawInfo = record
  38     Horz, Vert: TGridAxisDrawInfo;
  39   end;
  40
  41   TGridState = (gsNormal, gsSelecting, gsRowSizing, gsColSizing,
  42     gsRowMoving, gsColMoving);
  43   TGridMovement = gsRowMoving..gsColMoving;
  44
  45   TGridOption = (goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
  46     goRangeSelect, goDrawFocusSelected, goRowSizing, goColSizing, goRowMoving,
  47     goColMoving, goEditing, goTabs, goRowSelect,
  48     goAlwaysShowEditor, goThumbTracking);
  49   TGridOptions = set of TGridOption;
  50   TGridDrawState = set of (gdSelected, gdFocused, gdFixed);
  51   TGridScrollDirection = set of (sdLeft, sdRight, sdUp, sdDown);
  52
  53   TGridCoord = record
  54     X: Longint;
  55     Y: Longint;
  56   end;
  57
  58   TGridRect = record
  59     case Integer of
  60       0: (Left, Top, Right, Bottom: Longint);
  61       1: (TopLeft, BottomRight: TGridCoord);
  62   end;
  63
  64   TEditStyle =  (esSimple, esEllipsis, esPickList);
  65
  66   TSelectCellEvent = procedure (Sender: PControl; ACol, ARow: Longint;
  67     var CanSelect: Boolean) of object;
  68   TDrawCellEvent = procedure (Sender: PControl; Cnv: PCanvas; ACol, ARow: Longint;
  69     Rect: TRect; State: TGridDrawState) of object;
  70
  71   PStGrd = ^TStGrd;
  72   TStGrd = object(TControl)
  73   private
  74     function GetColWidths(Index: Integer): Integer;
  75     function GetGridHeight: Integer;
  76     function GetGridWidth: Integer;
  77     function GetRowHeights(Index: Integer): Integer;
  78     function GetSelection: TGridRect;
  79 //    function GetTabStops(Index: Integer): Boolean;
  80     function GetVisibleColCount: Integer;
  81     function GetVisibleRowCount: Integer;
  82     procedure SetCol(const Value: Longint);
  83     procedure SetColCount(Value: Longint);
  84     procedure SetColWidths(Index: Integer; const Value: Integer);
  85     procedure SetDefaultColWidth(const Value: Integer);
  86     procedure SetDefaultRowHeight(const Value: Integer);
  87     procedure SetFixedCols(const Value: Integer);
  88     procedure SetFixedRows(const Value: Integer);
  89     procedure SetLeftCol(const Value: Longint);
  90     procedure SetOptions(Value: TGridOptions);
  91     procedure SetRow(const Value: Longint);
  92     procedure SetRowCount(Value: Longint);
  93     procedure SetRowHeights(Index: Integer; const Value: Integer);
  94     procedure SetScrollBars(const Value: TScrollStyle);
  95     procedure SetSelection(const Value: TGridRect);
  96 //    procedure SetTabStops(Index: Integer; const Value: Boolean);
  97     procedure SetTopRow(const Value: Longint);
  98     function GetCol: Longint;
  99     function GetLeftCol: Longint;
 100     function GetRow: Longint;
 101     function GetTopRow: Longint;
 102     function GetColCount: Longint;
 103     function GetDefaultColWidth: Integer;
 104     function GetDefaultDrawing: Boolean;
 105     function GetHitTest: TPoint;
 106     procedure SetDefaultDrawing(const Value: Boolean);
 107     function GetDefaultRowHeight: Integer;
 108     function GetFixedCols: Integer;
 109     function GetFixedRows: Integer;
 110     function GetOptions: TGridOptions;
 111     function GetRowCount: Longint;
 112     function GetScrollBars: TScrollStyle;
 113
 114     function CalcCoordFromPoint(X, Y: Integer; const DrawInfo: TGridDrawInfo): TGridCoord;
 115     procedure CalcDrawInfoXY(var DrawInfo: TGridDrawInfo; UseWidth, UseHeight: Integer);
 116     procedure GridRectToScreenRect(GridRect: TGridRect; var ScreenRect: TRect; IncludeLine: Boolean);
 117     function IsActiveControl: Boolean;
 118     procedure MoveCurrent(ACol, ARow: Longint; _MoveAnchor, _Show: Boolean);
 119     procedure ClampInView(const Coord: TGridCoord);
 120     function CalcMaxTopLeft(const Coord: TGridCoord; const DrawInfo: TGridDrawInfo): TGridCoord;
 121     procedure SelectionMoved(const OldSel: TGridRect);
 122     procedure InvalidateRect(ARect: TGridRect);
 123     procedure ChangeSize(NewColCount, NewRowCount: Longint);
 124     procedure MoveAnchor(const NewAnchor: TGridCoord);
 125     procedure MoveTopLeft(ALeft, ATop: Longint);
 126     procedure DrawSizingLine(const DrawInfo: TGridDrawInfo);
 127     procedure DrawMove;
 128     procedure MoveAndScroll(Mouse, CellHit: Integer; var DrawInfo: TGridDrawInfo;
 129       var Axis: TGridAxisDrawInfo; Scrollbar: Integer; const MousePt: TPoint);
 130     procedure ModifyScrollBar(ScrollBar, ScrollCode, Pos: Cardinal; UseRightToLeft: Boolean);
 131     procedure ScrollDataInfo(DX, DY: Integer; var DrawInfo: TGridDrawInfo);
 132     procedure UpdateScrollPos;
 133     procedure UpdateScrollRange;
 134     procedure MoveAdjust(var CellPos: Longint; FromIndex, ToIndex: Longint);
 135     procedure CancelMode;
 136
 137     procedure WMTimer;
 138     procedure WMSetCursor(_HitTest: Word);
 139     function GetOnDrawCell: TDrawCellEvent;
 140     procedure SetOnDrawCell(const Value: TDrawCellEvent);
 141     function GetCells(ACol, ARow: Integer): string;
 142     procedure SetCells(ACol, ARow: Integer; const Value: string);
 143
 144    // function GetMyEvent: TMyEvent;
 145    // procedure SetMyEvent(const Value: TMyEvent);
 146
 147    // procedure OnNewLVData(Sender: PControl; Idx, SubItem: Integer; var Txt: String;
 148    //                       var ImgIdx: Integer; var State: DWORD; var Store: Boolean);
 149 //  protected
 150     procedure CalcDrawInfo(var DrawInfo: TGridDrawInfo);
 151     procedure CalcFixedInfo(var DrawInfo: TGridDrawInfo);
 152     procedure CalcSizingState(X, Y: Integer; var State: TGridState; var Index: Longint; var SizingPos, SizingOfs: Integer; var FixedInfo: TGridDrawInfo);// virtual;
 153     procedure DrawCell(Cnv: PCanvas; ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);// virtual;
 154     procedure FocusCell(ACol, ARow: Longint; _MoveAnchor: Boolean);
 155     procedure InvalidateCell(ACol, ARow: Longint);
 156     function BoxRect(ALeft, ATop, ARight, ABottom: Longint): TRect;
 157     procedure Paint(DC: HDC);
 158     procedure KeyDown(var Key: Integer);
 159     procedure MouseDown({Button: TMouseButton; Shift: TShiftState;} X, Y: Integer);
 160     procedure MouseMove({Shift: TShiftState;} X, Y: Integer);
 161     procedure MouseUp({Button: TMouseButton; Shift: TShiftState;} X, Y: Integer);
 162     procedure WheelDown{(Shift: TShiftState; MousePos: TPoint): Boolean};
 163     procedure WheelUp{(Shift: TShiftState; MousePos: TPoint): Boolean};
 164     procedure TimedScroll(Direction: TGridScrollDirection);
 165     procedure ScrollData(DX, DY: Integer);
 166     function SelectCell(ACol, ARow: Longint): Boolean;
 167     procedure MoveColumn(FromIndex, ToIndex: Longint);
 168     procedure MoveRow(FromIndex, ToIndex: Longint);
 169     procedure TopLeftMoved(const OldTopLeft: TGridCoord);
 170     function GetRows(Index: Integer): pStrList;
 171     procedure SetRows(Index: Integer; const Value: pStrList);
 172     function GetOnSelectCell: TSelectCellEvent;
 173     procedure SetOnSelectCell(const Value: TSelectCellEvent);
 174   public
 175     // property MyEvent: TMyEvent read GetMyEvent write SetMyEvent;
 176     property OnDrawCell: TDrawCellEvent read GetOnDrawCell write SetOnDrawCell;
 177     property OnSelectCell: TSelectCellEvent read GetOnSelectCell write SetOnSelectCell;
 178
 179     // property OnLVData: Boolean read FNotAvailable;
 180     property Col: Longint read GetCol write SetCol;
 181 //    property Color;
 182     property ColCount: Longint read GetColCount write SetColCount;
 183     property ColWidths[Index: Longint]: Integer read GetColWidths write SetColWidths;
 184     property DefaultColWidth: Integer read GetDefaultColWidth write SetDefaultColWidth;
 185     property DefaultDrawing: Boolean read GetDefaultDrawing write SetDefaultDrawing;
 186     property DefaultRowHeight: Integer read GetDefaultRowHeight write SetDefaultRowHeight;
 187     property FixedCols: Integer read GetFixedCols write SetFixedCols;
 188     property FixedRows: Integer read GetFixedRows write SetFixedRows;
 189     property GridHeight: Integer read GetGridHeight;
 190     property GridWidth: Integer read GetGridWidth;
 191     property HitTest: TPoint read GetHitTest;
 192     property LeftCol: Longint read GetLeftCol write SetLeftCol;
 193     property Options: TGridOptions read GetOptions write SetOptions;
 194     property Row: Longint read GetRow write SetRow;
 195     property RowCount: Longint read GetRowCount write SetRowCount;
 196     property RowHeights[Index: Longint]: Integer read GetRowHeights write SetRowHeights;
 197     property Rows[Index: Longint]: pStrList read GetRows write SetRows;
 198     property ScrollBars: TScrollStyle read GetScrollBars write SetScrollBars;
 199     property Selection: TGridRect read GetSelection write SetSelection;
 200 //    property TabStops[Index: Longint]: Boolean read GetTabStops write SetTabStops;
 201     property TopRow: Longint read GetTopRow write SetTopRow;
 202     property VisibleColCount: Integer read GetVisibleColCount;
 203     property VisibleRowCount: Integer read GetVisibleRowCount;
 204
 205     property Cells[ACol,ARow: Longint]: string read GetCells write SetCells;
 206   end;
 207
 208   TKOLStGrd = PStGrd;
 209
 210   TXorRects = array[0..3] of TRect;
 211
 212 const
 213   GridLineWidth = 1;
 214
 215 function NewStGrd(Sender: PControl;CCount,RCount,FCols,FRows,DefCW,DefRH: Longint; Options: TGridOptions; DefDraw,c3D,hasBrdr: Boolean; sBars: TScrollStyle): PStGrd;
 216
 217 function PointInGridRect(Col, Row: Longint; const Rect: TGridRect): Boolean;
 218 procedure XorRects(const R1, R2: TRect; var XorRects: TXorRects);
 219
 220 implementation
 221
 222 uses KOLMath;
 223
 224 {$R Cursors.res}
 225
 226 const
 227   IDC_HSPLIT =    PChar(32765);
 228   IDC_VSPLIT =    PChar(32764);
 229
 230 { ÄÀÍÍÛÅ ÄËß ÍÀØÅÃÎ ÎÁÚÅÊÒÀ (ÑÂÎÉÑÒÂÀ È ÎÁÐÀÁÎÒ×ÈÊÈ) }
 231 type
 232   PStGrdData = ^TStGrdData;
 233   TStGrdData = object(TObj)
 234     fControl: PControl;
 235     //MyEvent: TMyEvent;
 236     fOnDrawCell: TDrawCellEvent;
 237     fOnSelectCell: TSelectCellEvent;
 238
 239     fAnchor: TGridCoord;
 240     fColCount: Longint;
 241     fColWidths: Pointer;
 242     fCtl3D: Boolean;
 243 //    fTabStops: Pointer;
 244     fCurrent: TGridCoord;
 245     fDefaultColWidth: Integer;
 246     fDefaultRowHeight: Integer;
 247     fFixedCols: Integer;
 248     fFixedRows: Integer;
 249     fOptions: TGridOptions;
 250     fRowCount: Longint;
 251     fRowHeights: Pointer;
 252     fScrollBars: TScrollStyle;
 253     fTopLeft: TGridCoord;
 254     fSizingIndex: Longint;
 255     fSizingPos, fSizingOfs: Integer;
 256     fMoveIndex, fMovePos: Longint;
 257     fHitTest: TPoint;
 258     fColOffset: Integer;
 259     fDefaultDrawing: Boolean;
 260     fGridState: TGridState;
 261     fSaveCellExtents: Boolean;
 262
 263     fCells: Pointer;
 264
 265     destructor Destroy; virtual;
 266   end;
 267
 268 { Allocate a section and set all its items to nil. Returns: Pointer to start of
 269   section. }
 270 function  MakeSec(SecIndex: Integer; SectionSize: Word): Pointer;
 271 var
 272   SecP: Pointer;
 273   Size: Word;
 274 begin
 275   Size := SectionSize * SizeOf(Pointer);
 276   GetMem(secP, size);
 277   FillChar(secP^, size, 0);
 278   MakeSec := SecP
 279 end;
 280
 281
 282 function GridRect(Coord1, Coord2: TGridCoord): TGridRect;
 283 begin
 284   with Result do
 285   begin
 286     Left := Coord2.X;
 287     if Coord1.X < Coord2.X then Left := Coord1.X;
 288     Right := Coord1.X;
 289     if Coord1.X < Coord2.X then Right := Coord2.X;
 290     Top := Coord2.Y;
 291     if Coord1.Y < Coord2.Y then Top := Coord1.Y;
 292     Bottom := Coord1.Y;
 293     if Coord1.Y < Coord2.Y then Bottom := Coord2.Y;
 294   end;
 295 end;
 296
 297 function PointInGridRect(Col, Row: Longint; const Rect: TGridRect): Boolean;
 298 begin
 299   Result := (Col >= Rect.Left) and (Col <= Rect.Right) and (Row >= Rect.Top)
 300     and (Row <= Rect.Bottom);
 301 end;
 302
 303 procedure XorRects(const R1, R2: TRect; var XorRects: TXorRects);
 304 var
 305   Intersect, Union: TRect;
 306
 307   function PtInRect(X, Y: Integer; const Rect: TRect): Boolean;
 308   begin
 309     with Rect do Result := (X >= Left) and (X <= Right) and (Y >= Top) and
 310       (Y <= Bottom);
 311   end;
 312
 313   function Includes(const P1: TPoint; var P2: TPoint): Boolean;
 314   begin
 315     with P1 do
 316     begin
 317       Result := PtInRect(X, Y, R1) or PtInRect(X, Y, R2);
 318       if Result then P2 := P1;
 319     end;
 320   end;
 321
 322   function Build(var R: TRect; const P1, P2, P3: TPoint): Boolean;
 323   begin
 324     Build := True;
 325     with R do
 326       if Includes(P1, TopLeft) then
 327       begin
 328         if not Includes(P3, BottomRight) then BottomRight := P2;
 329       end
 330       else if Includes(P2, TopLeft) then BottomRight := P3
 331       else Build := False;
 332   end;
 333
 334 begin
 335   FillChar(XorRects, SizeOf(XorRects), 0);
 336   if not Bool(IntersectRect(Intersect, R1, R2)) then
 337   begin
 338     { Don't intersect so its simple }
 339     XorRects[0] := R1;
 340     XorRects[1] := R2;
 341   end
 342   else
 343   begin
 344     UnionRect(Union, R1, R2);
 345     if Build(XorRects[0],
 346       MakePoint(Union.Left, Union.Top),
 347       MakePoint(Union.Left, Intersect.Top),
 348       MakePoint(Union.Left, Intersect.Bottom)) then
 349       XorRects[0].Right := Intersect.Left;
 350     if Build(XorRects[1],
 351       MakePoint(Intersect.Left, Union.Top),
 352       MakePoint(Intersect.Right, Union.Top),
 353       MakePoint(Union.Right, Union.Top)) then
 354       XorRects[1].Bottom := Intersect.Top;
 355     if Build(XorRects[2],
 356       MakePoint(Union.Right, Intersect.Top),
 357       MakePoint(Union.Right, Intersect.Bottom),
 358       MakePoint(Union.Right, Union.Bottom)) then
 359       XorRects[2].Left := Intersect.Right;
 360     if Build(XorRects[3],
 361       MakePoint(Union.Left, Union.Bottom),
 362       MakePoint(Intersect.Left, Union.Bottom),
 363       MakePoint(Intersect.Right, Union.Bottom)) then
 364       XorRects[3].Top := Intersect.Bottom;
 365   end;
 366 end;
 367
 368 procedure ModifyExtents(var Extents: Pointer; Index, Amount: Longint;
 369   Default: Integer);
 370 var
 371   LongSize, OldSize: LongInt;
 372   NewSize: Integer;
 373   I: Integer;
 374 begin
 375   if Amount <> 0 then
 376   begin
 377     if not Assigned(Extents)
 378       then OldSize := 0
 379       else OldSize := PIntArray(Extents)^[0];
 380     if (Index < 0) or (OldSize < Index) then exit;//InvalidOp(SIndexOutOfRange);
 381     LongSize := OldSize + Amount;
 382     if LongSize < 0
 383       then exit//InvalidOp(STooManyDeleted)
 384       else if LongSize >= MaxCustomExtents - 1 then exit;//InvalidOp(SGridTooLarge);
 385     NewSize := Cardinal(LongSize);
 386     if NewSize > 0 then Inc(NewSize);
 387     ReallocMem(Extents, NewSize * SizeOf(Integer));
 388     if Assigned(Extents) then begin
 389       I := Index + 1;
 390       while I < NewSize do begin
 391         PIntArray(Extents)^[I] := Default;
 392         Inc(I);
 393       end;
 394       PIntArray(Extents)^[0] := NewSize-1;
 395     end;
 396   end;
 397 end;
 398
 399 procedure UpdateExtents(var Extents: Pointer; NewSize: Longint;
 400   Default: Integer);
 401 var
 402   OldSize: Integer;
 403 begin
 404   OldSize := 0;
 405   if Assigned(Extents) then OldSize := PIntArray(Extents)^[0];
 406   ModifyExtents(Extents, OldSize, NewSize - OldSize, Default);
 407 end;
 408
 409 procedure MoveExtent(var Extents: Pointer; FromIndex, ToIndex: Longint);
 410 var
 411   Extent: Integer;
 412 begin
 413   if Assigned(Extents) then
 414   begin
 415     Extent := PIntArray(Extents)^[FromIndex];
 416     if FromIndex < ToIndex then
 417       Move(PIntArray(Extents)^[FromIndex + 1], PIntArray(Extents)^[FromIndex],
 418         (ToIndex - FromIndex) * SizeOf(Integer))
 419     else if FromIndex > ToIndex then
 420       Move(PIntArray(Extents)^[ToIndex], PIntArray(Extents)^[ToIndex + 1],
 421         (FromIndex - ToIndex) * SizeOf(Integer));
 422     PIntArray(Extents)^[ToIndex] := Extent;
 423   end;
 424 end;
 425
 426 function CompareExtents(E1, E2: Pointer): Boolean;
 427 var
 428   I: Integer;
 429 begin
 430   Result := False;
 431   if E1 <> nil then
 432   begin
 433     if E2 <> nil then
 434     begin
 435       for I := 0 to PIntArray(E1)^[0] do
 436         if PIntArray(E1)^[I] <> PIntArray(E2)^[I] then Exit;
 437       Result := True;
 438     end
 439   end
 440   else Result := E2 = nil;
 441 end;
 442
 443 function LongMulDiv(Mult1, Mult2, Div1: Longint): Longint; stdcall;
 444   external 'kernel32.dll' name 'MulDiv';
 445
 446 procedure KillMessage(Wnd: HWnd; Msg: Integer);
 447 var
 448   M: TMsg;
 449 begin
 450   M.Message := 0;
 451   if PeekMessage(M, Wnd, Msg, Msg, pm_Remove) and (M.Message = WM_QUIT) then
 452     PostQuitMessage(M.wparam);
 453 end;
 454
 455 {-------------------------}
 456 { Destructor ÍÀØÈÕ ÄÀÍÍÛÕ }
 457 {-------------------------}
 458 destructor TStGrdData.Destroy;
 459 var i: Longint;
 460 begin
 461 // All Strings := '';
 462 // Free_And_Nil(All PObj);
 463   for i := fColCount-1 downto 0 do
 464     PStrListArray(fCells)^[i].Free;
 465   SetLength(PStrListArray(fCells)^,0);
 466   Dispose(PStrListArray(fCells));
 467   fCells := nil;
 468   inherited Destroy;
 469   FreeMem(fColWidths);
 470   FreeMem(fRowHeights);
 471 //  FreeMem(fTabStops);
 472 end;
 473 ////////////////////////////////////////////////////////////////////////////////
 474
 475 {--------------------}
 476 { ÎÁÐÀÁÎÒ×ÈÊ ÎÁÚÅÊÒÀ }
 477 {--------------------}
 478 function WndProcStGrd(Ctl: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;
 479 var
 480   S: PStGrd;
 481   D: PStGrdData;
 482   p: TPoint;
 483   r: TRect;
 484   t_dc: hDC;
 485 //  LV: PNMLISTVIEW;
 486 begin
 487   S := PStGrd(Ctl);
 488   D := Pointer(S.CustomObj);
 489   Result := False;
 490
 491   with S^,Msg do case Msg.message of
 492     WM_KEYDOWN: KeyDown(wParam);
 493     WM_LBUTTONDOWN: begin MouseDown(LOWORD(lParam),HIWORD(lParam)); SetCapture(Handle); end;
 494     WM_LBUTTONUP: begin MouseUp(LoWord(lParam),HiWord(lParam)); ReleaseCapture; end;
 495     WM_MOUSEMOVE: begin
 496       GetCursorPos(p);
 497       GetWindowRect(Handle,r);
 498       InflateRect(r,-2,-2);
 499       if PtInRect(r,p) then MouseMove(LOWORD(lParam),HIWORD(lParam));
 500     end;
 501     WM_SIZE: UpdateScrollRange;
 502     WM_GETDLGCODE: begin
 503       Rslt := DLGC_WANTARROWS;
 504       if goRowSelect in D.fOptions then Exit;
 505       if goTabs in D.fOptions then Rslt := Rslt or DLGC_WANTTAB;
 506       if goEditing in D.fOptions then Rslt := Rslt or DLGC_WANTCHARS;
 507     end;
 508     WM_KILLFOCUS: InvalidateRect(Selection);
 509     WM_SETFOCUS: InvalidateRect(Selection);
 510     WM_NCHITTEST: D.fHitTest := Screen2Client(MakePoint(LOWORD(lParam),HIWORD(lParam)));
 511     WM_TIMER: WMTimer;
 512     WM_PAINT: begin
 513       t_dc := GetDC(Handle);
 514       Paint(t_dc);
 515       ReleaseDC(Handle,t_dc);
 516     end;
 517     WM_VSCROLL: ModifyScrollBar(SB_VERT, LOWORD(wParam), HIWORD(wParam), True);
 518     WM_HSCROLL: ModifyScrollBar(SB_HORZ, LOWORD(wParam), HIWORD(wParam), True);
 519     WM_MOUSEWHEEL: if smallint(HIWORD(wParam)) > 0 then WheelUp else WheelDown;
 520     WM_SETCURSOR: WMSetCursor(LOWORD(lParam));
 521     WM_CANCELMODE: CancelMode;
 522 // Åñëè Result := TRUE, òî äàëüøå ñîîáùåíèå êîíòðîëó íå ïåðåäàåòñÿ.
 523 end; { case Msg }
 524 end;
 525 ////////////////////////////////////////////////////////////////////////////////
 526
 527 {-----------------------------}
 528 { ÊÎÍÑÒÐÓÊÒÎÐ ÄËß KOL ÎÁÚÅÊÒÀ }
 529 {-----------------------------}
 530 function NewStGrd;
 531 var D: PStGrdData;
 532     i,j: Longint;
 533 begin
 534   New(D, Create);
 535
 536   i := WS_CHILD {or WS_CLIPCHILDREN or WS_CLIPSIBLINGS} or WS_TABSTOP or WS_VISIBLE;
 537   if (sBars in [ssVertical,ssBoth]) then i := i or WS_VSCROLL;
 538   if (sBars in [ssHorizontal,ssBoth]) then i := i or WS_HSCROLL;
 539
 540   Result := PStGrd(_NewControl(Sender,'TStGrd',i,false,nil));
 541
 542   Result.ExStyle := Result.ExStyle and not WS_EX_CLIENTEDGE;
 543   Result.Style := Result.Style and not WS_BORDER;
 544   if hasBrdr then
 545     if c3D then Result.ExStyle := Result.ExStyle or WS_EX_CLIENTEDGE
 546            else Result.Style := Result.Style or WS_BORDER;
 547
 548   Result.CustomObj := D;
 549   D.fControl := Result;
 550
 551   D.fDefaultColWidth := DefCW;
 552   D.fDefaultRowHeight := DefRH;
 553   D.fDefaultDrawing := DefDraw;
 554   D.fSaveCellExtents := True;
 555   D.fColCount := CCount;
 556   D.fRowCount := RCount;
 557   D.fFixedCols := FCols;
 558   D.fFixedRows := FRows;
 559   D.fTopLeft.X := D.fFixedCols;
 560   D.fTopLeft.Y := D.fFixedRows;
 561   D.fCurrent := D.fTopLeft;
 562   D.fAnchor := D.fCurrent;
 563   D.fOptions := Options;
 564   if goRowSelect in D.fOptions then D.fAnchor.X := D.fColCount - 1;
 565   D.fScrollBars := sBars;
 566   D.fGridState := gsNormal;
 567   D.fCtl3D := c3D;
 568
 569   New(PStrListArray(D.fCells));//,D.fColCount*D.fRowCount*SizeOf(PAnsiString));
 570   SetLength(PStrListArray(D.fCells)^,D.fColCount);
 571   for i := 0 to D.fColCount-1 do begin
 572     PStrListArray(D.fCells)^[i] := NewStrList;//.Create;
 573     for j := 0 to D.fRowCount-1 do
 574       PStrListArray(D.fCells)^[i].Add('');
 575   end;
 576
 577 //  Result.TabStop := True;
 578
 579 // Code
 580
 581 { Óñòàíîâêà îáðàáîò÷èêîâ }
 582   Result.AttachProc(WndProcStGrd);
 583
 584 { Óñòàíîâêà íîâîãî îáðàáîò÷èêà }
 585 // Result.SetOnLVData(Result.OnNewLVData);
 586 end;
 587 ////////////////////////////////////////////////////////////////////////////////
 588
 589 {--------------------}
 590 { ÎÁÐÀÁÎÒ×ÈÊ MyEvent }
 591 {--------------------}
 592 { procedure TStGrd.SetMyEvent;
 593 var D: PStGrdData;
 594 begin
 595 D := Pointer(CustomObj);
 596 D.MyEvent := Value;
 597 end;
 598
 599 function TStGrd.GetMyEvent;
 600 var D: PStGrdData;
 601 begin
 602 D := Pointer(CustomObj);
 603 Result := D.MyEvent;
 604 end; }
 605
 606 { TStGrd }
 607
 608 function TStGrd.BoxRect(ALeft, ATop, ARight, ABottom: Integer): TRect;
 609 var
 610   GridRect: TGridRect;
 611 begin
 612   GridRect.Left := ALeft;
 613   GridRect.Right := ARight;
 614   GridRect.Top := ATop;
 615   GridRect.Bottom := ABottom;
 616   GridRectToScreenRect(GridRect, Result, False);
 617 end;
 618
 619 function TStGrd.CalcCoordFromPoint(X, Y: Integer; const DrawInfo: TGridDrawInfo): TGridCoord;
 620
 621   function DoCalc(const AxisInfo: TGridAxisDrawInfo; N: Integer): Integer;
 622   var
 623     I, Start, Stop: Longint;
 624     Line: Integer;
 625   begin
 626     with AxisInfo do
 627     begin
 628       if N < FixedBoundary then
 629       begin
 630         Start := 0;
 631         Stop :=  FixedCellCount - 1;
 632         Line := 0;
 633       end
 634       else
 635       begin
 636         Start := FirstGridCell;
 637         Stop := GridCellCount - 1;
 638         Line := FixedBoundary;
 639       end;
 640       Result := -1;
 641       for I := Start to Stop do
 642       begin
 643         Inc(Line, GetExtent(I) + EffectiveLineWidth);
 644         if N < Line then
 645         begin
 646           Result := I;
 647           Exit;
 648         end;
 649       end;
 650     end;
 651   end;
 652
 653   function DoCalcRightToLeft(const AxisInfo: TGridAxisDrawInfo; N: Integer): Integer;
 654   var
 655     I, Start, Stop: Longint;
 656     Line: Integer;
 657   begin
 658     N := ClientWidth - N;
 659     with AxisInfo do
 660     begin
 661       if N < FixedBoundary then
 662       begin
 663         Start := 0;
 664         Stop :=  FixedCellCount - 1;
 665         Line := ClientWidth;
 666       end
 667       else
 668       begin
 669         Start := FirstGridCell;
 670         Stop := GridCellCount - 1;
 671         Line := FixedBoundary;
 672       end;
 673       Result := -1;
 674       for I := Start to Stop do
 675       begin
 676         Inc(Line, GetExtent(I) + EffectiveLineWidth);
 677         if N < Line then
 678         begin
 679           Result := I;
 680           Exit;
 681         end;
 682       end;
 683     end;
 684   end;
 685
 686 begin
 687 //  if not UseRightToLeftAlignment then
 688     Result.X := DoCalc(DrawInfo.Horz, X);
 689 //  else
 690 //    Result.X := DoCalcRightToLeft(DrawInfo.Horz, X);
 691   Result.Y := DoCalc(DrawInfo.Vert, Y);
 692 end;
 693
 694 procedure TStGrd.CalcDrawInfo(var DrawInfo: TGridDrawInfo);
 695 begin
 696   CalcDrawInfoXY(DrawInfo, ClientWidth, ClientHeight);
 697 end;
 698
 699 procedure TStGrd.CalcDrawInfoXY(var DrawInfo: TGridDrawInfo; UseWidth, UseHeight: Integer);
 700
 701   procedure CalcAxis(var AxisInfo: TGridAxisDrawInfo; UseExtent: Integer);
 702   var I: Integer;
 703   begin
 704     with AxisInfo do begin
 705       GridExtent := UseExtent;
 706       GridBoundary := FixedBoundary;
 707       FullVisBoundary := FixedBoundary;
 708       LastFullVisibleCell := FirstGridCell;
 709       for I := FirstGridCell to GridCellCount - 1 do begin
 710         Inc(GridBoundary, GetExtent(I) + EffectiveLineWidth);
 711         if GridBoundary > GridExtent + EffectiveLineWidth then begin
 712           GridBoundary := GridExtent;
 713           Break;
 714         end;
 715         LastFullVisibleCell := I;
 716         FullVisBoundary := GridBoundary;
 717       end;
 718     end;
 719   end;
 720
 721 begin
 722   CalcFixedInfo(DrawInfo);
 723   CalcAxis(DrawInfo.Horz, UseWidth);
 724   CalcAxis(DrawInfo.Vert, UseHeight);
 725 end;
 726
 727 procedure TStGrd.CalcFixedInfo(var DrawInfo: TGridDrawInfo);
 728
 729   procedure CalcFixedAxis(var Axis: TGridAxisDrawInfo; LineOptions: TGridOptions; FixedCount, FirstCell, CellCount: Integer; GetExtentFunc: TGetExtentsFunc);
 730   var I: Integer;
 731   begin
 732     with Axis do begin
 733       if LineOptions * Options = []
 734         then EffectiveLineWidth := 0
 735         else EffectiveLineWidth := GridLineWidth;
 736
 737       FixedBoundary := 0;
 738       for I := 0 to FixedCount - 1 do
 739         Inc(FixedBoundary, GetExtentFunc(I) + EffectiveLineWidth);
 740
 741       FixedCellCount := FixedCount;
 742       FirstGridCell := FirstCell;
 743       GridCellCount := CellCount;
 744       GetExtent := GetExtentFunc;
 745     end;
 746   end;
 747
 748 var D: PStGrdData;
 749 begin
 750   D := Pointer(CustomObj);
 751   CalcFixedAxis(DrawInfo.Horz, [goFixedVertLine, goVertLine], D.fFixedCols, D.fTopLeft.X, D.fColCount, GetColWidths);
 752   CalcFixedAxis(DrawInfo.Vert, [goFixedHorzLine, goHorzLine], D.fFixedRows, D.fTopLeft.Y, D.fRowCount, GetRowHeights);
 753 end;
 754
 755 function TStGrd.CalcMaxTopLeft(const Coord: TGridCoord; const DrawInfo: TGridDrawInfo): TGridCoord;
 756
 757   function CalcMaxCell(const Axis: TGridAxisDrawInfo; Start: Integer): Integer;
 758   var
 759     Line: Integer;
 760     I, Extent: Longint;
 761   begin
 762     Result := Start;
 763     with Axis do
 764     begin
 765       Line := GridExtent + EffectiveLineWidth;
 766       for I := Start downto FixedCellCount do
 767       begin
 768         Extent := GetExtent(I);
 769         if Extent > 0 then
 770         begin
 771           Dec(Line, Extent);
 772           Dec(Line, EffectiveLineWidth);
 773           if Line < FixedBoundary then
 774           begin
 775             if (Result = Start) and (GetExtent(Start) <= 0) then
 776               Result := I;
 777             Break;
 778           end;
 779           Result := I;
 780         end;
 781       end;
 782     end;
 783   end;
 784
 785 begin
 786   Result.X := CalcMaxCell(DrawInfo.Horz, Coord.X);
 787   Result.Y := CalcMaxCell(DrawInfo.Vert, Coord.Y);
 788 end;
 789
 790 procedure TStGrd.CalcSizingState(X, Y: Integer; var State: TGridState; var Index, SizingPos, SizingOfs: Integer; var FixedInfo: TGridDrawInfo);
 791
 792   procedure CalcAxisState(const AxisInfo: TGridAxisDrawInfo; Pos: Integer; NewState: TGridState);
 793   var I, Line, Back, Range: Integer;
 794   begin
 795 //    if (NewState = gsColSizing) and UseRightToLeftAlignment then
 796 //      Pos := ClientWidth - Pos;
 797     with AxisInfo do begin
 798       Line := FixedBoundary;
 799       Range := EffectiveLineWidth;
 800       Back := 0;
 801       if Range < 7 then begin
 802         Range := 7;
 803         Back := (Range - EffectiveLineWidth) shr 1;
 804       end;
 805       for I := FirstGridCell to GridCellCount - 1 do begin
 806         Inc(Line, GetExtent(I));
 807         if Line > GridBoundary then Break;
 808         if (Pos >= Line - Back) and (Pos <= Line - Back + Range) then begin
 809           State := NewState;
 810           SizingPos := Line;
 811           SizingOfs := Line - Pos;
 812           Index := I;
 813           Exit;
 814         end;
 815         Inc(Line, EffectiveLineWidth);
 816       end;
 817       if (GridBoundary = GridExtent) and (Pos >= GridExtent - Back) and (Pos <= GridExtent) then begin
 818         State := NewState;
 819         SizingPos := GridExtent;
 820         SizingOfs := GridExtent - Pos;
 821         Index := LastFullVisibleCell + 1;
 822       end;
 823     end;
 824   end;
 825
 826   function XOutsideHorzFixedBoundary: Boolean;
 827   begin
 828     with FixedInfo do
 829 //      if not UseRightToLeftAlignment then
 830         Result := X > Horz.FixedBoundary
 831 //      else
 832 //        Result := X < ClientWidth - Horz.FixedBoundary;
 833   end;
 834
 835   function XOutsideOrEqualHorzFixedBoundary: Boolean;
 836   begin
 837     with FixedInfo do
 838 //      if not UseRightToLeftAlignment then
 839         Result := X >= Horz.FixedBoundary
 840 //      else
 841 //        Result := X <= ClientWidth - Horz.FixedBoundary;
 842   end;
 843
 844
 845 var
 846   EffectiveOptions: TGridOptions;
 847   D: PStGrdData;
 848 begin
 849   D := Pointer(CustomObj);
 850   State := gsNormal;
 851   Index := -1;
 852   EffectiveOptions := D.fOptions;
 853 //  if csDesigning in ComponentState then
 854 //    EffectiveOptions := EffectiveOptions + DesignOptionsBoost;
 855   if [goColSizing, goRowSizing] * EffectiveOptions <> [] then
 856     with FixedInfo do begin
 857       Vert.GridExtent := ClientHeight;
 858       Horz.GridExtent := ClientWidth;
 859       if (XOutsideHorzFixedBoundary) and (goColSizing in EffectiveOptions) then begin
 860         if Y >= Vert.FixedBoundary then Exit;
 861         CalcAxisState(Horz, X, gsColSizing);
 862       end else if (Y > Vert.FixedBoundary) and (goRowSizing in EffectiveOptions) then begin
 863         if XOutsideOrEqualHorzFixedBoundary then Exit;
 864         CalcAxisState(Vert, Y, gsRowSizing);
 865       end;
 866     end;
 867 end;
 868
 869 procedure TStGrd.CancelMode;
 870 var
 871   DrawInfo: TGridDrawInfo;
 872   D: PStGrdData;
 873 begin
 874   D := Pointer(CustomObj);
 875   try
 876     case D.fGridState of
 877       gsSelecting:
 878         KillTimer(Handle, 1);
 879       gsRowSizing, gsColSizing:
 880         begin
 881           CalcDrawInfo(DrawInfo);
 882           DrawSizingLine(DrawInfo);
 883         end;
 884       gsColMoving, gsRowMoving:
 885         begin
 886           DrawMove;
 887           KillTimer(Handle, 1);
 888         end;
 889     end;
 890   finally
 891     D.fGridState := gsNormal;
 892   end;
 893 end;
 894
 895 procedure TStGrd.ChangeSize(NewColCount, NewRowCount: Integer);
 896 var
 897   OldColCount, OldRowCount: Longint;
 898   OldDrawInfo: TGridDrawInfo;
 899   D: PStGrdData;
 900
 901   procedure MinRedraw(const OldInfo, NewInfo: TGridAxisDrawInfo; Axis: Integer);
 902   var
 903     R: TRect;
 904     First: Integer;
 905   begin
 906     First := Min(OldInfo.LastFullVisibleCell, NewInfo.LastFullVisibleCell);
 907     // Get the rectangle around the leftmost or topmost cell in the target range.
 908     R := BoxRect(First and not Axis, First and Axis,First and not Axis, First and Axis);
 909     R.Bottom := Height;
 910     R.Right := Width;
 911     Windows.InvalidateRect(Handle, @R, False);
 912   end;
 913
 914   procedure DoChange;
 915   var
 916     Coord: TGridCoord;
 917     NewDrawInfo: TGridDrawInfo;
 918   begin
 919     if D.fColWidths <> nil then
 920       UpdateExtents(D.fColWidths, D.fColCount, D.fDefaultColWidth);
 921 {    if D.fTabStops <> nil then
 922       UpdateExtents(D.fTabStops, D.fColCount, Integer(True));}
 923     if D.fRowHeights <> nil then
 924       UpdateExtents(D.fRowHeights, D.fRowCount, D.fDefaultRowHeight);
 925     Coord := D.fCurrent;
 926     if Row >= D.fRowCount then Coord.Y := D.fRowCount - 1;
 927     if Col >= D.fColCount then Coord.X := D.fColCount - 1;
 928     if (D.fCurrent.X <> Coord.X) or (D.fCurrent.Y <> Coord.Y) then
 929       MoveCurrent(Coord.X, Coord.Y, True, True);
 930     if (D.fAnchor.X <> Coord.X) or (D.fAnchor.Y <> Coord.Y) then
 931       MoveAnchor(Coord);
 932     if //VirtualView or
 933       (LeftCol <> OldDrawInfo.Horz.FirstGridCell) or
 934       (TopRow <> OldDrawInfo.Vert.FirstGridCell) then
 935       Invalidate//Grid
 936     else begin
 937       CalcDrawInfo(NewDrawInfo);
 938       MinRedraw(OldDrawInfo.Horz, NewDrawInfo.Horz, 0);
 939       MinRedraw(OldDrawInfo.Vert, NewDrawInfo.Vert, -1);
 940     end;
 941     UpdateScrollRange;
 942 //    SizeChanged(OldColCount, OldRowCount);
 943   end;
 944
 945 begin
 946   D := Pointer(CustomObj);
 947   CalcDrawInfo(OldDrawInfo);
 948   OldColCount := D.fColCount;
 949   OldRowCount := D.fRowCount;
 950   D.fColCount := NewColCount;
 951   D.fRowCount := NewRowCount;
 952   if D.fFixedCols > NewColCount then D.fFixedCols := NewColCount - 1;
 953   if D.fFixedRows > NewRowCount then D.fFixedRows := NewRowCount - 1;
 954   try
 955     DoChange;
 956   except
 957     { Could not change size so try to clean up by setting the size back }
 958     D.fColCount := OldColCount;
 959     D.fRowCount := OldRowCount;
 960     DoChange;
 961     Invalidate//Grid;
 962 //    raise;
 963   end;
 964 end;
 965
 966 procedure TStGrd.ClampInView(const Coord: TGridCoord);
 967 var
 968   DrawInfo: TGridDrawInfo;
 969   MaxTopLeft: TGridCoord;
 970   OldTopLeft: TGridCoord;
 971   D: PStGrdData;
 972 begin
 973   CalcDrawInfo(DrawInfo);
 974   with DrawInfo, Coord do begin
 975     if (X > Horz.LastFullVisibleCell) or
 976       (Y > Vert.LastFullVisibleCell) or (X < LeftCol) or (Y < TopRow) then begin
 977       D := Pointer(CustomObj);
 978       OldTopLeft := d.fTopLeft;
 979       MaxTopLeft := CalcMaxTopLeft(Coord, DrawInfo);
 980       Update;
 981       if X < LeftCol then d.fTopLeft.X := X
 982       else if X > Horz.LastFullVisibleCell then d.fTopLeft.X := MaxTopLeft.X;
 983       if Y < TopRow then d.fTopLeft.Y := Y
 984       else if Y > Vert.LastFullVisibleCell then d.fTopLeft.Y := MaxTopLeft.Y;
 985       TopLeftMoved(OldTopLeft);
 986     end;
 987   end;
 988 end;
 989
 990 procedure TStGrd.DrawCell(Cnv: PCanvas; ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState);
 991 var D: PStGrdData;
 992 begin
 993   D := Pointer(CustomObj);
 994   if Assigned(D.fOnDrawCell) and (not D.fDefaultDrawing)
 995     then D.fOnDrawCell(@Self,Cnv,ACol,ARow,ARect,AState);
 996 {    else if D.fDefaultDrawing then begin
 997       InflateRect(ARect,-2,-2);
 998       Cnv.TextRect(ARect,ARect.Left,ARect.Top,Cells[ACol,ARow]);
 999     end;}
1000 end;
1001
1002 procedure TStGrd.DrawMove;
1003 var
1004   OldPen: PGraphicTool;
1005   Pos: Integer;
1006   R: TRect;
1007   D: PStGrdData;
1008 begin
1009   OldPen := NewPen;
1010   D := Pointer(CustomObj);
1011   try
1012     with Canvas^ do begin
1013       OldPen.Assign(Pen);
1014       try
1015         Pen.PenStyle := psDot;
1016         Pen.PenMode := pmXor;
1017         Pen.Color := $0FFFF00;
1018         Pen.PenWidth := 3;
1019         if D.fGridState = gsRowMoving then begin
1020           R := BoxRect(0, D.fMovePos, 0, D.fMovePos);
1021           if D.fMovePos > D.fMoveIndex then
1022             Pos := R.Bottom else
1023             Pos := R.Top - 1;
1024           MoveTo(0, Pos);
1025           LineTo(ClientWidth, Pos);
1026         end else begin
1027           R := BoxRect(D.fMovePos, 0, D.fMovePos, 0);
1028           if D.fMovePos > D.fMoveIndex
1029             then {if not UseRightToLeftAlignment
1030               then} Pos := R.Right
1031               //else Pos := R.Left
1032             else {if not UseRightToLeftAlignment
1033               then} Pos := R.Left - 1;
1034               //else Pos := R.Right;
1035           MoveTo(Pos, 0);
1036           LineTo(Pos, ClientHeight);
1037         end;
1038       finally
1039         Pen.Assign(OldPen);
1040       end;
1041     end;
1042   finally
1043     OldPen.Free;
1044   end;
1045 end;
1046
1047 procedure TStGrd.DrawSizingLine(const DrawInfo: TGridDrawInfo);
1048 var
1049   OldPen: PGraphicTool;
1050   D: PStGrdData;
1051 begin
1052   D := Pointer(CustomObj);
1053   OldPen := NewPen;
1054   try
1055     with Canvas^, DrawInfo do begin
1056       OldPen.Assign(Pen);
1057       Pen.PenStyle := psSolid;
1058       Pen.PenMode := pmXor;
1059       Pen.Color := $0FFFF00;
1060       Pen.PenWidth := 1;
1061       try
1062         if D.fGridState = gsRowSizing then begin
1063 {          if UseRightToLeftAlignment then
1064           begin
1065             MoveTo(Horz.GridExtent, FSizingPos);
1066             LineTo(Horz.GridExtent - Horz.GridBoundary, FSizingPos);
1067           end
1068           else
1069           begin}
1070             MoveTo(0, D.fSizingPos);
1071             LineTo(Horz.GridBoundary, D.fSizingPos);
1072           //end;
1073         end else begin
1074           MoveTo(D.fSizingPos, 0);
1075           LineTo(D.fSizingPos, Vert.GridBoundary);
1076         end;
1077       finally
1078         Pen.Assign(OldPen);
1079       end;
1080     end;
1081   finally
1082     OldPen.Free;
1083   end;
1084 end;
1085
1086 procedure TStGrd.FocusCell(ACol, ARow: Integer; _MoveAnchor: Boolean);
1087 begin
1088   MoveCurrent(ACol, ARow, _MoveAnchor, True);
1089 //  Click;
1090 end;
1091
1092 function TStGrd.GetCells(ACol, ARow: Integer): string;
1093 var D: PStGrdData;
1094 begin
1095   D := Pointer(CustomObj);
1096   if (ACol < 0) or (ARow < 0) or (ACol > D.fColCount-1) or (ARow > D.fRowCount - 1) then exit;
1097 {  if PStrArray(D.fCells)^[ACol,ARow] = nil
1098     then Result := ''
1099     else Result := PStrArray(D.fCells)^[ACol,ARow];}
1100   Result := PStrListArray(D.fCells)^[ACol].Items[ARow];
1101 end;
1102
1103 function TStGrd.GetCol: Longint;
1104 var D: PStGrdData;
1105 begin
1106   D := Pointer(CustomObj);
1107   Result := D.fCurrent.X;
1108 end;
1109
1110 function TStGrd.GetColCount: Longint;
1111 var D: PStGrdData;
1112 begin
1113   D := Pointer(CustomObj);
1114   Result := D.fColCount;
1115 end;
1116
1117 function TStGrd.GetColWidths(Index: Integer): Integer;
1118 var D: PStGrdData;
1119 begin
1120   D := Pointer(CustomObj);
1121   if (D.fColWidths = nil) or (Index >= D.fColCount) then
1122     Result := D.fDefaultColWidth
1123   else
1124     Result := PIntArray(D.fColWidths)^[Index + 1];
1125 end;
1126
1127 function TStGrd.GetDefaultColWidth: Integer;
1128 var D: PStGrdData;
1129 begin
1130   D := Pointer(CustomObj);
1131   Result := D.fDefaultColWidth;
1132 end;
1133
1134 function TStGrd.GetDefaultDrawing: Boolean;
1135 var D: PStGrdData;
1136 begin
1137   D := Pointer(CustomObj);
1138   Result := D.fDefaultDrawing;
1139 end;
1140
1141 function TStGrd.GetDefaultRowHeight: Integer;
1142 var D: PStGrdData;
1143 begin
1144   D := Pointer(CustomObj);
1145   Result := D.fDefaultRowHeight;
1146 end;
1147
1148 function TStGrd.GetFixedCols: Integer;
1149 var D: PStGrdData;
1150 begin
1151   D := Pointer(CustomObj);
1152   Result := D.fFixedCols;
1153 end;
1154
1155 function TStGrd.GetFixedRows: Integer;
1156 var D: PStGrdData;
1157 begin
1158   D := Pointer(CustomObj);
1159   Result := D.fFixedRows;
1160 end;
1161
1162 function TStGrd.GetGridHeight: Integer;
1163 var
1164   DrawInfo: TGridDrawInfo;
1165 begin
1166   CalcDrawInfo(DrawInfo);
1167   Result := DrawInfo.Vert.GridBoundary;
1168 end;
1169
1170 function TStGrd.GetGridWidth: Integer;
1171 var
1172   DrawInfo: TGridDrawInfo;
1173 begin
1174   CalcDrawInfo(DrawInfo);
1175   Result := DrawInfo.Horz.GridBoundary;
1176 end;
1177
1178 function TStGrd.GetHitTest: TPoint;
1179 var D: PStGrdData;
1180 begin
1181   D := Pointer(CustomObj);
1182   Result := D.fHitTest;
1183 end;
1184
1185 function TStGrd.GetLeftCol: Longint;
1186 var D: PStGrdData;
1187 begin
1188   D := Pointer(CustomObj);
1189   Result := D.fTopLeft.X;
1190 end;
1191
1192 function TStGrd.GetOnDrawCell: TDrawCellEvent;
1193 var D: PStGrdData;
1194 begin
1195   D := Pointer(CustomObj);
1196   Result := D.fOnDrawCell;
1197 end;
1198
1199 function TStGrd.GetOnSelectCell: TSelectCellEvent;
1200 var D: PStGrdData;
1201 begin
1202   D := Pointer(CustomObj);
1203   Result := D.fOnSelectCell;
1204 end;
1205
1206 function TStGrd.GetOptions: TGridOptions;
1207 var D: PStGrdData;
1208 begin
1209   D := Pointer(CustomObj);
1210   Result := D.fOptions;
1211 end;
1212
1213 function TStGrd.GetRow: Longint;
1214 var D: PStGrdData;
1215 begin
1216   D := Pointer(CustomObj);
1217   Result := D.fCurrent.Y;
1218 end;
1219
1220 function TStGrd.GetRowCount: Longint;
1221 var D: PStGrdData;
1222 begin
1223   D := Pointer(CustomObj);
1224   Result := D.fRowCount;
1225 end;
1226
1227 function TStGrd.GetRowHeights(Index: Integer): Integer;
1228 var D: PStGrdData;
1229 begin
1230   D := Pointer(CustomObj);
1231   if (d.fRowHeights = nil) or (Index >= d.fRowCount)
1232     then Result := D.fDefaultRowHeight
1233     else Result := PIntArray(d.fRowHeights)^[Index + 1];
1234 end;
1235
1236 function TStGrd.GetRows(Index: Integer): pStrList;
1237 var D: PStGrdData;
1238     i: Longint;
1239 begin
1240   Result := NewStrList;
1241   D := Pointer(CustomObj);
1242   for i := 0 to D.fColCount-1 do
1243     Result.Add(PStrListArray(D.fCells)^[i].Items[Index])
1244 end;
1245
1246 function TStGrd.GetScrollBars: TScrollStyle;
1247 var D: PStGrdData;
1248 begin
1249   D := Pointer(CustomObj);
1250   Result := D.fScrollBars;
1251 end;
1252
1253 function TStGrd.GetSelection: TGridRect;
1254 var D: PStGrdData;
1255 begin
1256   D := Pointer(CustomObj);
1257   Result := GridRect(D.fCurrent, D.fAnchor);
1258 end;
1259 {
1260 function TStGrd.GetTabStops(Index: Integer): Boolean;
1261 var D: PStGrdData;
1262 begin
1263   D := Pointer(CustomObj);
1264   if D.fTabStops = nil then Result := True
1265   else Result := Boolean(PIntArray(D.fTabStops)^[Index + 1]);
1266 end;
1267 }
1268 function TStGrd.GetTopRow: Longint;
1269 var D: PStGrdData;
1270 begin
1271   D := Pointer(CustomObj);
1272   Result := D.fTopLeft.Y;
1273 end;
1274
1275 function TStGrd.GetVisibleColCount: Integer;
1276 var
1277   DrawInfo: TGridDrawInfo;
1278 begin
1279   CalcDrawInfo(DrawInfo);
1280   Result := DrawInfo.Horz.LastFullVisibleCell - LeftCol + 1;
1281 end;
1282
1283 function TStGrd.GetVisibleRowCount: Integer;
1284 var
1285   DrawInfo: TGridDrawInfo;
1286 begin
1287   CalcDrawInfo(DrawInfo);
1288   Result := DrawInfo.Vert.LastFullVisibleCell - TopRow + 1;
1289 end;
1290
1291 procedure TStGrd.GridRectToScreenRect(GridRect: TGridRect; var ScreenRect: TRect; IncludeLine: Boolean);
1292
1293   function LinePos(const AxisInfo: TGridAxisDrawInfo; Line: Integer): Integer;
1294   var
1295     Start, I: Longint;
1296   begin
1297     with AxisInfo do begin
1298       Result := 0;
1299       if Line < FixedCellCount
1300         then Start := 0
1301         else begin
1302           if Line >= FirstGridCell then
1303             Result := FixedBoundary;
1304           Start := FirstGridCell;
1305         end;
1306       for I := Start to Line - 1 do begin
1307         Inc(Result, GetExtent(I) + EffectiveLineWidth);
1308         if Result > GridExtent then begin
1309           Result := 0;
1310           Exit;
1311         end;
1312       end;
1313     end;
1314   end;
1315
1316   function CalcAxis(const AxisInfo: TGridAxisDrawInfo;
1317     GridRectMin, GridRectMax: Integer;
1318     var ScreenRectMin, ScreenRectMax: Integer): Boolean;
1319   begin
1320     Result := False;
1321     with AxisInfo do begin
1322       if (GridRectMin >= FixedCellCount) and (GridRectMin < FirstGridCell) then
1323         if GridRectMax < FirstGridCell then begin
1324           FillChar(ScreenRect, SizeOf(ScreenRect), 0); { erase partial results }
1325           Exit;
1326         end else
1327           GridRectMin := FirstGridCell;
1328       if GridRectMax > LastFullVisibleCell then begin
1329         GridRectMax := LastFullVisibleCell;
1330         if GridRectMax < GridCellCount - 1 then Inc(GridRectMax);
1331         if LinePos(AxisInfo, GridRectMax) = 0 then
1332           Dec(GridRectMax);
1333       end;
1334
1335       ScreenRectMin := LinePos(AxisInfo, GridRectMin);
1336       ScreenRectMax := LinePos(AxisInfo, GridRectMax);
1337       if ScreenRectMax = 0
1338         then ScreenRectMax := ScreenRectMin + GetExtent(GridRectMin)
1339         else Inc(ScreenRectMax, GetExtent(GridRectMax));
1340       if ScreenRectMax > GridExtent then ScreenRectMax := GridExtent;
1341       if IncludeLine then Inc(ScreenRectMax, EffectiveLineWidth);
1342     end;
1343     Result := True;
1344   end;
1345
1346 var
1347   DrawInfo: TGridDrawInfo;
1348 //  Hold: Integer;
1349 begin
1350   FillChar(ScreenRect, SizeOf(ScreenRect), 0);
1351   if (GridRect.Left > GridRect.Right) or (GridRect.Top > GridRect.Bottom) then Exit;
1352   CalcDrawInfo(DrawInfo);
1353   with DrawInfo do begin
1354     if GridRect.Left > Horz.LastFullVisibleCell + 1 then Exit;
1355     if GridRect.Top > Vert.LastFullVisibleCell + 1 then Exit;
1356
1357     if CalcAxis(Horz, GridRect.Left, GridRect.Right, ScreenRect.Left, ScreenRect.Right) then
1358        CalcAxis(Vert, GridRect.Top, GridRect.Bottom, ScreenRect.Top, ScreenRect.Bottom);
1359   end;
1360
1361 {  if UseRightToLeftAlignment and (Canvas.CanvasOrientation = coLeftToRight) then
1362   begin
1363     Hold := ScreenRect.Left;
1364     ScreenRect.Left := ClientWidth - ScreenRect.Right;
1365     ScreenRect.Right := ClientWidth - Hold;
1366   end;}
1367 end;
1368
1369 procedure TStGrd.InvalidateCell(ACol, ARow: Integer);
1370 var
1371   Rect: TGridRect;
1372 begin
1373   Rect.Top := ARow;
1374   Rect.Left := ACol;
1375   Rect.Bottom := ARow;
1376   Rect.Right := ACol;
1377   InvalidateRect(Rect);
1378 end;
1379
1380 procedure TStGrd.InvalidateRect(ARect: TGridRect);
1381 var
1382   InvalidRect: TRect;
1383 begin
1384   GridRectToScreenRect(ARect, InvalidRect, True);
1385   Windows.InvalidateRect(Handle, @InvalidRect, False);
1386 end;
1387
1388 function TStGrd.IsActiveControl: Boolean;
1389 var
1390   H: Hwnd;
1391   PForm: PControl;
1392 begin
1393   Result := False;
1394   PForm := ParentForm;
1395   if Assigned(PForm) then begin
1396     if (PForm.ActiveControl = @Self) then
1397       Result := True
1398   end else begin
1399     H := GetFocus;
1400     while IsWindow(H) and (Result = False) do begin
1401       if H = PForm.Handle
1402         then Result := True
1403         else H := GetParent(H);
1404     end;
1405   end;
1406 end;
1407
1408 procedure FillDWord(var Dest; Count, Value: Integer); register;
1409 asm
1410   XCHG  EDX, ECX
1411   PUSH  EDI
1412   MOV   EDI, EAX
1413   MOV   EAX, EDX
1414   REP   STOSD
1415   POP   EDI
1416 end;
1417
1418 function StackAlloc(Size: Integer): Pointer; register;
1419 asm
1420   POP   ECX          { return address }
1421   MOV   EDX, ESP
1422   ADD   EAX, 3
1423   AND   EAX, not 3   // round up to keep ESP dword aligned
1424   CMP   EAX, 4092
1425   JLE   @@2
1426 @@1:
1427   SUB   ESP, 4092
1428   PUSH  EAX          { make sure we touch guard page, to grow stack }
1429   SUB   EAX, 4096
1430   JNS   @@1
1431   ADD   EAX, 4096
1432 @@2:
1433   SUB   ESP, EAX
1434   MOV   EAX, ESP     { function result = low memory address of block }
1435   PUSH  EDX          { save original SP, for cleanup }
1436   MOV   EDX, ESP
1437   SUB   EDX, 4
1438   PUSH  EDX          { save current SP, for sanity check  (sp = [sp]) }
1439   PUSH  ECX          { return to caller }
1440 end;
1441
1442 procedure StackFree(P: Pointer); register;
1443 asm
1444   POP   ECX                     { return address }
1445   MOV   EDX, DWORD PTR [ESP]
1446   SUB   EAX, 8
1447   CMP   EDX, ESP                { sanity check #1 (SP = [SP]) }
1448   JNE   @@1
1449   CMP   EDX, EAX                { sanity check #2 (P = this stack block) }
1450   JNE   @@1
1451   MOV   ESP, DWORD PTR [ESP+4]  { restore previous SP  }
1452 @@1:
1453   PUSH  ECX                     { return to caller }
1454 end;
1455
1456 procedure TStGrd.KeyDown(var Key: Integer);
1457 var
1458   NewTopLeft, NewCurrent, MaxTopLeft: TGridCoord;
1459   DrawInfo: TGridDrawInfo;
1460   PageWidth, PageHeight: Integer;
1461 //  RTLFactor: Integer;
1462 //  NeedsInvalidating: Boolean;
1463   D: PStGrdData;
1464
1465   procedure CalcPageExtents;
1466   begin
1467     CalcDrawInfo(DrawInfo);
1468     PageWidth := DrawInfo.Horz.LastFullVisibleCell - LeftCol;
1469     if PageWidth < 1 then PageWidth := 1;
1470     PageHeight := DrawInfo.Vert.LastFullVisibleCell - TopRow;
1471     if PageHeight < 1 then PageHeight := 1;
1472   end;
1473
1474   procedure Restrict(var Coord: TGridCoord; MinX, MinY, MaxX, MaxY: Longint);
1475   begin
1476     with Coord do
1477     begin
1478       if X > MaxX then X := MaxX
1479       else if X < MinX then X := MinX;
1480       if Y > MaxY then Y := MaxY
1481       else if Y < MinY then Y := MinY;
1482     end;
1483   end;
1484
1485 begin
1486   D := Pointer(CustomObj);
1487 //  NeedsInvalidating := False;
1488 //  if not CanGridAcceptKey(Key, Shift) then Key := 0;
1489 {  if not UseRightToLeftAlignment then
1490     RTLFactor := 1
1491   else
1492     RTLFactor := -1;}
1493   NewCurrent := D.fCurrent;
1494   NewTopLeft := D.fTopLeft;
1495   CalcPageExtents;
1496   if (GetAsyncKeyState(vk_Control) < 0) then //ssCtrl in Shift then
1497     case Key of
1498       VK_UP: Dec(NewTopLeft.Y);
1499       VK_DOWN: Inc(NewTopLeft.Y);
1500       VK_LEFT:
1501         if not (goRowSelect in Options) then
1502         begin
1503           Dec(NewCurrent.X, PageWidth);
1504           Dec(NewTopLeft.X, PageWidth);
1505         end;
1506       VK_RIGHT:
1507         if not (goRowSelect in Options) then
1508         begin
1509           Inc(NewCurrent.X, PageWidth);
1510           Inc(NewTopLeft.X, PageWidth);
1511         end;
1512       VK_PRIOR: NewCurrent.Y := TopRow;
1513       VK_NEXT: NewCurrent.Y := DrawInfo.Vert.LastFullVisibleCell;
1514       VK_HOME:
1515         begin
1516           NewCurrent.X := FixedCols;
1517           NewCurrent.Y := FixedRows;
1518         end;
1519       VK_END:
1520         begin
1521           NewCurrent.X := ColCount - 1;
1522           NewCurrent.Y := RowCount - 1;
1523         end;
1524     end
1525   else
1526     case Key of
1527       VK_UP: Dec(NewCurrent.Y);
1528       VK_DOWN: Inc(NewCurrent.Y);
1529       VK_LEFT:
1530         if goRowSelect in D.fOptions then
1531           Dec(NewCurrent.Y) else
1532           Dec(NewCurrent.X);
1533       VK_RIGHT:
1534         if goRowSelect in D.fOptions then
1535           Inc(NewCurrent.Y) else
1536           Inc(NewCurrent.X);
1537       VK_NEXT:
1538         begin
1539           Inc(NewCurrent.Y, PageHeight);
1540           Inc(NewTopLeft.Y, PageHeight);
1541         end;
1542       VK_PRIOR:
1543         begin
1544           Dec(NewCurrent.Y, PageHeight);
1545           Dec(NewTopLeft.Y, PageHeight);
1546         end;
1547       VK_HOME:
1548         if goRowSelect in D.fOptions then
1549           NewCurrent.Y := D.fFixedRows else
1550           NewCurrent.X := D.fFixedCols;
1551       VK_END:
1552         if goRowSelect in D.fOptions then
1553           NewCurrent.Y := D.fRowCount - 1 else
1554           NewCurrent.X := D.fColCount - 1;
1555 {      VK_TAB:
1556         if not (ssAlt in Shift) then
1557         repeat
1558           if ssShift in Shift then
1559           begin
1560             Dec(NewCurrent.X);
1561             if NewCurrent.X < FixedCols then
1562             begin
1563               NewCurrent.X := ColCount - 1;
1564               Dec(NewCurrent.Y);
1565               if NewCurrent.Y < FixedRows then NewCurrent.Y := RowCount - 1;
1566             end;
1567             Shift := [];
1568           end
1569           else
1570           begin
1571             Inc(NewCurrent.X);
1572             if NewCurrent.X >= D.fColCount then
1573             begin
1574               NewCurrent.X := D.fFixedCols;
1575               Inc(NewCurrent.Y);
1576               if NewCurrent.Y >= RowCount then NewCurrent.Y := D.fFixedRows;
1577             end;
1578           end;
1579         until TabStops[NewCurrent.X] or (NewCurrent.X = D.fCurrent.X);}
1580 //      VK_F2: EditorMode := True;
1581     end;
1582   MaxTopLeft.X := D.fColCount - 1;
1583   MaxTopLeft.Y := D.fRowCount - 1;
1584   MaxTopLeft := CalcMaxTopLeft(MaxTopLeft, DrawInfo);
1585   Restrict(NewTopLeft, D.fFixedCols, D.fFixedRows, MaxTopLeft.X, MaxTopLeft.Y);
1586   if (NewTopLeft.X <> LeftCol) or (NewTopLeft.Y <> TopRow) then
1587     MoveTopLeft(NewTopLeft.X, NewTopLeft.Y);
1588   Restrict(NewCurrent, D.fFixedCols, D.fFixedRows, D.fColCount - 1, D.fRowCount - 1);
1589   if (NewCurrent.X <> D.fCurrent.X) or (NewCurrent.Y <> D.fCurrent.Y) then
1590     FocusCell(NewCurrent.X, NewCurrent.Y, not (GetAsyncKeyState(vk_Shift) < 0){(ssShift in Shift)});
1591 //  if NeedsInvalidating then Invalidate;
1592 end;
1593
1594 procedure TStGrd.ModifyScrollBar(ScrollBar, ScrollCode, Pos: Cardinal; UseRightToLeft: Boolean);
1595 var
1596   NewTopLeft, MaxTopLeft: TGridCoord;
1597   DrawInfo: TGridDrawInfo;
1598 //  RTLFactor: Integer;
1599   D: PStGrdData;
1600
1601   function Min: Longint;
1602   begin
1603     if ScrollBar = SB_HORZ then Result := FixedCols
1604     else Result := FixedRows;
1605   end;
1606
1607   function Max: Longint;
1608   begin
1609     if ScrollBar = SB_HORZ then Result := MaxTopLeft.X
1610     else Result := MaxTopLeft.Y;
1611   end;
1612
1613   function PageUp: Longint;
1614   var
1615     MaxTopLeft: TGridCoord;
1616   begin
1617     MaxTopLeft := CalcMaxTopLeft(D.fTopLeft, DrawInfo);
1618     if ScrollBar = SB_HORZ then
1619       Result := D.fTopLeft.X - MaxTopLeft.X else
1620       Result := D.fTopLeft.Y - MaxTopLeft.Y;
1621     if Result < 1 then Result := 1;
1622   end;
1623
1624   function PageDown: Longint;
1625   var
1626     DrawInfo: TGridDrawInfo;
1627   begin
1628     CalcDrawInfo(DrawInfo);
1629     with DrawInfo do
1630       if ScrollBar = SB_HORZ then
1631         Result := Horz.LastFullVisibleCell - D.fTopLeft.X else
1632         Result := Vert.LastFullVisibleCell - D.fTopLeft.Y;
1633     if Result < 1 then Result := 1;
1634   end;
1635
1636   function CalcScrollBar(Value{, ARTLFactor}: Longint): Longint;
1637   begin
1638     Result := Value;
1639     case ScrollCode of
1640       SB_LINEUP:
1641         Dec(Result{, ARTLFactor});
1642       SB_LINEDOWN:
1643         Inc(Result{, ARTLFactor});
1644       SB_PAGEUP:
1645         Dec(Result, PageUp{ * ARTLFactor});
1646       SB_PAGEDOWN:
1647         Inc(Result, PageDown{ * ARTLFactor});
1648       SB_THUMBPOSITION, SB_THUMBTRACK:
1649         if (goThumbTracking in Options) or (ScrollCode = SB_THUMBPOSITION) then
1650         begin
1651 //          if (not UseRightToLeftAlignment) or (ARTLFactor = 1) then
1652             Result := Min + LongMulDiv(Pos, Max - Min, MaxShortInt)
1653 //          else
1654 //            Result := Max - LongMulDiv(Pos, Max - Min, MaxShortInt);
1655         end;
1656       SB_BOTTOM:
1657         Result := Max;
1658       SB_TOP:
1659         Result := Min;
1660     end;
1661   end;
1662
1663   procedure ModifyPixelScrollBar(Code, Pos: Cardinal);
1664   var
1665     NewOffset: Integer;
1666     OldOffset: Integer;
1667     R: TGridRect;
1668     GridSpace, ColWidth: Integer;
1669   begin
1670     NewOffset := D.fColOffset;
1671     ColWidth := ColWidths[DrawInfo.Horz.FirstGridCell];
1672     GridSpace := ClientWidth - DrawInfo.Horz.FixedBoundary;
1673     case Code of
1674       SB_LINEUP: Dec(NewOffset, Canvas.TextWidth('0') {* RTLFactor});
1675       SB_LINEDOWN: Inc(NewOffset, Canvas.TextWidth('0') {* RTLFactor});
1676       SB_PAGEUP: Dec(NewOffset, GridSpace {* RTLFactor});
1677       SB_PAGEDOWN: Inc(NewOffset, GridSpace {* RTLFactor});
1678       SB_THUMBPOSITION,
1679       SB_THUMBTRACK:
1680         if (goThumbTracking in Options) or (Code = SB_THUMBPOSITION) then
1681 //        begin
1682 //          if not UseRightToLeftAlignment then
1683             NewOffset := Pos;
1684 //          else
1685 //            NewOffset := Max - Integer(Pos);
1686 //        end;
1687       SB_BOTTOM: NewOffset := 0;
1688       SB_TOP: NewOffset := ColWidth - GridSpace;
1689     end;
1690     if NewOffset < 0 then
1691       NewOffset := 0
1692     else if NewOffset >= ColWidth - GridSpace then
1693       NewOffset := ColWidth - GridSpace;
1694     if NewOffset <> D.fColOffset then
1695     begin
1696       OldOffset := D.fColOffset;
1697       D.fColOffset := NewOffset;
1698       ScrollData(OldOffset - NewOffset, 0);
1699       FillChar(R, SizeOf(R), 0);
1700       R.Bottom := FixedRows;
1701       InvalidateRect(R);
1702       Update;
1703       UpdateScrollPos;
1704     end;
1705   end;
1706
1707 var
1708   Temp: Longint;
1709 begin
1710   D := Pointer(CustomObj);
1711 //  if (not UseRightToLeftAlignment) or (not UseRightToLeft) then
1712 //    RTLFactor := 1
1713 //  else
1714 //    RTLFactor := -1;
1715   if Visible and {CanFocus and} TabStop {and not (csDesigning in ComponentState)} then
1716     SetFocused(True);
1717   CalcDrawInfo(DrawInfo);
1718   if (ScrollBar = SB_HORZ) and (ColCount = 1) then
1719   begin
1720     ModifyPixelScrollBar(ScrollCode, Pos);
1721     Exit;
1722   end;
1723   MaxTopLeft.X := ColCount - 1;
1724   MaxTopLeft.Y := RowCount - 1;
1725   MaxTopLeft := CalcMaxTopLeft(MaxTopLeft, DrawInfo);
1726   NewTopLeft := D.fTopLeft;
1727   if ScrollBar = SB_HORZ then
1728     repeat
1729       Temp := NewTopLeft.X;
1730       NewTopLeft.X := CalcScrollBar(NewTopLeft.X{, RTLFactor});
1731     until (NewTopLeft.X <= D.fFixedCols) or (NewTopLeft.X >= MaxTopLeft.X)
1732       or (ColWidths[NewTopLeft.X] > 0) or (Temp = NewTopLeft.X)
1733   else
1734     repeat
1735       Temp := NewTopLeft.Y;
1736       NewTopLeft.Y := CalcScrollBar(NewTopLeft.Y{, 1});
1737     until (NewTopLeft.Y <= D.fFixedRows) or (NewTopLeft.Y >= MaxTopLeft.Y)
1738       or (RowHeights[NewTopLeft.Y] > 0) or (Temp = NewTopLeft.Y);
1739   NewTopLeft.X := KOLMath.Max(D.fFixedCols, KOLMath.Min(MaxTopLeft.X, NewTopLeft.X));
1740   NewTopLeft.Y := KOLMath.Max(D.fFixedRows, KOLMath.Min(MaxTopLeft.Y, NewTopLeft.Y));
1741   if (NewTopLeft.X <> D.fTopLeft.X) or (NewTopLeft.Y <> D.fTopLeft.Y) then
1742     MoveTopLeft(NewTopLeft.X, NewTopLeft.Y);
1743 end;
1744
1745 procedure TStGrd.MouseDown(X, Y: Integer);
1746 var
1747   CellHit: TGridCoord;
1748   DrawInfo: TGridDrawInfo;
1749 //  MoveDrawn: Boolean;
1750   D: PStGrdData;
1751 begin
1752   D := Pointer(CustomObj);
1753 //  MoveDrawn := False;
1754 //  HideEdit;
1755 //  if not (csDesigning in ComponentState) and
1756 //    (CanFocus or (GetParentForm(Self) = nil)) then
1757 //  begin
1758     SetFocused(True);
1759 //    if not IsActiveControl then
1760 //    begin
1761 //      MouseCapture := False;
1762 //      Exit;
1763 //    end;
1764 //  end;
1765 //  if (Button = mbLeft) and (ssDouble in Shift) then
1766 //    DblClick
1767 //  else if Button = mbLeft then
1768   begin
1769     CalcDrawInfo(DrawInfo);
1770     { Check grid sizing }
1771     CalcSizingState(X, Y, D.fGridState, D.fSizingIndex, D.fSizingPos, D.fSizingOfs, DrawInfo);
1772     if D.fGridState <> gsNormal then
1773     begin
1774 //      if (D.fGridState = gsColSizing) and UseRightToLeftAlignment then
1775 //        FSizingPos := ClientWidth - FSizingPos;
1776       DrawSizingLine(DrawInfo);
1777       Exit;
1778     end;
1779     CellHit := CalcCoordFromPoint(X, Y, DrawInfo);
1780     if (CellHit.X >= D.fFixedCols) and (CellHit.Y >= D.fFixedRows) then begin
1781       if goEditing in Options then begin
1782         if (CellHit.X = D.fCurrent.X) and (CellHit.Y = D.fCurrent.Y) then
1783 //          ShowEditor
1784         else begin
1785           MoveCurrent(CellHit.X, CellHit.Y, True, True);
1786 //          UpdateEdit;
1787         end;
1788 //        Click;
1789       end else begin
1790         D.fGridState := gsSelecting;
1791         SetTimer(Handle, 1, 60, nil);
1792         if (GetAsyncKeyState(vk_Shift) < 0) then
1793           MoveAnchor(CellHit)
1794         else
1795           MoveCurrent(CellHit.X, CellHit.Y, True, True);
1796       end;
1797     end else if (goRowMoving in D.fOptions) and (CellHit.X >= 0) and
1798       (CellHit.X < D.fFixedCols) and (CellHit.Y >= D.fFixedRows) then begin
1799       D.fMoveIndex := CellHit.Y;
1800       D.fMovePos := D.fMoveIndex;
1801 //      if BeginRowDrag(FMoveIndex, FMovePos, Point(X,Y)) then
1802       begin
1803         D.fGridState := gsRowMoving;
1804         Update;
1805         DrawMove;
1806 //        MoveDrawn := True;
1807         SetTimer(Handle, 1, 60, nil);
1808       end;
1809     end else if (goColMoving in D.fOptions) and (CellHit.Y >= 0) and
1810       (CellHit.Y < D.fFixedRows) and (CellHit.X >= D.fFixedCols) then begin
1811       D.fMoveIndex := CellHit.X;
1812       D.fMovePos := D.fMoveIndex;
1813 //      if BeginColumnDrag(FMoveIndex, FMovePos, Point(X,Y)) then
1814 //      begin
1815         D.fGridState := gsColMoving;
1816         Update;
1817         DrawMove;
1818 //        MoveDrawn := True;
1819         SetTimer(Handle, 1, 60, nil);
1820 //      end;
1821     end;
1822   end;
1823 //  try
1824 //    inherited MouseDown(Button, Shift, X, Y);
1825 //  except
1826 //    if MoveDrawn then DrawMove;
1827 //  end;
1828 end;
1829
1830 procedure TStGrd.MouseMove(X, Y: Integer);
1831 var
1832   DrawInfo: TGridDrawInfo;
1833   CellHit: TGridCoord;
1834   D: PStGrdData;
1835 begin
1836   D := Pointer(CustomObj);
1837   CalcDrawInfo(DrawInfo);
1838   case D.fGridState of
1839     gsSelecting, gsColMoving, gsRowMoving:
1840       begin
1841         CellHit := CalcCoordFromPoint(X, Y, DrawInfo);
1842         if (CellHit.X >= D.fFixedCols) and (CellHit.Y >= D.fFixedRows) and
1843           (CellHit.X <= DrawInfo.Horz.LastFullVisibleCell+1) and
1844           (CellHit.Y <= DrawInfo.Vert.LastFullVisibleCell+1) then
1845           case D.fGridState of
1846             gsSelecting:
1847               if ((CellHit.X <> D.fAnchor.X) or (CellHit.Y <> D.fAnchor.Y)) then
1848                 MoveAnchor(CellHit);
1849             gsColMoving:
1850               MoveAndScroll(X, CellHit.X, DrawInfo, DrawInfo.Horz, SB_HORZ, MakePoint(X,Y));
1851             gsRowMoving:
1852               MoveAndScroll(Y, CellHit.Y, DrawInfo, DrawInfo.Vert, SB_VERT, MakePoint(X,Y));
1853           end;
1854       end;
1855     gsRowSizing, gsColSizing:
1856       begin
1857         DrawSizingLine(DrawInfo); { XOR it out }
1858         if D.fGridState = gsRowSizing then
1859           D.fSizingPos := Y + D.fSizingOfs else
1860           D.fSizingPos := X + D.fSizingOfs;
1861         DrawSizingLine(DrawInfo); { XOR it back in }
1862       end;
1863   end;
1864 //  inherited MouseMove(Shift, X, Y);
1865 end;
1866
1867 procedure TStGrd.MouseUp(X, Y: Integer);
1868 var
1869   DrawInfo: TGridDrawInfo;
1870   NewSize: Integer;
1871   D: PStGrdData;
1872
1873   function ResizeLine(const AxisInfo: TGridAxisDrawInfo): Integer;
1874   var
1875     I: Integer;
1876   begin
1877     with AxisInfo do
1878     begin
1879       Result := FixedBoundary;
1880       for I := FirstGridCell to D.fSizingIndex - 1 do
1881         Inc(Result, GetExtent(I) + EffectiveLineWidth);
1882       Result := D.fSizingPos - Result;
1883     end;
1884   end;
1885
1886 begin
1887   D := Pointer(CustomObj);
1888   try
1889     case D.fGridState of
1890       gsSelecting:
1891         begin
1892           MouseMove({Shift,} X, Y);
1893           KillTimer(Handle, 1);
1894 //          UpdateEdit;
1895           if Assigned(OnClick) then OnClick(@self);
1896         end;
1897       gsRowSizing, gsColSizing:
1898         begin
1899           CalcDrawInfo(DrawInfo);
1900           DrawSizingLine(DrawInfo);
1901 //          if (D.fGridState = gsColSizing) and UseRightToLeftAlignment then
1902 //            D.fSizingPos := ClientWidth - D.fSizingPos;
1903           if D.fGridState = gsColSizing then begin
1904             NewSize := ResizeLine(DrawInfo.Horz);
1905             if (NewSize > 1) then ColWidths[D.fSizingIndex] := NewSize;
1906           end else begin
1907             NewSize := ResizeLine(DrawInfo.Vert);
1908             if (NewSize > 1) then RowHeights[D.fSizingIndex] := NewSize;
1909           end;
1910         end;
1911       gsColMoving:
1912         begin
1913           DrawMove;
1914           KillTimer(Handle, 1);
1915           if //EndColumnDrag(FMoveIndex, FMovePos, Point(X,Y)) and
1916             (D.fMoveIndex <> D.fMovePos) then
1917           begin
1918             MoveColumn(D.fMoveIndex, D.fMovePos);
1919 //            UpdateDesigner;
1920           end;
1921 //          UpdateEdit;
1922         end;
1923       gsRowMoving:
1924         begin
1925           DrawMove;
1926           KillTimer(Handle, 1);
1927           if //EndRowDrag(FMoveIndex, FMovePos, Point(X,Y)) and
1928             (D.fMoveIndex <> D.fMovePos) then
1929           begin
1930             MoveRow(D.fMoveIndex, D.fMovePos);
1931 //            UpdateDesigner;
1932           end;
1933 //          UpdateEdit;
1934         end;
1935     else
1936 //      UpdateEdit;
1937     end;
1938 //    inherited MouseUp(Button, Shift, X, Y);
1939   finally
1940     D.fGridState := gsNormal;
1941   end;
1942 //  invalidate;
1943 end;
1944
1945 procedure TStGrd.MoveAdjust(var CellPos: Integer; FromIndex, ToIndex: Integer);
1946 var
1947   Min, Max: Longint;
1948 begin
1949   if CellPos = FromIndex then CellPos := ToIndex
1950   else
1951   begin
1952     Min := FromIndex;
1953     Max := ToIndex;
1954     if FromIndex > ToIndex then
1955     begin
1956       Min := ToIndex;
1957       Max := FromIndex;
1958     end;
1959     if (CellPos >= Min) and (CellPos <= Max) then
1960       if FromIndex > ToIndex then
1961         Inc(CellPos) else
1962         Dec(CellPos);
1963   end;
1964 end;
1965
1966 procedure TStGrd.MoveAnchor(const NewAnchor: TGridCoord);
1967 var
1968   OldSel: TGridRect;
1969   D: PStGrdData;
1970 begin
1971   D := Pointer(CustomObj);
1972   if [goRangeSelect, goEditing] * D.fOptions = [goRangeSelect] then begin
1973     OldSel := Selection;
1974     D.fAnchor := NewAnchor;
1975     if goRowSelect in D.fOptions then D.fAnchor.X := D.fColCount - 1;
1976     ClampInView(NewAnchor);
1977     SelectionMoved(OldSel);
1978   end
1979   else MoveCurrent(NewAnchor.X, NewAnchor.Y, True, True);
1980 end;
1981
1982 procedure TStGrd.MoveAndScroll(Mouse, CellHit: Integer; var DrawInfo: TGridDrawInfo;
1983   var Axis: TGridAxisDrawInfo; Scrollbar: Integer; const MousePt: TPoint);
1984 var D: PStGrdData;
1985 begin
1986   D := Pointer(CustomObj);
1987 //  if UseRightToLeftAlignment and (ScrollBar = SB_HORZ) then
1988 //    Mouse := ClientWidth - Mouse;
1989   if (CellHit <> D.fMovePos) and
1990     not((D.fMovePos = Axis.FixedCellCount) and (Mouse < Axis.FixedBoundary)) and
1991     not((D.fMovePos = Axis.GridCellCount-1) and (Mouse > Axis.GridBoundary)) then
1992   begin
1993     DrawMove;
1994     if (Mouse < Axis.FixedBoundary) then
1995     begin
1996       if (D.fMovePos > Axis.FixedCellCount) then
1997       begin
1998         ModifyScrollbar(ScrollBar, SB_LINEUP, 0, False);
1999         Update;
2000         CalcDrawInfo(DrawInfo);
2001       end;
2002       CellHit := Axis.FirstGridCell;
2003     end
2004     else if (Mouse >= Axis.FullVisBoundary) then
2005     begin
2006       if (D.fMovePos = Axis.LastFullVisibleCell) and
2007         (D.fMovePos < Axis.GridCellCount -1) then
2008       begin
2009         ModifyScrollBar(Scrollbar, SB_LINEDOWN, 0, False);
2010         Update;
2011         CalcDrawInfo(DrawInfo);
2012       end;
2013       CellHit := Axis.LastFullVisibleCell;
2014     end
2015     else if CellHit < 0 then CellHit := D.fMovePos;
2016     if {(}(D.fGridState = gsColMoving) {and CheckColumnDrag(D.fMoveIndex, CellHit, MousePt))}
2017       or {(}(D.fGridState = gsRowMoving) {and CheckRowDrag(D.fMoveIndex, CellHit, MousePt))} then
2018       D.fMovePos := CellHit;
2019     DrawMove;
2020   end;
2021 end;
2022
2023 procedure TStGrd.MoveColumn(FromIndex, ToIndex: Integer);
2024 var
2025   Rect: TGridRect;
2026   D: PStGrdData;
2027   S: PStrList;
2028   i: Longint;
2029 begin
2030   if FromIndex = ToIndex then Exit;
2031   D := Pointer(CustomObj);
2032   if Assigned(D.fColWidths) then
2033   begin
2034     MoveExtent(D.fColWidths, FromIndex + 1, ToIndex + 1);
2035 //    MoveExtent(D.fTabStops, FromIndex + 1, ToIndex + 1);
2036   end;
2037   MoveAdjust(D.fCurrent.X, FromIndex, ToIndex);
2038   MoveAdjust(D.fAnchor.X, FromIndex, ToIndex);
2039 //  MoveAdjust(FInplaceCol, FromIndex, ToIndex);
2040   Rect.Top := 0;
2041   Rect.Bottom := VisibleRowCount;
2042   if FromIndex < ToIndex then
2043   begin
2044     Rect.Left := FromIndex;
2045     Rect.Right := ToIndex;
2046   end
2047   else
2048   begin
2049     Rect.Left := ToIndex;
2050     Rect.Right := FromIndex;
2051   end;
2052
2053   S := NewStrList;
2054   S.Assign(PStrListArray(D.fCells)^[FromIndex]);
2055   if FromIndex < ToIndex
2056     then for i := FromIndex to ToIndex-1 do PStrListArray(D.fCells)^[i].Assign(PStrListArray(D.fCells)^[i+1])
2057     else for i := FromIndex downto ToIndex+1 do PStrListArray(D.fCells)^[i].Assign(PStrListArray(D.fCells)^[i-1]);
2058   PStrListArray(D.fCells)^[ToIndex].Assign(S);
2059   S.Free;
2060
2061   InvalidateRect(Rect);
2062 //  ColumnMoved(FromIndex, ToIndex);
2063   if Assigned(D.fColWidths) then
2064     UpdateScrollRange;//ColWidthsChanged;
2065 //  UpdateEdit;
2066 end;
2067
2068 procedure TStGrd.MoveCurrent(ACol, ARow: Integer; _MoveAnchor, _Show: Boolean);
2069 var
2070   OldSel: TGridRect;
2071   OldCurrent: TGridCoord;
2072   D: PStGrdData;
2073 begin
2074   D := Pointer(CustomObj);
2075   if (ACol < 0) or (ARow < 0) or (ACol >= d.fColCount) or (ARow >= d.fRowCount) then
2076     exit;//InvalidOp(SIndexOutOfRange);
2077   if SelectCell(ACol, ARow) then begin
2078     OldSel := Selection;
2079     OldCurrent := d.fCurrent;
2080     d.fCurrent.X := ACol;
2081     d.fCurrent.Y := ARow;
2082 //    if not (goAlwaysShowEditor in d.fOptions) then HideEditor;
2083     if _MoveAnchor or not (goRangeSelect in d.fOptions) then begin
2084       d.fAnchor := d.fCurrent;
2085       if goRowSelect in d.fOptions then d.fAnchor.X := d.fColCount - 1;
2086     end;
2087     if goRowSelect in d.fOptions then d.fCurrent.X := d.fFixedCols;
2088     if _Show then ClampInView(d.fCurrent);
2089     SelectionMoved(OldSel);
2090     with OldCurrent do InvalidateCell(X,Y);
2091     with d.fCurrent do InvalidateCell(X,Y);
2092   end;
2093 end;
2094
2095 procedure TStGrd.MoveRow(FromIndex, ToIndex: Integer);
2096 var Rect: tGridRect;
2097     D: PStGrdData;
2098     S: PStrList;
2099     i,j: Longint;
2100 begin
2101   D := Pointer(CustomObj);
2102   if Assigned(D.fRowHeights) then
2103     MoveExtent(D.fRowHeights, FromIndex + 1, ToIndex + 1);
2104   MoveAdjust(D.fCurrent.Y, FromIndex, ToIndex);
2105   MoveAdjust(D.fAnchor.Y, FromIndex, ToIndex);
2106
2107   S := NewStrList;
2108   S.Clear;
2109   for i := 0 to D.fColCount-1 do S.Add(PStrListArray(D.fCells)^[i].Items[FromIndex]);
2110   if FromIndex < ToIndex
2111     then for i := FromIndex to ToIndex-1 do
2112       for j := 0 to D.fColCount-1 do PStrListArray(D.fCells)^[j].Items[i] := PStrListArray(D.fCells)^[j].Items[i+1]
2113     else for i := FromIndex downto ToIndex+1 do
2114       for j := 0 to D.fColCount-1 do PStrListArray(D.fCells)^[j].Items[i] := PStrListArray(D.fCells)^[j].Items[i-1];
2115   for i := 0 to D.fColCount-1 do PStrListArray(D.fCells)^[i].Items[ToIndex] := S.Items[i];
2116   S.Free;
2117
2118   Rect.Left := 0;
2119   Rect.Right := VisibleColCount;
2120   if FromIndex < ToIndex then begin
2121     Rect.Top := FromIndex;
2122     Rect.Bottom := ToIndex;
2123   end else begin
2124     Rect.Top := ToIndex;
2125     Rect.Bottom := FromIndex;
2126   end;
2127
2128   InvalidateRect(Rect);
2129 //  MoveAdjust(D.fInplaceRow, FromIndex, ToIndex);
2130 //  RowMoved(FromIndex, ToIndex);
2131   if Assigned(D.fRowHeights) then
2132     UpdateScrollRange;//RowHeightsChanged;
2133 //  UpdateEdit;
2134 end;
2135
2136 procedure TStGrd.MoveTopLeft(ALeft, ATop: Integer);
2137 var
2138   OldTopLeft: TGridCoord;
2139   D: PStGrdData;
2140 begin
2141   D := PStGrdData(CustomObj);
2142   if (ALeft = D.fTopLeft.X) and (ATop = D.fTopLeft.Y) then Exit;
2143   Update;
2144   OldTopLeft := D.fTopLeft;
2145   D.fTopLeft.X := ALeft;
2146   D.fTopLeft.Y := ATop;
2147   TopLeftMoved(OldTopLeft);
2148 end;
2149
2150 procedure TStGrd.Paint(DC: HDC);
2151 var
2152   LineColor: TColor;
2153   DrawInfo: TGridDrawInfo;
2154   Sel: TGridRect;
2155   UpdateRect: TRect;
2156   {AFocRect,} FocRect: TRect;
2157   PointsList: PIntArray;
2158   StrokeList: PIntArray;
2159   MaxStroke: Integer;
2160   FrameFlags1, FrameFlags2: DWORD;
2161   D: PStGrdData;
2162
2163 //  r: TRect;
2164   tmDC, tmBmp, tmObj: Cardinal;
2165   c: PCanvas;
2166
2167   procedure DrawLines(DoHorz, DoVert: Boolean; Col, Row: Longint; const CellBounds: array of Integer; OnColor, OffColor: TColor);
2168 //  const
2169 //    FlatPenStyle = PS_Geometric or PS_Solid or PS_EndCap_Flat or PS_Join_Miter;
2170
2171     procedure DrawAxisLines(const AxisInfo: TGridAxisDrawInfo; Cell, MajorIndex: Integer; UseOnColor: Boolean);
2172     var
2173       Line: Integer;
2174 //      LogBrush: TLOGBRUSH;
2175       Index: Integer;
2176       Points: PIntArray;
2177       StopMajor, StartMinor, StopMinor, StopIndex: Integer;
2178       LineIncr: Integer;
2179     begin
2180       with c^, AxisInfo do begin
2181         if (EffectiveLineWidth <> 0) then begin
2182           Pen.PenWidth := GridLineWidth;
2183           if UseOnColor then
2184             Pen.Color := OnColor
2185           else
2186             Pen.Color := OffColor;
2187           MoveTo(0,0); LineTo(0,0);
2188 {          if Pen.Width > 1 then
2189           begin
2190             LogBrush.lbStyle := BS_Solid;
2191             LogBrush.lbColor := Pen.Color;
2192             LogBrush.lbHatch := 0;
2193             Pen.Handle := ExtCreatePen(FlatPenStyle, Pen.Width, LogBrush, 0, nil);
2194           end;}
2195           Points := PointsList;
2196           Line := CellBounds[MajorIndex] + EffectiveLineWidth shr 1 + GetExtent(Cell);
2197           //!!! ??? Line needs to be incremented for RightToLeftAlignment ???
2198 //          if UseRightToLeftAlignment and (MajorIndex = 0) then Inc(Line);
2199           StartMinor := CellBounds[MajorIndex xor 1];
2200           StopMinor := CellBounds[2 + (MajorIndex xor 1)];
2201           StopMajor := CellBounds[2 + MajorIndex] + EffectiveLineWidth;
2202           StopIndex := MaxStroke * 4;
2203           Index := 0;
2204           repeat
2205             Points^[Index + MajorIndex] := Line;         { MoveTo }
2206             Points^[Index + (MajorIndex xor 1)] := StartMinor;
2207             Inc(Index, 2);
2208             Points^[Index + MajorIndex] := Line;         { LineTo }
2209             Points^[Index + (MajorIndex xor 1)] := StopMinor;
2210             Inc(Index, 2);
2211             // Skip hidden columns/rows.  We don't have stroke slots for them
2212             // A column/row with an extent of -EffectiveLineWidth is hidden
2213             repeat
2214               Inc(Cell);
2215               LineIncr := GetExtent(Cell) + EffectiveLineWidth;
2216             until (LineIncr > 0) or (Cell > LastFullVisibleCell);
2217             Inc(Line, LineIncr);
2218           until (Line > StopMajor) or (Cell > LastFullVisibleCell) or (Index > StopIndex);
2219            { 2 integers per point, 2 points per line -> Index div 4 }
2220           PolyPolyLine(Handle, Points^, StrokeList^, Index shr 2);
2221         end;
2222       end;
2223     end;
2224
2225   begin
2226     if (CellBounds[0] = CellBounds[2]) or (CellBounds[1] = CellBounds[3]) then Exit;
2227     if not DoHorz then begin
2228       DrawAxisLines(DrawInfo.Vert, Row, 1, DoHorz);
2229       DrawAxisLines(DrawInfo.Horz, Col, 0, DoVert);
2230     end else begin
2231       DrawAxisLines(DrawInfo.Horz, Col, 0, DoVert);
2232       DrawAxisLines(DrawInfo.Vert, Row, 1, DoHorz);
2233     end;
2234   end;
2235
2236   procedure DrawCells(ACol, ARow: Longint; StartX, StartY, StopX, StopY: Integer; Color: TColor; IncludeDrawState: TGridDrawState);
2237   var
2238     CurCol, CurRow: Longint;
2239     {AWhere,} Where, TempRect: TRect;
2240     DrawState: TGridDrawState;
2241     Focused: Boolean;
2242     s: string;
2243   begin
2244     CurRow := ARow;
2245     Where.Top := StartY;
2246     while (Where.Top < StopY) and (CurRow < d.fRowCount) do begin
2247       CurCol := ACol;
2248       Where.Left := StartX;
2249       Where.Bottom := Where.Top + RowHeights[CurRow];
2250       while (Where.Left < StopX) and (CurCol < ColCount) do begin
2251         Where.Right := Where.Left + ColWidths[CurCol];
2252         if (Where.Right > Where.Left) and RectVisible(c.Handle, Where) then begin
2253           DrawState := IncludeDrawState;
2254           Focused := IsActiveControl;
2255           if Focused and (CurRow = Row) and (CurCol = Col) then
2256             Include(DrawState, gdFocused);
2257           if PointInGridRect(CurCol, CurRow, Sel) then
2258             Include(DrawState, gdSelected);
2259 //          if not (gdFocused in DrawState) or not (goEditing in Options) {or not FEditorMode} then begin
2260             if d.fDefaultDrawing then with c^ do begin
2261               Font.Assign(Self.Font);
2262               if (gdSelected in DrawState) and
2263                 (not (gdFocused in DrawState) or
2264                 ([goDrawFocusSelected, goRowSelect] * d.fOptions <> [])) then
2265               begin
2266                 Brush.Color := clHighlight;
2267                 Font.Color := clHighlightText;
2268               end else
2269                 Brush.Color := Color;
2270               FillRect(Where);
2271
2272               TempRect := Where;
2273               InflateRect(TempRect,-2,-2);
2274               s := Cells[CurCol,CurRow];
2275               if (s <> '') and (TempRect.Right-TempRect.Left > 4) and (TempRect.Bottom-TempRect.Top > 4) then begin
2276                 SelectObject(c.Handle,Font.Handle);
2277                 Windows.DrawText(c.Handle,pChar(s),length(s),TempRect,dt_SingleLine);
2278               end;
2279 //              TempRect := Where;
2280 //              InflateRect(TempRect,-2,-2);
2281 //              if () and () then
2282 //                TextRect(TempRect,TempRect.Left,TempRect.Top,Cells[CurCol,CurRow]);
2283             end else
2284               DrawCell(c, CurCol, CurRow, Where, DrawState);
2285             if d.fDefaultDrawing and (gdFixed in DrawState) and d.fCtl3D and
2286               ((FrameFlags1 or FrameFlags2) <> 0) then
2287             begin
2288               TempRect := Where;
2289               if (FrameFlags1 and BF_RIGHT) = 0
2290                 then Inc(TempRect.Right, DrawInfo.Horz.EffectiveLineWidth)
2291                 else if (FrameFlags1 and BF_BOTTOM) = 0
2292                   then Inc(TempRect.Bottom, DrawInfo.Vert.EffectiveLineWidth);
2293               DrawEdge(c.Handle, TempRect, BDR_RAISEDINNER, FrameFlags2);
2294               DrawEdge(c.Handle, TempRect, BDR_RAISEDINNER, FrameFlags1);
2295             end;
2296
2297             if d.fDefaultDrawing and
2298               (gdFocused in DrawState)// and
2299 //              ([goEditing, goAlwaysShowEditor] * d.fOptions <>
2300 //              [goEditing, goAlwaysShowEditor])
2301               and not (goRowSelect in d.fOptions) then
2302               c.DrawFocusRect(Where);// DrawFocusRect(c.Handle, Where)
2303 //          end;
2304         end;
2305         Where.Left := Where.Right + DrawInfo.Horz.EffectiveLineWidth;
2306         Inc(CurCol);
2307       end;
2308       Where.Top := Where.Bottom + DrawInfo.Vert.EffectiveLineWidth;
2309       Inc(CurRow);
2310     end;
2311   end;
2312
2313
2314 begin
2315   {GetClientRect(Handle,r); //}//r := MakeRect(0,0,ClientWidth,ClientHeight);
2316   UpdateRect := Canvas.ClipRect;
2317
2318   tmDC := CreateCompatibleDC(DC);
2319   tmBmp := CreateCompatibleBitmap(DC,UpdateRect.Right,UpdateRect.Bottom);
2320   tmObj := SelectObject(tmDC,tmBmp);
2321   c := NewCanvas(tmDC);
2322
2323 //  if UseRightToLeftAlignment then ChangeGridOrientation(True);
2324
2325   D := Pointer(CustomObj);
2326   CalcDrawInfo(DrawInfo);
2327   with DrawInfo do begin
2328     if (Horz.EffectiveLineWidth > 0) or (Vert.EffectiveLineWidth > 0) then begin
2329       LineColor := clSilver;
2330       MaxStroke := Max(Horz.LastFullVisibleCell - d.fTopLeft.X + d.fFixedCols,
2331                         Vert.LastFullVisibleCell - d.fTopLeft.Y + d.fFixedRows) + 3;
2332       PointsList := StackAlloc(MaxStroke * sizeof(TPoint) * 2);
2333       StrokeList := StackAlloc(MaxStroke * sizeof(Integer));
2334       FillDWord(StrokeList^, MaxStroke, 2);
2335
2336       if Color2RGB(Color) = clSilver then LineColor := clGray;
2337       DrawLines(goFixedHorzLine in d.fOptions, goFixedVertLine in d.fOptions,
2338         0, 0, [0, 0, Horz.FixedBoundary, Vert.FixedBoundary], clBlack, clBtnFace);
2339       DrawLines(goFixedHorzLine in d.fOptions, goFixedVertLine in d.fOptions,
2340         d.fTopLeft.X, 0, [Horz.FixedBoundary, 0, Horz.GridBoundary,
2341         Vert.FixedBoundary], clBlack, clBtnFace);
2342       DrawLines(goFixedHorzLine in d.fOptions, goFixedVertLine in d.fOptions,
2343         0, d.fTopLeft.Y, [0, Vert.FixedBoundary, Horz.FixedBoundary,
2344         Vert.GridBoundary], clBlack, clBtnFace);
2345       DrawLines(goHorzLine in d.fOptions, goVertLine in d.fOptions,
2346         d.fTopLeft.X, d.fTopLeft.Y, [Horz.FixedBoundary, Vert.FixedBoundary, Horz.GridBoundary,
2347         Vert.GridBoundary], LineColor, clWindow);
2348
2349       StackFree(StrokeList);
2350       StackFree(PointsList);
2351     end;                                     {FixedColor = clBtnFace}
2352                                               {Color = clWindow}
2353     { Draw the cells in the four areas }
2354     Sel := Selection;
2355     FrameFlags1 := 0;
2356     FrameFlags2 := 0;
2357     if goFixedVertLine in d.fOptions then begin
2358       FrameFlags1 := BF_RIGHT;
2359       FrameFlags2 := BF_LEFT;
2360     end;
2361     if goFixedHorzLine in d.fOptions then begin
2362       FrameFlags1 := FrameFlags1 or BF_BOTTOM;
2363       FrameFlags2 := FrameFlags2 or BF_TOP;
2364     end;
2365     DrawCells(0, 0, 0, 0, Horz.FixedBoundary, Vert.FixedBoundary, clBtnFace{FixedColor},
2366       [gdFixed]);
2367     DrawCells(d.fTopLeft.X, 0, Horz.FixedBoundary - d.fColOffset, 0, Horz.GridBoundary,  //!! clip
2368       Vert.FixedBoundary, clBtnFace{FixedColor}, [gdFixed]);
2369     DrawCells(0, d.fTopLeft.Y, 0, Vert.FixedBoundary, Horz.FixedBoundary,
2370       Vert.GridBoundary, clBtnFace{FixedColor}, [gdFixed]);
2371     DrawCells(d.fTopLeft.X, d.fTopLeft.Y, Horz.FixedBoundary - d.fColOffset,                   //!! clip
2372       Vert.FixedBoundary, Horz.GridBoundary, Vert.GridBoundary, clWindow{Color}, []);
2373
2374     if //not (csDesigning in ComponentState) and
2375       (goRowSelect in d.fOptions) and d.fDefaultDrawing and Focused then begin
2376       GridRectToScreenRect(GetSelection, FocRect, False);
2377       c.DrawFocusRect(FocRect);
2378     end;
2379     if Horz.GridBoundary < Horz.GridExtent then begin
2380       c.Brush.Color := Color;
2381       c.FillRect(MakeRect(Horz.GridBoundary, 0, Horz.GridExtent, Vert.GridBoundary));
2382     end;
2383     if Vert.GridBoundary < Vert.GridExtent then begin
2384       c.Brush.Color := Color;
2385       c.FillRect(MakeRect(0, Vert.GridBoundary, Horz.GridExtent, Vert.GridExtent));
2386     end;
2387   end;
2388
2389 //  BitBlt(Canvas.Handle,0,0,r.Right,r.Bottom,c.Handle,0,0,SrcCopy);
2390   BitBlt(Canvas.Handle,UpdateRect.Left,UpdateRect.Top,UpdateRect.Right,UpdateRect.Bottom,c.Handle,UpdateRect.Left,UpdateRect.Top,SrcCopy);
2391 //  Canvas.CopyRect(r,c,r);
2392   SelectObject(tmDC,tmObj);
2393   DeleteObject(tmBmp);
2394 //  DeleteDC(tmDC);
2395   c.Free;
2396 end;
2397
2398 procedure TStGrd.ScrollData(DX, DY: Integer);
2399 var
2400   DrawInfo: TGridDrawInfo;
2401 begin
2402   CalcDrawInfo(DrawInfo);
2403   ScrollDataInfo(DX, DY, DrawInfo);
2404 end;
2405
2406 procedure TStGrd.ScrollDataInfo(DX, DY: Integer; var DrawInfo: TGridDrawInfo);
2407 var
2408   ScrollArea: TRect;
2409   ScrollFlags: Integer;
2410 begin
2411   with DrawInfo do
2412   begin
2413     ScrollFlags := SW_INVALIDATE;
2414     if not DefaultDrawing then ScrollFlags := ScrollFlags or SW_ERASE;
2415     { Scroll the area }
2416     if DY = 0 then begin
2417       { Scroll both the column titles and data area at the same time }
2418 //      if not UseRightToLeftAlignment then
2419         ScrollArea := MakeRect(Horz.FixedBoundary, 0, Horz.GridExtent, Vert.GridExtent);
2420 {      else
2421       begin
2422         ScrollArea := Rect(ClientWidth - Horz.GridExtent, 0, ClientWidth - Horz.FixedBoundary, Vert.GridExtent);
2423         DX := -DX;
2424       end;}
2425       ScrollWindowEx(Handle, DX, 0, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
2426     end else if DX = 0 then begin
2427       ScrollArea := MakeRect(0, Vert.FixedBoundary, Horz.GridExtent, Vert.GridExtent);
2428       ScrollWindowEx(Handle, 0, DY, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
2429     end else begin
2430       ScrollArea := MakeRect(Horz.FixedBoundary, 0, Horz.GridExtent, Vert.FixedBoundary);
2431       ScrollWindowEx(Handle, DX, 0, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
2432       ScrollArea := MakeRect(0, Vert.FixedBoundary, Horz.FixedBoundary, Vert.GridExtent);
2433       ScrollWindowEx(Handle, 0, DY, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
2434       { Data area }
2435       ScrollArea := MakeRect(Horz.FixedBoundary, Vert.FixedBoundary, Horz.GridExtent,
2436         Vert.GridExtent);
2437       ScrollWindowEx(Handle, DX, DY, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
2438     end;
2439   end;
2440   if goRowSelect in Options then
2441     InvalidateRect(Selection);
2442 end;
2443
2444 function TStGrd.SelectCell(ACol, ARow: Integer): Boolean;
2445 var D: PStGrdData;
2446 begin
2447   D := Pointer(CustomObj);
2448   Result := True;
2449   if Assigned(d.fOnSelectCell) then d.fOnSelectCell(@Self, ACol, ARow, Result);
2450 end;
2451
2452 procedure TStGrd.SelectionMoved(const OldSel: TGridRect);
2453 var
2454   OldRect, NewRect: TRect;
2455   AXorRects: TXorRects;
2456   I: Integer;
2457 begin
2458   GridRectToScreenRect(OldSel, OldRect, True);
2459   GridRectToScreenRect(Selection, NewRect, True);
2460   XorRects(OldRect, NewRect, AXorRects);
2461   for I := Low(AXorRects) to High(AXorRects) do
2462     Windows.InvalidateRect(Handle, @AXorRects[I], False);
2463 end;
2464
2465 procedure TStGrd.SetCells(ACol, ARow: Integer; const Value: string);
2466 var D: PStGrdData;
2467 begin
2468   D := Pointer(CustomObj);
2469   if (ACol < 0) or (ARow < 0) or (ACol > D.fColCount-1) or (ARow > D.fRowCount - 1) then exit;
2470   PStrListArray(D.fCells)^[ACol].Items[ARow] := Value;
2471   InvalidateCell(ACol,ARow);
2472 end;
2473
2474 procedure TStGrd.SetCol(const Value: Longint);
2475 begin
2476   FocusCell(Value, Row, True);
2477 end;
2478
2479 procedure TStGrd.SetColCount(Value: Longint);
2480 var D: PStGrdData;
2481     i,j,old: Longint;
2482 begin
2483   D := Pointer(CustomObj);
2484   if d.fColCount <> Value then begin
2485     if Value < 1 then Value := 1;
2486     if Value <= d.fFixedCols then d.fFixedCols := Value - 1;
2487     old := d.fColCount;
2488     ChangeSize(Value, d.fRowCount);
2489     if goRowSelect in d.fOptions then begin
2490       d.fAnchor.X := d.fColCount - 1;
2491       Invalidate;
2492     end;
2493     if old > D.fColCount
2494       then for i := old - 1 downto D.fColCount do PStrListArray(D.fCells)^[i].Free
2495     else begin
2496       SetLength(PStrListArray(D.fCells)^,D.fColCount);
2497       for i := old to D.fColCount - 1 do begin
2498         PStrListArray(D.fCells)^[i] := NewStrList;
2499         for j := 0 to D.fRowCount - 1 do
2500           PStrListArray(D.fCells)^[i].Add('');
2501       end;
2502     end;
2503   end;
2504 end;
2505
2506 procedure TStGrd.SetColWidths(Index: Integer; const Value: Integer);
2507 var D: PStGrdData;
2508 begin
2509   D := Pointer(CustomObj);
2510   if d.fColWidths = nil then
2511     UpdateExtents(d.fColWidths, d.fColCount, d.fDefaultColWidth);
2512   if Index >= d.fColCount then exit;//InvalidOp(SIndexOutOfRange);
2513   if Value <> PIntArray(d.fColWidths)^[Index + 1] then
2514   begin
2515     invalidate;//ResizeCol(Index, PIntArray(d.fColWidths)^[Index + 1], Value);
2516     PIntArray(d.fColWidths)^[Index + 1] := Value;
2517     UpdateScrollRange;//ColWidthsChanged;
2518   end;
2519 end;
2520
2521 procedure TStGrd.SetDefaultColWidth(const Value: Integer);
2522 var D: PStGrdData;
2523 begin
2524   D := Pointer(CustomObj);
2525   if D.fColWidths <> nil then UpdateExtents(D.fColWidths, 0, 0);
2526   D.fDefaultColWidth := Value;
2527   UpdateScrollRange;//ColWidthsChanged;
2528   Invalidate//Grid;
2529 end;
2530
2531 procedure TStGrd.SetDefaultDrawing(const Value: Boolean);
2532 var D: PStGrdData;
2533 begin
2534   D := Pointer(CustomObj);
2535   D.fDefaultDrawing := Value;
2536 end;
2537
2538 procedure TStGrd.SetDefaultRowHeight(const Value: Integer);
2539 var D: PStGrdData;
2540 begin
2541   D := Pointer(CustomObj);
2542   if D.fRowHeights <> nil then UpdateExtents(D.fRowHeights, 0, 0);
2543   D.fDefaultRowHeight := Value;
2544   UpdateScrollRange;//RowHeightsChanged;
2545   Invalidate//Grid;
2546 end;
2547
2548 procedure TStGrd.SetFixedCols(const Value: Integer);
2549 var D: PStGrdData;
2550 begin
2551   D := Pointer(CustomObj);
2552   if Value < 0 then exit;//InvalidOp(SIndexOutOfRange);
2553   if Value >= D.fColCount then exit;//InvalidOp(SFixedColTooBig);
2554   D.fFixedCols := Value;
2555 //  Initialize;
2556   D.fTopLeft.X := D.fFixedCols;
2557   D.fTopLeft.Y := D.fFixedRows;
2558   D.fCurrent := D.fTopLeft;
2559   D.fAnchor := D.fCurrent;
2560   if goRowSelect in D.fOptions then D.fAnchor.X := D.fColCount - 1;
2561 //
2562   Invalidate//Grid;
2563 end;
2564
2565 procedure TStGrd.SetFixedRows(const Value: Integer);
2566 var D: PStGrdData;
2567 begin
2568   D := Pointer(CustomObj);
2569   if Value < 0 then exit;//InvalidOp(SIndexOutOfRange);
2570   if Value >= D.fRowCount then exit;//InvalidOp(SFixedRowTooBig);
2571   D.fFixedRows := Value;
2572 //  Initialize;
2573   D.fTopLeft.X := D.fFixedCols;
2574   D.fTopLeft.Y := D.fFixedRows;
2575   D.fCurrent := D.fTopLeft;
2576   D.fAnchor := D.fCurrent;
2577   if goRowSelect in D.fOptions then D.fAnchor.X := D.fColCount - 1;
2578 //
2579   Invalidate//Grid;
2580 end;
2581
2582 procedure TStGrd.SetLeftCol(const Value: Longint);
2583 begin
2584   MoveTopLeft(Value, TopRow);
2585 end;
2586
2587 procedure TStGrd.SetOnDrawCell(const Value: TDrawCellEvent);
2588 var D: PStGrdData;
2589 begin
2590   D := Pointer(CustomObj);
2591   D.fOnDrawCell := Value;
2592 end;
2593
2594 procedure TStGrd.SetOnSelectCell(const Value: TSelectCellEvent);
2595 var D: PStGrdData;
2596 begin
2597   D := Pointer(CustomObj);
2598   D.fOnSelectCell := Value;
2599 end;
2600
2601 procedure TStGrd.SetOptions(Value: TGridOptions);
2602 var D: PStGrdData;
2603 begin
2604   D := Pointer(CustomObj);
2605   if goRowSelect in Value then
2606     Exclude(Value, goAlwaysShowEditor);
2607   D.fOptions := Value;
2608 //  if not FEditorMode then
2609 //    if goAlwaysShowEditor in Value then
2610 //      ShowEditor else
2611 //      HideEditor;
2612   if goRowSelect in Value then MoveCurrent(Col, Row,  True, False);
2613   Invalidate//Grid;
2614 end;
2615
2616 procedure TStGrd.SetRow(const Value: Longint);
2617 begin
2618   FocusCell(Col, Value, True);
2619 end;
2620
2621 procedure TStGrd.SetRowCount(Value: Longint);
2622 var D: PStGrdData;
2623     i,j,old: Longint;
2624 begin
2625   D := Pointer(CustomObj);
2626   if Value < 1 then Value := 1;
2627   if Value <= D.fFixedRows then D.fFixedRows := Value - 1;
2628   old := D.fRowCount;
2629   ChangeSize(D.fColCount, Value);
2630   if old > D.fRowCount
2631     then for i := 0 to D.fColCount - 1 do
2632       for j := old - 1 downto D.fRowCount do
2633         PStrListArray(D.fCells)^[i].Delete(j)
2634     else for i := 0 to D.fColCount - 1 do
2635       for j := old to D.fRowCount - 1 do
2636         PStrListArray(D.fCells)^[i].Add('');
2637 end;
2638
2639 procedure TStGrd.SetRowHeights(Index: Integer; const Value: Integer);
2640 var D: PStGrdData;
2641 begin
2642   D := Pointer(CustomObj);
2643   if D.fRowHeights = nil then
2644     UpdateExtents(d.fRowHeights, d.fRowCount, d.fDefaultRowHeight);
2645   if Index >= d.fRowCount then exit;//InvalidOp(SIndexOutOfRange);
2646   if Value <> PIntArray(d.fRowHeights)^[Index + 1] then begin
2647     invalidate;//ResizeRow(Index, PIntArray(D.fRowHeights)^[Index + 1], Value);
2648     PIntArray(d.fRowHeights)^[Index + 1] := Value;
2649     UpdateScrollRange;//RowHeightsChanged;
2650   end;
2651 end;
2652
2653 procedure TStGrd.SetRows(Index: Integer; const Value: pStrList);
2654 var D: PStGrdData;
2655     i: Longint;
2656 begin
2657   D := Pointer(CustomObj);
2658   if (Index < 0) or (Index > D.fRowCount - 1) then exit;
2659   for i := 0 to Value.Count-1 do
2660     PStrListArray(D.fCells)^[i].Items[Index] := Value.Items[i];
2661 end;
2662
2663 procedure TStGrd.SetScrollBars(const Value: TScrollStyle);
2664 var D: PStGrdData;
2665 begin
2666   D := Pointer(CustomObj);
2667   if D.fScrollBars <> Value then begin
2668     D.fScrollBars := Value;
2669     ShowScrollBar(Handle,sb_Vert,Value in [ssVertical,ssBoth]);
2670     ShowScrollBar(Handle,sb_Horz,Value in [ssHorizontal,ssBoth]);
2671   end;
2672 end;
2673
2674 procedure TStGrd.SetSelection(const Value: TGridRect);
2675 var
2676   OldSel: TGridRect;
2677   D: PStGrdData;
2678 begin
2679   D := Pointer(CustomObj);
2680   OldSel := Selection;
2681   D.fAnchor := Value.TopLeft;
2682   D.fCurrent := Value.BottomRight;
2683   SelectionMoved(OldSel);
2684 end;
2685 {
2686 procedure TStGrd.SetTabStops(Index: Integer; const Value: Boolean);
2687 var D: PStGrdData;
2688 begin
2689   D := Pointer(CustomObj);
2690   if D.fTabStops = nil then
2691     UpdateExtents(D.fTabStops, D.fColCount, Integer(True));
2692   if Index >= D.fColCount then exit;//InvalidOp(SIndexOutOfRange);
2693   PIntArray(D.fTabStops)^[Index + 1] := Integer(Value);
2694 end;
2695 }
2696 procedure TStGrd.SetTopRow(const Value: Longint);
2697 begin
2698   MoveTopLeft(LeftCol, Value);
2699 end;
2700
2701 procedure TStGrd.TimedScroll(Direction: TGridScrollDirection);
2702 var
2703   MaxAnchor, NewAnchor: TGridCoord;
2704   D: PStGrdData;
2705 begin
2706   D := Pointer(CustomObj);
2707   NewAnchor := D.fAnchor;
2708   MaxAnchor.X := D.fColCount - 1;
2709   MaxAnchor.Y := D.fRowCount - 1;
2710   if (sdLeft in Direction) and (D.fAnchor.X > D.fFixedCols) then Dec(NewAnchor.X);
2711   if (sdRight in Direction) and (D.fAnchor.X < MaxAnchor.X) then Inc(NewAnchor.X);
2712   if (sdUp in Direction) and (D.fAnchor.Y > D.fFixedRows) then Dec(NewAnchor.Y);
2713   if (sdDown in Direction) and (D.fAnchor.Y < MaxAnchor.Y) then Inc(NewAnchor.Y);
2714   if (D.fAnchor.X <> NewAnchor.X) or (D.fAnchor.Y <> NewAnchor.Y) then
2715     MoveAnchor(NewAnchor);
2716 end;
2717
2718 procedure TStGrd.TopLeftMoved(const OldTopLeft: TGridCoord);
2719
2720   function CalcScroll(const AxisInfo: TGridAxisDrawInfo;
2721     OldPos, CurrentPos: Integer; var Amount: Longint): Boolean;
2722   var
2723     Start, Stop: Longint;
2724     I: Longint;
2725   begin
2726     Result := False;
2727     with AxisInfo do begin
2728       if OldPos < CurrentPos then begin
2729         Start := OldPos;
2730         Stop := CurrentPos;
2731       end else begin
2732         Start := CurrentPos;
2733         Stop := OldPos;
2734       end;
2735       Amount := 0;
2736       for I := Start to Stop - 1 do begin
2737         Inc(Amount, GetExtent(I) + EffectiveLineWidth);
2738         if Amount > (GridBoundary - FixedBoundary) then begin
2739           { Scroll amount too big, redraw the whole thing }
2740           Invalidate;//Grid;
2741           Exit;
2742         end;
2743       end;
2744       if OldPos < CurrentPos then Amount := -Amount;
2745     end;
2746     Result := True;
2747   end;
2748
2749 var
2750   DrawInfo: TGridDrawInfo;
2751   Delta: TGridCoord;
2752   D: PStGrdData;
2753 begin
2754   D := Pointer(CustomObj);
2755   UpdateScrollPos;
2756   CalcDrawInfo(DrawInfo);
2757   if CalcScroll(DrawInfo.Horz, OldTopLeft.X, D.fTopLeft.X, Delta.X) and
2758     CalcScroll(DrawInfo.Vert, OldTopLeft.Y, D.fTopLeft.Y, Delta.Y) then
2759     ScrollDataInfo(Delta.X, Delta.Y, DrawInfo);
2760 //  TopLeftChanged;
2761 end;
2762
2763 procedure TStGrd.UpdateScrollPos;
2764 var
2765   DrawInfo: TGridDrawInfo;
2766   MaxTopLeft: TGridCoord;
2767   GridSpace, ColWidth: Integer;
2768   D: PStGrdData;
2769
2770   procedure SetScroll(Code: Word; Value: Integer);
2771   begin
2772 {    if UseRightToLeftAlignment and (Code = SB_HORZ) then
2773       if ColCount <> 1 then Value := MaxShortInt - Value
2774       else                  Value := (ColWidth - GridSpace) - Value;}
2775     if GetScrollPos(Handle, Code) <> Value then
2776       SetScrollPos(Handle, Code, Value, True);
2777   end;
2778
2779 begin
2780   D := Pointer(CustomObj);
2781   if (ScrollBars = ssNone) then Exit;
2782   CalcDrawInfo(DrawInfo);
2783   MaxTopLeft.X := ColCount - 1;
2784   MaxTopLeft.Y := RowCount - 1;
2785   MaxTopLeft := CalcMaxTopLeft(MaxTopLeft, DrawInfo);
2786   if ScrollBars in [ssHorizontal, ssBoth] then
2787     if ColCount = 1 then
2788     begin
2789       ColWidth := ColWidths[DrawInfo.Horz.FirstGridCell];
2790       GridSpace := ClientWidth - DrawInfo.Horz.FixedBoundary;
2791       if (D.fColOffset > 0) and (GridSpace > (ColWidth - D.fColOffset)) then
2792         ModifyScrollbar(SB_HORZ, SB_THUMBPOSITION, ColWidth - GridSpace, True)
2793       else
2794         SetScroll(SB_HORZ, D.fColOffset)
2795     end
2796     else
2797       SetScroll(SB_HORZ, LongMulDiv(D.fTopLeft.X - D.fFixedCols, MaxShortInt,
2798         MaxTopLeft.X - D.fFixedCols));
2799   if ScrollBars in [ssVertical, ssBoth] then
2800     SetScroll(SB_VERT, LongMulDiv(D.fTopLeft.Y - D.fFixedRows, MaxShortInt,
2801       MaxTopLeft.Y - D.fFixedRows));
2802 end;
2803
2804 procedure TStGrd.UpdateScrollRange;
2805 var
2806   MaxTopLeft, OldTopLeft: TGridCoord;
2807   DrawInfo: TGridDrawInfo;
2808   OldScrollBars: TScrollStyle;
2809   Updated: Boolean;
2810   D: PStGrdData;
2811
2812   procedure DoUpdate;
2813   begin
2814     if not Updated then
2815     begin
2816       Update;
2817       Updated := True;
2818     end;
2819   end;
2820
2821   function ScrollBarVisible(Code: Word): Boolean;
2822   var
2823     Min, Max: Integer;
2824   begin
2825     Result := False;
2826     if (ScrollBars = ssBoth) or
2827       ((Code = SB_HORZ) and (ScrollBars = ssHorizontal)) or
2828       ((Code = SB_VERT) and (ScrollBars = ssVertical)) then
2829     begin
2830       GetScrollRange(Handle, Code, Min, Max);
2831       Result := Min <> Max;
2832     end;
2833   end;
2834
2835   procedure CalcSizeInfo;
2836   begin
2837     CalcDrawInfoXY(DrawInfo, DrawInfo.Horz.GridExtent, DrawInfo.Vert.GridExtent);
2838     MaxTopLeft.X := ColCount - 1;
2839     MaxTopLeft.Y := RowCount - 1;
2840     MaxTopLeft := CalcMaxTopLeft(MaxTopLeft, DrawInfo);
2841   end;
2842
2843   procedure SetAxisRange(var Max, Old, Current: Longint; Code: Word;
2844     Fixeds: Integer);
2845   begin
2846     CalcSizeInfo;
2847     if Fixeds < Max then
2848       SetScrollRange(Handle, Code, 0, MaxShortInt, True)
2849     else
2850       SetScrollRange(Handle, Code, 0, 0, True);
2851     if Old > Max then
2852     begin
2853       DoUpdate;
2854       Current := Max;
2855     end;
2856   end;
2857
2858   procedure SetHorzRange;
2859   var
2860     Range: Integer;
2861   begin
2862     if OldScrollBars in [ssHorizontal, ssBoth] then
2863       if ColCount = 1 then
2864       begin
2865         Range := ColWidths[0] - ClientWidth;
2866         if Range < 0 then Range := 0;
2867         SetScrollRange(Handle, SB_HORZ, 0, Range, True);
2868       end
2869       else
2870         SetAxisRange(MaxTopLeft.X, OldTopLeft.X, D.fTopLeft.X, SB_HORZ, D.fFixedCols);
2871   end;
2872
2873   procedure SetVertRange;
2874   begin
2875     if OldScrollBars in [ssVertical, ssBoth] then
2876       SetAxisRange(MaxTopLeft.Y, OldTopLeft.Y, D.fTopLeft.Y, SB_VERT, D.fFixedRows);
2877   end;
2878
2879 begin
2880   if (ScrollBars = ssNone) {or not Showing} then Exit;
2881   D := Pointer(CustomObj);
2882   with DrawInfo do
2883   begin
2884     Horz.GridExtent := ClientWidth;
2885     Vert.GridExtent := ClientHeight;
2886     { Ignore scroll bars for initial calculation }
2887     if ScrollBarVisible(SB_HORZ) then
2888       Inc(Vert.GridExtent, GetSystemMetrics(SM_CYHSCROLL));
2889     if ScrollBarVisible(SB_VERT) then
2890       Inc(Horz.GridExtent, GetSystemMetrics(SM_CXVSCROLL));
2891   end;
2892   OldTopLeft := D.fTopLeft;
2893   { Temporarily mark us as not having scroll bars to avoid recursion }
2894   OldScrollBars := D.fScrollBars;
2895   D.fScrollBars := ssNone;
2896   Updated := False;
2897   try
2898     { Update scrollbars }
2899     SetHorzRange;
2900     DrawInfo.Vert.GridExtent := ClientHeight;
2901     SetVertRange;
2902     if DrawInfo.Horz.GridExtent <> ClientWidth then
2903     begin
2904       DrawInfo.Horz.GridExtent := ClientWidth;
2905       SetHorzRange;
2906     end;
2907   finally
2908     D.fScrollBars := OldScrollBars;
2909   end;
2910   UpdateScrollPos;
2911   if (D.fTopLeft.X <> OldTopLeft.X) or (D.fTopLeft.Y <> OldTopLeft.Y) then
2912     TopLeftMoved(OldTopLeft);
2913 end;
2914
2915 procedure TStGrd.WheelDown{(Shift: TShiftState; MousePos: TPoint): Boolean};
2916 begin
2917 //  Result := inherited DoMouseWheelDown(Shift, MousePos);
2918 //  if not Result then
2919   begin
2920     if Row < RowCount - 1 then Row := Row + 1;
2921 //    Result := True;
2922   end;
2923 end;
2924
2925 procedure TStGrd.WheelUp{(Shift: TShiftState; MousePos: TPoint): Boolean};
2926 begin
2927 //  Result := inherited DoMouseWheelUp(Shift, MousePos);
2928 //  if not Result then
2929   begin
2930     if Row > FixedRows then Row := Row - 1;
2931 //    Result := True;
2932   end;
2933 end;
2934
2935 procedure TStGrd.WMSetCursor(_HitTest: Word);
2936 var
2937   DrawInfo: TGridDrawInfo;
2938   State: TGridState;
2939   Index: Longint;
2940   Pos, Ofs: Integer;
2941   Cur: HCURSOR;
2942   D: PStGrdData;
2943 begin
2944   if _HitTest = HTCLIENT then begin
2945     D := Pointer(CustomObj);
2946     if D.fGridState = gsNormal then begin
2947       CalcDrawInfo(DrawInfo);
2948       CalcSizingState(D.fHitTest.X, D.fHitTest.Y, State, Index, Pos, Ofs, DrawInfo);
2949     end else State := D.fGridState;
2950     case State of
2951       gsRowSizing: Cur := LoadCursor(hInstance,IDC_VSPLIT); //LoadCursor(0,IDC_SIZENS);
2952       gsColSizing: Cur := LoadCursor(hInstance,IDC_HSPLIT); //LoadCursor(0,IDC_SIZEWE);
2953     else
2954       Cur := LoadCursor(0,IDC_ARROW);
2955     end;
2956 {    if State = gsRowSizing
2957       then Cur := LoadCursor(0,IDC_SIZENS) //Screen.Cursors[crVSplit]
2958       else if State = gsColSizing
2959         then Cur := LoadCursor(0,IDC_SIZEWE); //Screen.Cursors[crHSplit]}
2960   DestroyCursor(Cursor);
2961   SetCursor(Cur);
2962   Cursor := Cur;
2963   end;
2964   {if Cur <> 0 then }
2965 end;
2966
2967 procedure TStGrd.WMTimer;
2968 var
2969   Point: TPoint;
2970   DrawInfo: TGridDrawInfo;
2971   ScrollDirection: TGridScrollDirection;
2972   CellHit: TGridCoord;
2973 //  LeftSide: Integer;
2974 //  RightSide: Integer;
2975   D: PStGrdData;
2976 begin
2977   D := Pointer(CustomObj);
2978   if not (D.fGridState in [gsSelecting, gsRowMoving, gsColMoving]) then Exit;
2979   GetCursorPos(Point);
2980   Point := Screen2Client(Point);
2981   CalcDrawInfo(DrawInfo);
2982   ScrollDirection := [];
2983   with DrawInfo do
2984   begin
2985     CellHit := CalcCoordFromPoint(Point.X, Point.Y, DrawInfo);
2986     case D.fGridState of
2987       gsColMoving:
2988         MoveAndScroll(Point.X, CellHit.X, DrawInfo, Horz, SB_HORZ, Point);
2989       gsRowMoving:
2990         MoveAndScroll(Point.Y, CellHit.Y, DrawInfo, Vert, SB_VERT, Point);
2991       gsSelecting:
2992       begin
2993 //        if not UseRightToLeftAlignment then
2994         begin
2995           if Point.X < Horz.FixedBoundary then Include(ScrollDirection, sdLeft)
2996           else if Point.X > Horz.FullVisBoundary then Include(ScrollDirection, sdRight);
2997         end
2998 {        else
2999         begin
3000           LeftSide := ClientWidth - Horz.FullVisBoundary;
3001           RightSide := ClientWidth - Horz.FixedBoundary;
3002           if Point.X < LeftSide then Include(ScrollDirection, sdRight)
3003           else if Point.X > RightSide then Include(ScrollDirection, sdLeft);
3004         end};
3005         if Point.Y < Vert.FixedBoundary then Include(ScrollDirection, sdUp)
3006         else if Point.Y > Vert.FullVisBoundary then Include(ScrollDirection, sdDown);
3007         if ScrollDirection <> [] then  TimedScroll(ScrollDirection);
3008       end;
3009     end;
3010   end;
3011 end;
3012
3013 end.