home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Source / Vcl / dbcgrids.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  34KB  |  1,181 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {                                                       }
  6. {       Copyright (c) 1996,99 Inprise Corporation       }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit DBCGrids;
  11.  
  12. {$R-,H+,X+}
  13.  
  14. interface
  15.  
  16. uses SysUtils, Windows, Messages, Classes, Controls, Forms,
  17.   Graphics, Menus, DB;
  18.  
  19. type
  20.  
  21. { TDBCtrlGrid }
  22.  
  23.   TDBCtrlGrid = class;
  24.  
  25.   TDBCtrlGridLink = class(TDataLink)
  26.   private
  27.     FDBCtrlGrid: TDBCtrlGrid;
  28.   protected
  29.     procedure ActiveChanged; override;
  30.     procedure DataSetChanged; override;
  31.   public
  32.     constructor Create(DBCtrlGrid: TDBCtrlGrid);
  33.   end;
  34.  
  35.   TDBCtrlPanel = class(TWinControl)
  36.   private
  37.     FDBCtrlGrid: TDBCtrlGrid;
  38.     procedure CMControlListChange(var Message: TCMControlListChange); message CM_CONTROLLISTCHANGE;
  39.     procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
  40.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  41.     procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  42.   protected
  43.     procedure CreateParams(var Params: TCreateParams); override;
  44.     procedure PaintWindow(DC: HDC); override;
  45.   public
  46.     constructor CreateLinked(DBCtrlGrid: TDBCtrlGrid);
  47.   end;
  48.  
  49.   TDBCtrlGridOrientation = (goVertical, goHorizontal);
  50.   TDBCtrlGridBorder = (gbNone, gbRaised);
  51.   TDBCtrlGridKey = (gkNull, gkEditMode, gkPriorTab, gkNextTab, gkLeft,
  52.     gkRight, gkUp, gkDown, gkScrollUp, gkScrollDown, gkPageUp, gkPageDown,
  53.     gkHome, gkEnd, gkInsert, gkAppend, gkDelete, gkCancel);
  54.  
  55.   TPaintPanelEvent = procedure(DBCtrlGrid: TDBCtrlGrid;
  56.     Index: Integer) of object;
  57.  
  58.   TDBCtrlGrid = class(TWinControl)
  59.   private
  60.     FDataLink: TDBCtrlGridLink;
  61.     FPanel: TDBCtrlPanel;
  62.     FCanvas: TCanvas;
  63.     FColCount: Integer;
  64.     FRowCount: Integer;
  65.     FPanelWidth: Integer;
  66.     FPanelHeight: Integer;
  67.     FPanelIndex: Integer;
  68.     FPanelCount: Integer;
  69.     FBitmapCount: Integer;
  70.     FPanelBitmap: HBitmap;
  71.     FSaveBitmap: HBitmap;
  72.     FPanelDC: HDC;
  73.     FOrientation: TDBCtrlGridOrientation;
  74.     FPanelBorder: TDBCtrlGridBorder;
  75.     FAllowInsert: Boolean;
  76.     FAllowDelete: Boolean;
  77.     FShowFocus: Boolean;
  78.     FFocused: Boolean;
  79.     FClicking: Boolean;
  80.     FSelColorChanged: Boolean;
  81.     FScrollBarKind: Integer;
  82.     FSelectedColor: TColor;
  83.     FOnPaintPanel: TPaintPanelEvent;
  84.     function AcquireFocus: Boolean;
  85.     procedure AdjustSize; reintroduce;
  86.     procedure CreatePanelBitmap;
  87.     procedure DataSetChanged(Reset: Boolean);
  88.     procedure DestroyPanelBitmap;
  89.     procedure DrawPanel(DC: HDC; Index: Integer);
  90.     procedure DrawPanelBackground(DC: HDC; const R: TRect; Erase, Selected: Boolean);
  91.     function FindNext(StartControl: TWinControl; GoForward: Boolean;
  92.      var WrapFlag: Integer): TWinControl;
  93.     function GetDataSource: TDataSource;
  94.     function GetEditMode: Boolean;
  95.     function GetPanelBounds(Index: Integer): TRect;
  96.     function PointInPanel(const P: TSmallPoint): Boolean;
  97.     procedure Reset;
  98.     procedure Scroll(Inc: Integer; ScrollLock: Boolean);
  99.     procedure ScrollMessage(var Message: TWMScroll);
  100.     procedure SelectNext(GoForward: Boolean);
  101.     procedure SetColCount(Value: Integer);
  102.     procedure SetDataSource(Value: TDataSource);
  103.     procedure SetEditMode(Value: Boolean);
  104.     procedure SetOrientation(Value: TDBCtrlGridOrientation);
  105.     procedure SetPanelBorder(Value: TDBCtrlGridBorder);
  106.     procedure SetPanelHeight(Value: Integer);
  107.     procedure SetPanelIndex(Value: Integer);
  108.     procedure SetPanelWidth(Value: Integer);
  109.     procedure SetRowCount(Value: Integer);
  110.     procedure SetSelectedColor(Value: TColor);
  111.     procedure UpdateDataLinks(Control: TControl; Inserting: Boolean);
  112.     procedure UpdateScrollBar;
  113.     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  114.     procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
  115.     procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
  116.     procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
  117.     procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
  118.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  119.     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  120.     procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
  121.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  122.     procedure WMSize(var Message: TMessage); message WM_SIZE;
  123.     procedure CMChildKey(var Message: TCMChildKey); message CM_CHILDKEY;
  124.     procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  125.   protected
  126.     procedure CreateParams(var Params: TCreateParams); override;
  127.     procedure CreateWnd; override;
  128.     function GetChildParent: TComponent; override;
  129.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  130.     procedure PaintPanel(Index: Integer); virtual;
  131.     procedure PaintWindow(DC: HDC); override;
  132.     procedure ReadState(Reader: TReader); override;
  133.     property Panel: TDBCtrlPanel read FPanel;
  134.   public
  135.     constructor Create(AOwner: TComponent); override;
  136.     destructor Destroy; override;
  137.     procedure DoKey(Key: TDBCtrlGridKey);
  138.     function ExecuteAction(Action: TBasicAction): Boolean; override;
  139.     procedure GetTabOrderList(List: TList); override;
  140.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  141.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  142.     function UpdateAction(Action: TBasicAction): Boolean; override;
  143.     property Canvas: TCanvas read FCanvas;
  144.     property EditMode: Boolean read GetEditMode write SetEditMode;
  145.     property PanelCount: Integer read FPanelCount;
  146.     property PanelIndex: Integer read FPanelIndex write SetPanelIndex;
  147.   published
  148.     property Align;
  149.     property AllowDelete: Boolean read FAllowDelete write FAllowDelete default True;
  150.     property AllowInsert: Boolean read FAllowInsert write FAllowInsert default True;
  151.     property Anchors;
  152.     property ColCount: Integer read FColCount write SetColCount;
  153.     property Color;
  154.     property Constraints;
  155.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  156.     property DragCursor;
  157.     property DragMode;
  158.     property Enabled;
  159.     property Font;
  160.     property Orientation: TDBCtrlGridOrientation read FOrientation write SetOrientation default goVertical;
  161.     property PanelBorder: TDBCtrlGridBorder read FPanelBorder write SetPanelBorder default gbRaised;
  162.     property PanelHeight: Integer read FPanelHeight write SetPanelHeight;
  163.     property PanelWidth: Integer read FPanelWidth write SetPanelWidth;
  164.     property ParentColor;
  165.     property ParentFont;
  166.     property ParentShowHint;
  167.     property PopupMenu;
  168.     property TabOrder;
  169.     property TabStop default True;
  170.     property RowCount: Integer read FRowCount write SetRowCount;
  171.     property SelectedColor: TColor read FSelectedColor write SetSelectedColor
  172.       stored FSelColorChanged default clWindow;
  173.     property ShowFocus: Boolean read FShowFocus write FShowFocus default True;
  174.     property ShowHint;
  175.     property Visible;
  176.     property OnClick;
  177.     property OnDblClick;
  178.     property OnDragDrop;
  179.     property OnDragOver;
  180.     property OnEndDrag;
  181.     property OnEnter;
  182.     property OnExit;
  183.     property OnKeyDown;
  184.     property OnKeyPress;
  185.     property OnKeyUp;
  186.     property OnMouseDown;
  187.     property OnMouseMove;
  188.     property OnMouseUp;
  189.     property OnPaintPanel: TPaintPanelEvent read FOnPaintPanel write FOnPaintPanel;
  190.     property OnStartDrag;
  191.   end;
  192.  
  193. implementation
  194.  
  195. uses DBConsts;
  196.  
  197. { TDBCtrlGridLink }
  198.  
  199. constructor TDBCtrlGridLink.Create(DBCtrlGrid: TDBCtrlGrid);
  200. begin
  201.   inherited Create;
  202.   FDBCtrlGrid := DBCtrlGrid;
  203.   VisualControl := True;
  204.   RPR;
  205. end;
  206.  
  207. procedure TDBCtrlGridLink.ActiveChanged;
  208. begin
  209.   FDBCtrlGrid.DataSetChanged(False);
  210. end;
  211.  
  212. procedure TDBCtrlGridLink.DataSetChanged;
  213. begin
  214.   FDBCtrlGrid.DataSetChanged(False);
  215. end;
  216.  
  217. { TDBCtrlPanel }
  218.  
  219. constructor TDBCtrlPanel.CreateLinked(DBCtrlGrid: TDBCtrlGrid);
  220. begin
  221.   inherited Create(DBCtrlGrid);
  222.   ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
  223.     csDoubleClicks, csOpaque, csReplicatable];
  224.   FDBCtrlGrid := DBCtrlGrid;
  225.   Parent := DBCtrlGrid;
  226. end;
  227.  
  228. procedure TDBCtrlPanel.CreateParams(var Params: TCreateParams);
  229. begin
  230.   inherited CreateParams(Params);
  231.   with Params.WindowClass do
  232.     style := style and not (CS_HREDRAW or CS_VREDRAW);
  233. end;
  234.  
  235. procedure TDBCtrlPanel.PaintWindow(DC: HDC);
  236. var
  237.   R: TRect;
  238.   Selected: Boolean;
  239. begin
  240.   with FDBCtrlGrid do
  241.   begin
  242.     if FDataLink.Active then
  243.     begin
  244.       Selected := (FDataLink.ActiveRecord = FPanelIndex);
  245.       DrawPanelBackground(DC, Self.ClientRect, True, Selected);
  246.       FCanvas.Handle := DC;
  247.       try
  248.         FCanvas.Font := Font;
  249.         FCanvas.Brush.Style := bsSolid;
  250.         FCanvas.Brush.Color := Color;
  251.         PaintPanel(FDataLink.ActiveRecord);
  252.         if FShowFocus and FFocused and Selected then
  253.         begin
  254.           R := Self.ClientRect;
  255.           if FPanelBorder = gbRaised then InflateRect(R, -2, -2);
  256.           FCanvas.Brush.Color := Color;
  257.           FCanvas.DrawFocusRect(R);
  258.         end;
  259.       finally
  260.         FCanvas.Handle := 0;
  261.       end;
  262.     end else
  263.       DrawPanelBackground(DC, Self.ClientRect, True, csDesigning in ComponentState);
  264.   end;
  265. end;
  266.  
  267. procedure TDBCtrlPanel.CMControlListChange(var Message: TCMControlListChange);
  268. begin
  269.   FDBCtrlGrid.UpdateDataLinks(Message.Control, Message.Inserting);
  270. end;
  271.  
  272. procedure TDBCtrlPanel.WMPaint(var Message: TWMPaint);
  273. var
  274.   DC: HDC;
  275.   PS: TPaintStruct;
  276. begin
  277.   if Message.DC = 0 then
  278.   begin
  279.     FDBCtrlGrid.CreatePanelBitmap;
  280.     try
  281.       Message.DC := FDBCtrlGrid.FPanelDC;
  282.       PaintHandler(Message);
  283.       Message.DC := 0;
  284.       DC := BeginPaint(Handle, PS);
  285.       BitBlt(DC, 0, 0, Width, Height, FDBCtrlGrid.FPanelDC, 0, 0, SRCCOPY);
  286.       EndPaint(Handle, PS);
  287.     finally
  288.       FDBCtrlGrid.DestroyPanelBitmap;
  289.     end;
  290.   end else
  291.     PaintHandler(Message);
  292. end;
  293.  
  294. procedure TDBCtrlPanel.WMNCHitTest(var Message: TWMNCHitTest);
  295. begin
  296.   if csDesigning in ComponentState then
  297.     Message.Result := HTCLIENT else
  298.     Message.Result := HTTRANSPARENT;
  299. end;
  300.  
  301. procedure TDBCtrlPanel.WMEraseBkgnd(var Message: TMessage);
  302. begin
  303.   Message.Result := 1;
  304. end;
  305.  
  306. { TDBCtrlGrid }
  307.  
  308. constructor TDBCtrlGrid.Create(AOwner: TComponent);
  309. begin
  310.   inherited Create(AOwner);
  311.   ControlStyle := [csOpaque, csDoubleClicks];
  312.   TabStop := True;
  313.   FDataLink := TDBCtrlGridLink.Create(Self);
  314.   FCanvas := TCanvas.Create;
  315.   FPanel := TDBCtrlPanel.CreateLinked(Self);
  316.   FColCount := 1;
  317.   FRowCount := 3;
  318.   FPanelWidth := 200;
  319.   FPanelHeight := 72;
  320.   FPanelBorder := gbRaised;
  321.   FAllowInsert := True;
  322.   FAllowDelete := True;
  323.   FShowFocus := True;
  324.   FSelectedColor := Color;
  325.   AdjustSize;
  326. end;
  327.  
  328. destructor TDBCtrlGrid.Destroy;
  329. begin
  330.   FCanvas.Free;
  331.   FDataLink.Free;
  332.   FDataLink := nil;
  333.   inherited Destroy;
  334. end;
  335.  
  336. function TDBCtrlGrid.AcquireFocus: Boolean;
  337. begin
  338.   Result := True;
  339.   if not (Focused or EditMode) then
  340.   begin
  341.     SetFocus;
  342.     Result := Focused;
  343.   end;
  344. end;
  345.  
  346. procedure TDBCtrlGrid.AdjustSize;
  347. var
  348.   W, H: Integer;
  349. begin
  350.   W := FPanelWidth * FColCount;
  351.   H := FPanelHeight * FRowCount;
  352.   if FOrientation = goVertical then
  353.     Inc(W, GetSystemMetrics(SM_CXVSCROLL)) else
  354.     Inc(H, GetSystemMetrics(SM_CYHSCROLL));
  355.   SetBounds(Left, Top, W, H);
  356.   Reset;
  357. end;
  358.  
  359. procedure TDBCtrlGrid.CreatePanelBitmap;
  360. var
  361.   DC: HDC;
  362. begin
  363.   if FBitmapCount = 0 then
  364.   begin
  365.     DC := GetDC(0);
  366.     FPanelBitmap := CreateCompatibleBitmap(DC, FPanel.Width, FPanel.Height);
  367.     ReleaseDC(0, DC);
  368.     FPanelDC := CreateCompatibleDC(0);
  369.     FSaveBitmap := SelectObject(FPanelDC, FPanelBitmap);
  370.   end;
  371.   Inc(FBitmapCount);
  372. end;
  373.  
  374. procedure TDBCtrlGrid.CreateParams(var Params: TCreateParams);
  375. begin
  376.   inherited CreateParams(Params);
  377.   with Params do
  378.   begin
  379.     Style := Style or WS_CLIPCHILDREN;
  380.     WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
  381.   end;
  382. end;
  383.  
  384. procedure TDBCtrlGrid.CreateWnd;
  385. begin
  386.   inherited CreateWnd;
  387.   if FOrientation = goVertical then
  388.     FScrollBarKind := SB_VERT else
  389.     FScrollBarKind := SB_HORZ;
  390.   if not FDataLink.Active then
  391.     SetScrollRange(Handle, FScrollBarKind, 0, 4, False);
  392.     UpdateScrollBar;
  393. end;
  394.  
  395. procedure TDBCtrlGrid.DataSetChanged(Reset: Boolean);
  396. var
  397.   NewPanelIndex, NewPanelCount: Integer;
  398.   FocusedControl: TWinControl;
  399.   R: TRect;
  400. begin
  401.   if csDesigning in ComponentState then
  402.   begin
  403.     NewPanelIndex := 0;
  404.     NewPanelCount := 1;
  405.   end else
  406.     if FDataLink.Active then
  407.     begin
  408.       NewPanelIndex := FDataLink.ActiveRecord;
  409.       NewPanelCount := FDataLink.RecordCount;
  410.       if NewPanelCount = 0 then NewPanelCount := 1;
  411.     end else
  412.     begin
  413.       NewPanelIndex := 0;
  414.       NewPanelCount := 0;
  415.     end;
  416.   FocusedControl := nil;
  417.   R := GetPanelBounds(NewPanelIndex);
  418.   if Reset or not HandleAllocated then FPanel.BoundsRect := R else
  419.   begin
  420.     FocusedControl := FindControl(GetFocus);
  421.     if (FocusedControl <> FPanel) and FPanel.ContainsControl(FocusedControl) then
  422.       FPanel.SetFocus else
  423.       FocusedControl := nil;
  424.     if NewPanelIndex <> FPanelIndex then
  425.     begin
  426.       SetWindowPos(FPanel.Handle, 0, R.Left, R.Top, R.Right - R.Left,
  427.         R.Bottom - R.Top, SWP_NOZORDER or SWP_NOREDRAW);
  428.       RedrawWindow(FPanel.Handle, nil, 0, RDW_INVALIDATE or RDW_ALLCHILDREN);
  429.     end;
  430.   end;
  431.   FPanelIndex := NewPanelIndex;
  432.   FPanelCount := NewPanelCount;
  433.   FPanel.Visible := FPanelCount > 0;
  434.   FPanel.Invalidate;
  435.   if not Reset then
  436.   begin
  437.     Invalidate;
  438.     Update;
  439.   end;
  440.   UpdateScrollBar;
  441.   if (FocusedControl <> nil) and not FClicking and FocusedControl.CanFocus then
  442.     FocusedControl.SetFocus;
  443. end;
  444.  
  445. procedure TDBCtrlGrid.DestroyPanelBitmap;
  446. begin
  447.   Dec(FBitmapCount);
  448.   if FBitmapCount = 0 then
  449.   begin
  450.     SelectObject(FPanelDC, FSaveBitmap);
  451.     DeleteDC(FPanelDC);
  452.     DeleteObject(FPanelBitmap);
  453.   end;
  454. end;
  455.  
  456. procedure TDBCtrlGrid.DoKey(Key: TDBCtrlGridKey);
  457. var
  458.   HInc, VInc: Integer;
  459. begin
  460.   if FDataLink.Active then
  461.   begin
  462.     if FOrientation = goVertical then
  463.     begin
  464.       HInc := 1;
  465.       VInc := FColCount;
  466.     end else
  467.     begin
  468.       HInc := FRowCount;
  469.       VInc := 1;
  470.     end;
  471.     with FDataLink.DataSet do
  472.       case Key of
  473.         gkEditMode: EditMode := not EditMode;
  474.         gkPriorTab: SelectNext(False);
  475.         gkNextTab: SelectNext(True);
  476.         gkLeft: Scroll(-HInc, False);
  477.         gkRight: Scroll(HInc, False);
  478.         gkUp: Scroll(-VInc, False);
  479.         gkDown: Scroll(VInc, False);
  480.         gkScrollUp: Scroll(-VInc, True);
  481.         gkScrollDown: Scroll(VInc, True);
  482.         gkPageUp: Scroll(-FDataLink.BufferCount, True);
  483.         gkPageDown: Scroll(FDataLink.BufferCount, True);
  484.         gkHome: First;
  485.         gkEnd: Last;
  486.         gkInsert:
  487.           if FAllowInsert and CanModify then
  488.           begin
  489.             Insert;
  490.             EditMode := True;
  491.           end;
  492.         gkAppend:
  493.           if FAllowInsert and CanModify then
  494.           begin
  495.             Append;
  496.             EditMode := True;
  497.           end;
  498.         gkDelete:
  499.           if FAllowDelete and CanModify then
  500.           begin
  501.             Delete;
  502.             EditMode := False;
  503.           end;
  504.         gkCancel:
  505.           begin
  506.             Cancel;
  507.             EditMode := False;
  508.           end;
  509.       end;
  510.   end;
  511. end;
  512.  
  513. procedure TDBCtrlGrid.DrawPanel(DC: HDC; Index: Integer);
  514. var
  515.   SaveActive: Integer;
  516.   R: TRect;
  517. begin
  518.   R := GetPanelBounds(Index);
  519.   if Index < FPanelCount then
  520.   begin
  521.     SaveActive := FDataLink.ActiveRecord;
  522.     FDataLink.ActiveRecord := Index;
  523.     FPanel.PaintTo(FPanelDC, 0, 0);
  524.     FDataLink.ActiveRecord := SaveActive;
  525.   end else
  526.     DrawPanelBackground(FPanelDC, FPanel.ClientRect, True, False);
  527.   BitBlt(DC, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top,
  528.     FPanelDC, 0, 0, SRCCOPY);
  529. end;
  530.  
  531. procedure TDBCtrlGrid.DrawPanelBackground(DC: HDC; const R: TRect;
  532.   Erase, Selected: Boolean);
  533. var
  534.   Brush: HBrush;
  535. begin
  536.   if Erase then
  537.   begin
  538.     if Selected then FPanel.Color := FSelectedColor
  539.     else FPanel.Color := Color;
  540.     Brush := CreateSolidBrush(ColorToRGB(FPanel.Color));
  541.     FillRect(DC, R, Brush);
  542.     DeleteObject(Brush);
  543.   end;
  544.   if FPanelBorder = gbRaised then
  545.     DrawEdge(DC, PRect(@R)^, BDR_RAISEDINNER, BF_RECT);
  546. end;
  547.  
  548. function TDBCtrlGrid.GetChildParent: TComponent;
  549. begin
  550.   Result := FPanel;
  551. end;
  552.  
  553. procedure TDBCtrlGrid.GetChildren(Proc: TGetChildProc; Root: TComponent);
  554. begin
  555.   FPanel.GetChildren(Proc, Root);
  556. end;
  557.  
  558. function TDBCtrlGrid.GetDataSource: TDataSource;
  559. begin
  560.   Result := FDataLink.DataSource;
  561. end;
  562.  
  563. function TDBCtrlGrid.GetEditMode: Boolean;
  564. begin
  565.   Result := not Focused and ContainsControl(FindControl(GetFocus));
  566. end;
  567.  
  568. function TDBCtrlGrid.GetPanelBounds(Index: Integer): TRect;
  569. var
  570.   Col, Row: Integer;
  571. begin
  572.   if FOrientation = goVertical then
  573.   begin
  574.     Col := Index mod FColCount;
  575.     Row := Index div FColCount;
  576.   end else
  577.   begin
  578.     Col := Index div FRowCount;
  579.     Row := Index mod FRowCount;
  580.   end;
  581.   Result.Left := FPanelWidth * Col;
  582.   Result.Top := FPanelHeight * Row;
  583.   Result.Right := Result.Left + FPanelWidth;
  584.   Result.Bottom := Result.Top + FPanelHeight;
  585. end;
  586.  
  587. procedure TDBCtrlGrid.GetTabOrderList(List: TList);
  588. begin
  589. end;
  590.  
  591. procedure TDBCtrlGrid.KeyDown(var Key: Word; Shift: TShiftState);
  592. var
  593.   GridKey: TDBCtrlGridKey;
  594. begin
  595.   inherited KeyDown(Key, Shift);
  596.   GridKey := gkNull;
  597.   case Key of
  598.     VK_LEFT: GridKey := gkLeft;
  599.     VK_RIGHT: GridKey := gkRight;
  600.     VK_UP: GridKey := gkUp;
  601.     VK_DOWN: GridKey := gkDown;
  602.     VK_PRIOR: GridKey := gkPageUp;
  603.     VK_NEXT: GridKey := gkPageDown;
  604.     VK_HOME: GridKey := gkHome;
  605.     VK_END: GridKey := gkEnd;
  606.     VK_RETURN, VK_F2: GridKey := gkEditMode;
  607.     VK_INSERT:
  608.       if GetKeyState(VK_CONTROL) >= 0 then
  609.         GridKey := gkInsert else
  610.         GridKey := gkAppend;
  611.     VK_DELETE: if GetKeyState(VK_CONTROL) < 0 then GridKey := gkDelete;
  612.     VK_ESCAPE: GridKey := gkCancel;
  613.   end;
  614.   DoKey(GridKey);
  615. end;
  616.  
  617. procedure TDBCtrlGrid.PaintWindow(DC: HDC);
  618. var
  619.   I: Integer;
  620.   Brush: HBrush;
  621. begin
  622.   if csDesigning in ComponentState then
  623.   begin
  624.     FPanel.Update;
  625.     Brush := CreateHatchBrush(HS_BDIAGONAL, ColorToRGB(clBtnShadow));
  626.     SetBkColor(DC, ColorToRGB(Color));
  627.     FillRect(DC, ClientRect, Brush);
  628.     DeleteObject(Brush);
  629.     for I := 1 to FColCount * FRowCount - 1 do
  630.       DrawPanelBackground(DC, GetPanelBounds(I), False, False);
  631.   end else
  632.   begin
  633.     CreatePanelBitmap;
  634.     try
  635.       for I := 0 to FColCount * FRowCount - 1 do
  636.         if (FPanelCount <> 0) and (I = FPanelIndex) then
  637.           FPanel.Update else
  638.           DrawPanel(DC, I);
  639.     finally
  640.       DestroyPanelBitmap;
  641.     end;
  642.   end;
  643.   { When width or height are not evenly divisible by panel size, fill the gaps }
  644.   if HandleAllocated then
  645.   begin
  646.     if (Height <> FPanel.Height * FRowCount) then
  647.     begin
  648.       Brush := CreateSolidBrush(ColorToRGB(Color));
  649.       FillRect(DC, Rect(0, FPanel.Height * FRowCount, Width, Height), Brush);
  650.       DeleteObject(Brush);
  651.     end;
  652.     if (Width <> FPanel.Width * FColCount) then
  653.     begin
  654.       Brush := CreateSolidBrush(ColorToRGB(Color));
  655.       FillRect(DC, Rect(FPanelWidth * FColCount, 0, Width, Height), Brush);
  656.       DeleteObject(Brush);
  657.     end;
  658.   end;
  659. end;
  660.  
  661. procedure TDBCtrlGrid.PaintPanel(Index: Integer);
  662. begin
  663.   if Assigned(FOnPaintPanel) then FOnPaintPanel(Self, Index);
  664. end;
  665.  
  666. function TDBCtrlGrid.PointInPanel(const P: TSmallPoint): Boolean;
  667. begin
  668.   Result := (FPanelCount > 0) and PtInRect(GetPanelBounds(FPanelIndex),
  669.     SmallPointToPoint(P));
  670. end;
  671.  
  672. procedure TDBCtrlGrid.ReadState(Reader: TReader);
  673. begin
  674.   inherited ReadState(Reader);
  675.   FPanel.FixupTabList;
  676. end;
  677.  
  678. procedure TDBCtrlGrid.Reset;
  679. begin
  680.   if csDesigning in ComponentState then
  681.     FDataLink.BufferCount := 1 else
  682.     FDataLink.BufferCount := FColCount * FRowCount;
  683.   DataSetChanged(True);
  684. end;
  685.  
  686. procedure TDBCtrlGrid.Scroll(Inc: Integer; ScrollLock: Boolean);
  687. var
  688.   NewIndex, ScrollInc, Adjust: Integer;
  689. begin
  690.   if FDataLink.Active and (Inc <> 0) then
  691.     with FDataLink.DataSet do
  692.       if State = dsInsert then
  693.       begin
  694.         UpdateRecord;
  695.         if Modified then Post else
  696.           if (Inc < 0) or not EOF then Cancel;
  697.       end else
  698.       begin
  699.         CheckBrowseMode;
  700.         DisableControls;
  701.         try
  702.           if ScrollLock then
  703.             if Inc > 0 then
  704.               MoveBy(Inc - MoveBy(Inc + FDataLink.BufferCount - FPanelIndex - 1))
  705.             else
  706.               MoveBy(Inc - MoveBy(Inc - FPanelIndex))
  707.           else
  708.           begin
  709.             NewIndex := FPanelIndex + Inc;
  710.             if (NewIndex >= 0) and (NewIndex < FDataLink.BufferCount) then
  711.               MoveBy(Inc)
  712.             else
  713.               if MoveBy(Inc) = Inc then
  714.               begin
  715.                 if FOrientation = goVertical then
  716.                   ScrollInc := FColCount else
  717.                   ScrollInc := FRowCount;
  718.                 if Inc > 0 then
  719.                   Adjust := ScrollInc - 1 - NewIndex mod ScrollInc
  720.                 else
  721.                   Adjust := 1 - ScrollInc - (NewIndex + 1) mod ScrollInc;
  722.                 MoveBy(-MoveBy(Adjust));
  723.               end;
  724.           end;
  725.           if (Inc = 1) and EOF and FAllowInsert and CanModify then Append;
  726.         finally
  727.           EnableControls;
  728.         end;
  729.       end;
  730. end;
  731.  
  732. procedure TDBCtrlGrid.ScrollMessage(var Message: TWMScroll);
  733. var
  734.   Key: TDBCtrlGridKey;
  735.   SI: TScrollInfo;
  736. begin
  737.   if AcquireFocus then
  738.   begin
  739.     Key := gkNull;
  740.     case Message.ScrollCode of
  741.       SB_LINEUP: Key := gkScrollUp;
  742.       SB_LINEDOWN: Key := gkScrollDown;
  743.       SB_PAGEUP: Key := gkPageUp;
  744.       SB_PAGEDOWN: Key := gkPageDown;
  745.       SB_TOP: Key := gkHome;
  746.       SB_BOTTOM: Key := gkEnd;
  747.       SB_THUMBPOSITION:
  748.         if FDataLink.Active and FDataLink.DataSet.IsSequenced then
  749.         begin
  750.           SI.cbSize := sizeof(SI);
  751.           SI.fMask := SIF_ALL;
  752.           GetScrollInfo(Self.Handle, FScrollBarKind, SI);
  753.           if SI.nTrackPos <= 1 then Key := gkHome
  754.           else if SI.nTrackPos >= FDataLink.DataSet.RecordCount then Key := gkEnd
  755.           else
  756.           begin
  757.             FDataLink.DataSet.RecNo := SI.nTrackPos;
  758.             Exit;
  759.           end;
  760.         end else
  761.         begin
  762.           case Message.Pos of
  763.             0: Key := gkHome;
  764.             1: Key := gkPageUp;
  765.             3: Key := gkPageDown;
  766.             4: Key := gkEnd;
  767.           end;
  768.         end;
  769.     end;
  770.     DoKey(Key);
  771.   end;
  772. end;
  773.  
  774. function TDBCtrlGrid.FindNext(StartControl: TWinControl; GoForward: Boolean;
  775.   var WrapFlag: Integer): TWinControl;
  776. var
  777.   I, StartIndex: Integer;
  778.   List: TList;
  779. begin
  780.   List := TList.Create;
  781.   try
  782.     StartIndex := 0;
  783.     I := 0;
  784.     Result := StartControl;
  785.     FPanel.GetTabOrderList(List);
  786.     if List.Count > 0 then
  787.     begin
  788.       StartIndex := List.IndexOf(StartControl);
  789.       if StartIndex = -1 then
  790.         if GoForward then
  791.           StartIndex := List.Count - 1 else
  792.           StartIndex := 0;
  793.       I := StartIndex;
  794.       repeat
  795.         if GoForward then
  796.         begin
  797.           Inc(I);
  798.           if I = List.Count then I := 0;
  799.         end else
  800.         begin
  801.           if I = 0 then I := List.Count;
  802.           Dec(I);
  803.         end;
  804.         Result := List[I];
  805.       until (Result.CanFocus and Result.TabStop) or (I = StartIndex);
  806.     end;
  807.     WrapFlag := 0;
  808.     if GoForward then
  809.     begin
  810.       if I <= StartIndex then WrapFlag := 1;
  811.     end else
  812.     begin
  813.       if I >= StartIndex then WrapFlag := -1;
  814.     end;
  815.   finally
  816.     List.Free;
  817.   end;
  818. end;
  819.  
  820. procedure TDBCtrlGrid.SelectNext(GoForward: Boolean);
  821. var
  822.   WrapFlag: Integer;
  823.   ParentForm: TCustomForm;
  824.   ActiveControl, Control: TWinControl;
  825. begin
  826.   ParentForm := GetParentForm(Self);
  827.   if ParentForm <> nil then
  828.   begin
  829.     ActiveControl := ParentForm.ActiveControl;
  830.     if ContainsControl(ActiveControl) then
  831.     begin
  832.       Control := FindNext(ActiveControl, GoForward, WrapFlag);
  833.       if not (FDataLink.DataSet.State in dsEditModes) then
  834.         FPanel.SetFocus;
  835.       try
  836.         if WrapFlag <> 0 then Scroll(WrapFlag, False);
  837.       except
  838.         ActiveControl.SetFocus;
  839.         raise;
  840.       end;
  841.       if not Control.CanFocus then
  842.         Control := FindNext(Control, GoForward, WrapFlag);
  843.       Control.SetFocus;
  844.     end;
  845.   end;
  846. end;
  847.  
  848. procedure TDBCtrlGrid.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  849. var
  850.   ScrollWidth, ScrollHeight, NewPanelWidth, NewPanelHeight: Integer;
  851. begin
  852.   ScrollWidth := 0;
  853.   ScrollHeight := 0;
  854.   if FOrientation = goVertical then
  855.     ScrollWidth := GetSystemMetrics(SM_CXVSCROLL) else
  856.     ScrollHeight := GetSystemMetrics(SM_CYHSCROLL);
  857.   NewPanelWidth := (AWidth - ScrollWidth) div FColCount;
  858.   NewPanelHeight := (AHeight - ScrollHeight) div FRowCount;
  859.   if NewPanelWidth < 1 then NewPanelWidth := 1;
  860.   if NewPanelHeight < 1 then NewPanelHeight := 1;
  861.   if (FPanelWidth <> NewPanelWidth) or (FPanelHeight <> NewPanelHeight) then
  862.   begin
  863.     FPanelWidth := NewPanelWidth;
  864.     FPanelHeight := NewPanelHeight;
  865.     Reset;
  866.   end;
  867.   inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  868. end;
  869.  
  870. procedure TDBCtrlGrid.SetColCount(Value: Integer);
  871. begin
  872.   if Value < 1 then Value := 1;
  873.   if Value > 100 then Value := 100;
  874.   if FColCount <> Value then
  875.   begin
  876.     FColCount := Value;
  877.     AdjustSize;
  878.   end;
  879. end;
  880.  
  881. procedure TDBCtrlGrid.SetDataSource(Value: TDataSource);
  882. begin
  883.   FDataLink.DataSource := Value;
  884.   UpdateDataLinks(FPanel, True);
  885. end;
  886.  
  887. procedure TDBCtrlGrid.SetEditMode(Value: Boolean);
  888. var
  889.   Control: TWinControl;
  890. begin
  891.   if GetEditMode <> Value then
  892.     if Value then
  893.     begin
  894.       Control := FPanel.FindNextControl(nil, True, True, False);
  895.       if Control <> nil then Control.SetFocus;
  896.     end else
  897.       SetFocus;
  898. end;
  899.  
  900. procedure TDBCtrlGrid.SetOrientation(Value: TDBCtrlGridOrientation);
  901. begin
  902.   if FOrientation <> Value then
  903.   begin
  904.     FOrientation := Value;
  905.     RecreateWnd;
  906.     AdjustSize;
  907.   end;
  908. end;
  909.  
  910. procedure TDBCtrlGrid.SetPanelBorder(Value: TDBCtrlGridBorder);
  911. begin
  912.   if FPanelBorder <> Value then
  913.   begin
  914.     FPanelBorder := Value;
  915.     Invalidate;
  916.     FPanel.Invalidate;
  917.   end;
  918. end;
  919.  
  920. procedure TDBCtrlGrid.SetPanelHeight(Value: Integer);
  921. begin
  922.   if Value < 1 then Value := 1;
  923.   if Value > 65535 then Value := 65535;
  924.   if FPanelHeight <> Value then
  925.   begin
  926.     FPanelHeight := Value;
  927.     AdjustSize;
  928.   end;
  929. end;
  930.  
  931. procedure TDBCtrlGrid.SetPanelIndex(Value: Integer);
  932. begin
  933.   if FDataLink.Active and (Value < PanelCount) then
  934.     FDataLink.DataSet.MoveBy(Value - FPanelIndex);
  935. end;
  936.  
  937. procedure TDBCtrlGrid.SetPanelWidth(Value: Integer);
  938. begin
  939.   if Value < 1 then Value := 1;
  940.   if Value > 65535 then Value := 65535;
  941.   if FPanelWidth <> Value then
  942.   begin
  943.     FPanelWidth := Value;
  944.     AdjustSize;
  945.   end;
  946. end;
  947.  
  948. procedure TDBCtrlGrid.SetRowCount(Value: Integer);
  949. begin
  950.   if Value < 1 then Value := 1;
  951.   if Value > 100 then Value := 100;
  952.   if FRowCount <> Value then
  953.   begin
  954.     FRowCount := Value;
  955.     AdjustSize;
  956.   end;
  957. end;
  958.  
  959. procedure TDBCtrlGrid.SetSelectedColor(Value: TColor);
  960. begin
  961.   if Value <> FSelectedColor then
  962.   begin
  963.     FSelectedColor := Value;
  964.     FSelColorChanged := Value <> Color;
  965.     Invalidate;
  966.     FPanel.Invalidate;
  967.   end;
  968. end;
  969.  
  970. procedure TDBCtrlGrid.UpdateDataLinks(Control: TControl; Inserting: Boolean);
  971. var
  972.   I: Integer;
  973.   DataLink: TDataLink;
  974. begin
  975.   if Inserting and not (csReplicatable in Control.ControlStyle) then
  976.     DatabaseError(SNotReplicatable);
  977.   DataLink := TDataLink(Control.Perform(CM_GETDATALINK, 0, 0));
  978.   if DataLink <> nil then
  979.   begin
  980.     DataLink.DataSourceFixed := False;
  981.     if Inserting then
  982.     begin
  983.       DataLink.DataSource := DataSource;
  984.       DataLink.DataSourceFixed := True;
  985.     end;
  986.   end;
  987.   if Control is TWinControl then
  988.     with TWinControl(Control) do
  989.       for I := 0 to ControlCount - 1 do
  990.         UpdateDataLinks(Controls[I], Inserting);
  991. end;
  992.  
  993. procedure TDBCtrlGrid.UpdateScrollBar;
  994. var
  995.   SIOld, SINew: TScrollInfo;
  996. begin
  997.   if FDatalink.Active and HandleAllocated then
  998.     with FDatalink.DataSet do
  999.     begin
  1000.       SIOld.cbSize := sizeof(SIOld);
  1001.       SIOld.fMask := SIF_ALL;
  1002.       GetScrollInfo(Self.Handle, FScrollBarKind, SIOld);
  1003.       SINew := SIOld;
  1004.       if IsSequenced then
  1005.       begin
  1006.         SINew.nMin := 1;
  1007.         SINew.nPage := Self.RowCount * Self.ColCount;
  1008.         SINew.nMax := DWORD(RecordCount) + SINew.nPage - 1;
  1009.         if State in [dsInactive, dsBrowse, dsEdit] then
  1010.           SINew.nPos := RecNo;
  1011.       end
  1012.       else
  1013.       begin
  1014.         SINew.nMin := 0;
  1015.         SINew.nPage := 0;
  1016.         SINew.nMax := 4;
  1017.         if BOF then SINew.nPos := 0
  1018.         else if EOF then SINew.nPos := 4
  1019.         else SINew.nPos := 2;
  1020.       end;
  1021.       if (SINew.nMin <> SIOld.nMin) or (SINew.nMax <> SIOld.nMax) or
  1022.         (SINew.nPage <> SIOld.nPage) or (SINew.nPos <> SIOld.nPos) then
  1023.         SetScrollInfo(Self.Handle, FScrollBarKind, SINew, True);
  1024.     end;
  1025. end;
  1026.  
  1027. procedure TDBCtrlGrid.WMLButtonDown(var Message: TWMLButtonDown);
  1028. var
  1029.   I: Integer;
  1030.   P: TPoint;
  1031.   Window: HWnd;
  1032. begin
  1033.   if FDataLink.Active then
  1034.   begin
  1035.     P := SmallPointToPoint(Message.Pos);
  1036.     for I := 0 to FPanelCount - 1 do
  1037.       if (I <> FPanelIndex) and PtInRect(GetPanelBounds(I), P) then
  1038.       begin
  1039.         FClicking := True;
  1040.         try
  1041.           SetPanelIndex(I);
  1042.         finally
  1043.           FClicking := False;
  1044.         end;
  1045.         P := ClientToScreen(P);
  1046.         Window := WindowFromPoint(P);
  1047.         if IsChild(FPanel.Handle, Window) then
  1048.         begin
  1049.           Windows.ScreenToClient(Window, P);
  1050.           Message.Pos := PointToSmallPoint(P);
  1051.           with TMessage(Message) do SendMessage(Window, Msg, WParam, LParam);
  1052.           Exit;
  1053.         end;
  1054.         Break;
  1055.       end;
  1056.   end;
  1057.   if AcquireFocus then
  1058.   begin
  1059.     if PointInPanel(Message.Pos) then
  1060.     begin
  1061.       EditMode := False;
  1062.       Click;
  1063.     end;
  1064.     inherited;
  1065.   end;
  1066. end;
  1067.  
  1068. procedure TDBCtrlGrid.WMLButtonDblClk(var Message: TWMLButtonDblClk);
  1069. begin
  1070.   if PointInPanel(Message.Pos) then DblClick;
  1071.   inherited;
  1072. end;
  1073.  
  1074. procedure TDBCtrlGrid.WMHScroll(var Message: TWMHScroll);
  1075. begin
  1076.   ScrollMessage(Message);
  1077. end;
  1078.  
  1079. procedure TDBCtrlGrid.WMVScroll(var Message: TWMVScroll);
  1080. begin
  1081.   ScrollMessage(Message);
  1082. end;
  1083.  
  1084. procedure TDBCtrlGrid.WMEraseBkgnd(var Message: TMessage);
  1085. begin
  1086.   Message.Result := 1;
  1087. end;
  1088.  
  1089. procedure TDBCtrlGrid.WMPaint(var Message: TWMPaint);
  1090. begin
  1091.   PaintHandler(Message);
  1092. end;
  1093.  
  1094. procedure TDBCtrlGrid.WMSetFocus(var Message: TWMSetFocus);
  1095. begin
  1096.   FFocused := True;
  1097.   FPanel.Repaint;
  1098. end;
  1099.  
  1100. procedure TDBCtrlGrid.WMKillFocus(var Message: TWMKillFocus);
  1101. begin
  1102.   FFocused := False;
  1103.   FPanel.Repaint;
  1104. end;
  1105.  
  1106. procedure TDBCtrlGrid.WMGetDlgCode(var Message: TWMGetDlgCode);
  1107. begin
  1108.   Message.Result := DLGC_WANTARROWS or DLGC_WANTCHARS;
  1109. end;
  1110.  
  1111. procedure TDBCtrlGrid.WMSize(var Message: TMessage);
  1112. begin
  1113.   inherited;
  1114.   Invalidate;
  1115. end;
  1116.  
  1117. function GetShiftState: TShiftState;
  1118. begin
  1119.   Result := [];
  1120.   if GetKeyState(VK_SHIFT) < 0 then Include(Result, ssShift);
  1121.   if GetKeyState(VK_CONTROL) < 0 then Include(Result, ssCtrl);
  1122.   if GetKeyState(VK_MENU) < 0 then Include(Result, ssAlt);
  1123. end;
  1124.  
  1125. procedure TDBCtrlGrid.CMChildKey(var Message: TCMChildKey);
  1126. var
  1127.   ShiftState: TShiftState;
  1128.   GridKey: TDBCtrlGridKey;
  1129. begin
  1130.   with Message do
  1131.     if Sender <> Self then
  1132.     begin
  1133.       ShiftState := GetShiftState;
  1134.       if Assigned(OnKeyDown) then OnKeyDown(Sender, CharCode, ShiftState);
  1135.       GridKey := gkNull;
  1136.       case CharCode of
  1137.         VK_TAB:
  1138.           if not (ssCtrl in ShiftState) and
  1139.             (Sender.Perform(WM_GETDLGCODE, 0, 0) and DLGC_WANTTAB = 0) then
  1140.             if ssShift in ShiftState then
  1141.               GridKey := gkPriorTab else
  1142.               GridKey := gkNextTab;
  1143.         VK_RETURN:
  1144.           if (Sender.Perform(WM_GETDLGCODE, 0, 0) and DLGC_WANTALLKEYS = 0) then
  1145.             GridKey := gkEditMode;
  1146.         VK_F2: GridKey := gkEditMode;
  1147.         VK_ESCAPE: GridKey := gkCancel;
  1148.       end;
  1149.       if GridKey <> gkNull then
  1150.       begin
  1151.         DoKey(GridKey);
  1152.         Result := 1;
  1153.         Exit;
  1154.       end;
  1155.     end;
  1156.   inherited;
  1157. end;
  1158.  
  1159. procedure TDBCtrlGrid.CMColorChanged(var Message: TMessage);
  1160. begin
  1161.   inherited;
  1162.   if not FSelColorChanged then
  1163.     FSelectedColor := Color;
  1164. end;
  1165.  
  1166. { Defer action processing to datalink }
  1167.  
  1168. function TDBCtrlGrid.ExecuteAction(Action: TBasicAction): Boolean;
  1169. begin
  1170.   Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
  1171.     FDataLink.ExecuteAction(Action);
  1172. end;
  1173.  
  1174. function TDBCtrlGrid.UpdateAction(Action: TBasicAction): Boolean;
  1175. begin
  1176.   Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
  1177.     FDataLink.UpdateAction(Action);
  1178. end;
  1179.  
  1180. end.
  1181.