ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/ibcontrols/DBControlGrid.pas
(Generate patch)

Comparing ibx/trunk/ibcontrols/DBControlGrid.pas (file contents):
Revision 27 by tony, Tue Apr 14 13:10:23 2015 UTC vs.
Revision 317 by tony, Thu Feb 25 12:01:13 2021 UTC

# Line 1 | Line 1
1 +  
2   {
3   /***************************************************************************
4                                 DBControlGrid.pas
# Line 67 | Line 68 | uses
68   }
69  
70   type
70  TRowCacheState = (rcEmpty,rcPresent,rcDeleted);
71  TRowDetails = record
72    FState: TRowCacheState;
73    FAlternateColor: boolean;
74    FBitmap: TBitmap;
75  end;
76
71    { TRowCache }
72  
73    TRowCache = class
74    private
75 +    type
76 +      TRowCacheState = (rcEmpty,rcPresent,rcDeleted);
77 +      TRowDetails = record
78 +        FState: TRowCacheState;
79 +        FAlternateColor: boolean;
80 +        FBitmap: TBitmap;
81 +  end;
82 +
83 +  private
84      FAltColorStartNormal: boolean;
85      FHeight: integer;
86      FList: array of TRowDetails;
# Line 97 | Line 100 | type
100      procedure ClearCache;
101      function Add2Cache(RecNo: Longint; Control: TWinControl): TBitmap;
102      function GetRowImage(RecNo, Offset: integer): TBitmap;
103 +    procedure InvalidateRowImage(RecNo: integer);
104      function IsEmpty(RecNo: integer): boolean;
105      procedure MarkAsDeleted(RecNo: integer);
106      property AlternateColor[RecNo: integer]: boolean read GetAlternateColor;
# Line 151 | Line 155 | type
155      FLastMouseButton: TMouseButton;
156      FLastMouseShiftState: TShiftState;
157  
158 +    function ActiveControl: TControl;
159      procedure EmptyGrid;
160      function GetDataSource: TDataSource;
161      function GetRecordCount: Integer;
# Line 236 | Line 241 | type
241      property Color;
242      property Constraints;
243      property DataSource: TDataSource read GetDataSource write SetDataSource;
239    property DefaultRowHeight;
244      property DefaultPositionAtEnd: boolean read  FDefaultPositionAtEnd write FDefaultPositionAtEnd;
245      property DragCursor;
246      property DragMode;
# Line 284 | Line 288 | end;
288  
289   implementation
290  
291 < uses LCLType, Math, LCLIntf, Forms, LCLMessageGlue;
291 > uses LCLType, Math, LCLIntf, Forms, LCLMessageGlue, EditBtn, MaskEdit;
292  
293   { TDBControlGridDataLink }
294  
# Line 299 | Line 303 | end;
303  
304   function TRowCache.Render(Control: TWinControl): TBitmap;
305   var Container: TBitmap;
302     Msg: TLMPaint;
306   begin
307    Container := TBitmap.Create;
308    try
309      Container.SetSize(Control.Width,Control.Height);
310 +    Container.Canvas.Brush.Color := control.Color;
311 +    Container.Canvas.FillRect(0,0,Control.Width,Control.Height);
312      Control.PaintTo(Container.Canvas,0,0);
313    except
314      Container.Free;
# Line 365 | Line 370 | begin
370      for i := StartIndex to Length(FList) - 1 do
371      begin
372        FList[i].FState := rcEmpty;
373 +      FList[i].FBitmap := nil;
374        FList[i].FAlternateColor := altColor;
375        if UseAlternateColors then
376          altColor := not altColor;
# Line 412 | Line 418 | end;
418   procedure TRowCache.ClearCache;
419   begin
420    FreeImages(true);
421 +  SetLength(FList,0);
422   end;
423  
424   function TRowCache.Add2Cache(RecNo: Longint; Control: TWinControl): TBitmap;
418 var i: integer;
425   begin
426    Dec(RecNo); {Adust to zero base}
427    ExtendCache(RecNo + 1);
428    FList[RecNo].FState := rcPresent;
429 +  if FList[RecNo].FBitmap <> nil then
430 +    FList[RecNo].FBitmap.Free;
431    FList[RecNo].FBitmap := Render(Control);
432    Result := FList[RecNo].FBitmap;
433   end;
# Line 467 | Line 475 | begin
475    until false;
476   end;
477  
478 + procedure TRowCache.InvalidateRowImage(RecNo: integer);
479 + begin
480 +  Dec(RecNo); {adjust to zero base}
481 +  if (RecNo < 0) or (RecNo >= Length(FList)) then
482 +    Exit;
483 +
484 +  if FList[RecNo].FState = rcPresent then
485 +  begin
486 +    FList[RecNo].FBitmap.Free;
487 +    FList[RecNo].FBitmap := nil;
488 +    FList[RecNo].FState := rcEmpty;
489 +  end;
490 + end;
491 +
492   function TRowCache.IsEmpty(RecNo: integer): boolean;
493   begin
494    Dec(RecNo);
# Line 509 | Line 531 | end;
531  
532   { TDBControlGrid }
533  
534 + function TDBControlGrid.ActiveControl: TControl;
535 + var AParent: TWinControl;
536 + begin
537 +  Result := nil;
538 +  AParent := Parent;
539 +  while (AParent <> nil) and  not (AParent is TCustomForm) do
540 +    AParent := AParent.Parent;
541 +  if (AParent <> nil) and (AParent is TCustomForm)then
542 +      Result := TCustomForm(AParent).ActiveControl;
543 + end;
544 +
545   procedure TDBControlGrid.EmptyGrid;
546   var
547    OldFixedRows: Integer;
548   begin
549    OldFixedRows := FixedRows;
550    Clear;
551 +  FRowCache.ClearCache;
552    RowCount := OldFixedRows + 1;
553    if dgpIndicator in FOptions then
554      ColWidths[0]:=12;
# Line 567 | Line 601 | begin
601      and ValidDataSet and FDatalink.DataSet.CanModify;
602   end;
603  
570
604   procedure TDBControlGrid.DoDrawRow(aRow: integer; aRect: TRect;
605    aState: TGridDrawState);
606   var CachedRow: TBitmap;
# Line 580 | Line 613 | begin
613      begin
614        FCacheRefreshQueued := true;
615        Application.QueueAsyncCall(@DoMoveRecord,PtrInt(aRow));
616 <    end
616 >    end;
617 >    Canvas.FillRect(aRect);
618    end
619    else
620       Canvas.Draw(aRect.Left,aRect.Top,CachedRow)
# Line 595 | Line 629 | begin
629    aRow := integer(Data);
630    FInCacheRefresh := true;
631    if assigned(FDataLink.DataSet) then
632 <    FDatalink.DataSet.MoveBy(aRow - FDrawRow)
632 >    FDatalink.DataSet.MoveBy(aRow - FDrawRow);
633   end;
634  
635   procedure TDBControlGrid.DoSetupDrawPanel(Data: PtrInt);
# Line 631 | Line 665 | end;
665   procedure TDBControlGrid.KeyDownHandler(Sender: TObject; var Key: Word;
666    Shift: TShiftState);
667   var Done: boolean;
668 +    AControl: TControl;
669   begin
670 <  if Visible and assigned(FDrawPanel) and FDrawPanel.Visible and FWeHaveFocus then
670 >  if Visible and assigned(FDrawPanel) and FDrawPanel.Visible and FWeHaveFocus
671 >    and (Self.Owner=Screen.ActiveForm) then
672    begin
673 +    AControl := ActiveControl;
674 +    if (AControl <> nil) and (AControl is TCustomComboBox)
675 +                         and ((Key in [VK_UP,VK_DOWN]) or
676 +                         (TCustomComboBox(AControl).DroppedDown and (Key = VK_RETURN)) or
677 +                         ((TCustomComboBox(AControl).Text <> '') and (Key =  VK_ESCAPE))) then
678 +      Exit; {ignore these keys if we are in a  combobox}
679 +
680 +    if (AControl <> nil) and (AControl is TCustomMemo)
681 +                         and (Key in [VK_RETURN,VK_UP,VK_DOWN]) then Exit; {Ignore Return in a CustomMemo}
682 +
683 +    if (AControl <> nil) and (AControl is TCustomGrid)
684 +                         and (Key in [VK_RETURN,VK_UP,VK_DOWN,VK_TAB]) then Exit; {Ignore Return in a CustomMemo}
685 +
686 +    if (AControl <> nil) and ((AControl is TDateEdit) or (AControl is TCustomMaskedit))
687 +                         and (Key in [VK_RETURN,VK_UP,VK_DOWN,
688 +                               VK_ESCAPE,VK_LEFT,VK_RIGHT]) then Exit; {Ignore Return in a CustomMemo}
689      Done := false;
690      if assigned(FOnKeyDownHander) then
691        OnKeyDownHander(Sender,Key,Shift,Done);
# Line 655 | Line 707 | begin
707        and (FModified or (FRowCache.IsEmpty(aDataSet.RecNo))) then
708    begin
709      RecNo := aDataSet.RecNo;
658    Application.ProcessMessages;  {A couple of trips round the message loop seems to be necessary}
710      Application.ProcessMessages;
711      if RecNo = aDataSet.RecNo then   {Guard against sudden changes}
712 <      FRowCache.Add2Cache(aDataSet.RecNo,FDrawPanel);
712 >      FRowCache.Add2Cache(RecNo,FDrawPanel);
713    end;
714   end;
715  
716   procedure TDBControlGrid.OnDataSetChanged(aDataSet: TDataSet);
717   begin
718 <  if (aDataSet.State = dsBrowse) and (FLastRecordCount >  GetRecordCount) then
718 >  if aDataSet.State = dsBrowse then
719    begin
720 <    {must be delete}
721 <    FRowCache.MarkAsDeleted(FSelectedRecNo);
722 <    Dec(FSelectedRow);
720 >    if GetRecordCount = 0 then
721 >    begin
722 >      {Must be closed/reopened}
723 >      FRowCache.ClearCache;
724 >      FSelectedRow := 0;
725 >    end
726 >    else
727 >    if FLastRecordCount >  GetRecordCount then
728 >    begin
729 >      {must be delete}
730 >      FRowCache.MarkAsDeleted(FSelectedRecNo);
731 >      Dec(FSelectedRow);
732 >    end;
733      LayoutChanged;
734    end;
735    FLastRecordCount := GetRecordCount;
# Line 765 | Line 826 | begin
826       RemoveFreeNotification(FDrawPanel);
827       FDrawPanel.RemoveAllHandlersOfObject(self);
828       theForm := Parent;
829 <     while not (theForm is TCustomForm) and (theForm.Parent <> nil) do
829 >     while not ((theForm is TCustomForm) or (theForm is TCustomFrame))
830 >                           and (theForm.Parent <> nil) do
831         theForm := theForm.Parent;
832       FDrawPanel.Parent := theForm;
833    end;
# Line 782 | Line 844 | begin
844         FDrawPanel.Visible := false;
845        FRowCache.Height := FDrawPanel.Height;
846        FRowCache.Width := FDrawPanel.Width;
847 <      AddHandlerOnResize(@OnDrawPanelResize);
847 >      FDrawPanel.AddHandlerOnResize(@OnDrawPanelResize);
848        FreeNotification(FDrawPanel);
849      end;
850    except
# Line 806 | Line 868 | end;
868  
869   procedure TDBControlGrid.SetupDrawPanel(aRow: integer);
870   begin
871 +  if FDrawPanel = nil then Exit;
872    if ValidDataSet and FRowCache.AlternateColor[FDataLink.DataSet.RecNo] then
873      FDrawPanel.Color := AlternateColor
874    else
# Line 1117 | Line 1180 | begin
1180      result := dsInactive;
1181   end;
1182  
1120 var
1121  DataCol: Integer;
1183   begin
1184    PrepareCanvas(aCol, aRow, aState);
1185  
1186    if aCol < FixedCols then
1187       DrawIndicator(Canvas,aRow, aRect,GetDataSetState,false)
1188    else
1189 +  if (FDrawPanel = nil) or not FDataLink.Active then
1190 +    DrawFillRect(Canvas,aRect)
1191 +  else
1192    if not FDrawingActiveRecord and FDataLink.Active then
1193        DoDrawRow(aRow,aRect,aState);
1194    {if we are drawing the active record then this is rendered by the Draw Panel
# Line 1226 | Line 1290 | end;
1290   procedure TDBControlGrid.KeyDown(var Key: Word; Shift: TShiftState);
1291   type
1292    TOperation=(opMoveBy,opCancel,opAppend,opInsert,opDelete);
1229 var
1230  DeltaCol,DeltaRow: Integer;
1293  
1294    procedure DoOnKeyDown;
1295    begin
# Line 1370 | Line 1432 | begin
1432      FInCacheRefresh := false;
1433      FCacheRefreshQueued := false;
1434      Row := FixedRows;
1435 +    FDrawingActiveRecord := false;
1436 +    FSelectedRecNo := 0;
1437 +    FSelectedRow := 0;
1438 +    FRequiredRecNo := 0;
1439    end;
1440    FRowCache.UseAlternateColors := AlternateColor <> Color;
1441    FRowCache.AltColorStartNormal := AltColorStartNormal;
# Line 1559 | Line 1625 | begin
1625    PrevRow := Row;
1626    Row := FDrawRow;
1627    if not FInCacheRefresh then
1628 +  begin
1629      FSelectedRow := FDrawRow;
1630 +    if FDatalink.DataSet.State <> dsInsert then
1631 +      FRowCache.InvalidateRowImage(FSelectedRecNo);
1632 +  end;
1633    InvalidateRow(PrevRow);
1634    SetupDrawPanel(FDrawRow);
1635   end;
# Line 1621 | Line 1691 | begin
1691      FDataLink.Free;
1692    end;
1693    if assigned(FRowCache) then FRowCache.Free;
1694 +  if not (csDesigning in ComponentState) then
1695 +    Application.RemoveOnKeyDownBeforeHandler( @KeyDownHandler );
1696 +  Application.RemoveAsyncCalls(self);
1697    inherited Destroy;
1698   end;
1699  
# Line 1659 | Line 1732 | begin
1732   end;
1733  
1734   end.
1735 +

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines