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