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 29 by tony, Sat May 9 11:37:49 2015 UTC vs.
Revision 263 by tony, Thu Dec 6 15:55:01 2018 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 152 | 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 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
# Line 365 | Line 368 | begin
368      for i := StartIndex to Length(FList) - 1 do
369      begin
370        FList[i].FState := rcEmpty;
371 +      FList[i].FBitmap := nil;
372        FList[i].FAlternateColor := altColor;
373        if UseAlternateColors then
374          altColor := not altColor;
# Line 412 | Line 416 | end;
416   procedure TRowCache.ClearCache;
417   begin
418    FreeImages(true);
419 +  SetLength(FList,0);
420   end;
421  
422   function TRowCache.Add2Cache(RecNo: Longint; Control: TWinControl): TBitmap;
418 var i: integer;
423   begin
424    Dec(RecNo); {Adust to zero base}
425    ExtendCache(RecNo + 1);
426    FList[RecNo].FState := rcPresent;
427 +  if FList[RecNo].FBitmap <> nil then
428 +    FList[RecNo].FBitmap.Free;
429    FList[RecNo].FBitmap := Render(Control);
430    Result := FList[RecNo].FBitmap;
431   end;
# Line 476 | Line 482 | begin
482    if FList[RecNo].FState = rcPresent then
483    begin
484      FList[RecNo].FBitmap.Free;
485 +    FList[RecNo].FBitmap := nil;
486      FList[RecNo].FState := rcEmpty;
487    end;
488   end;
# Line 522 | Line 529 | end;
529  
530   { TDBControlGrid }
531  
532 + function TDBControlGrid.ActiveControl: TControl;
533 + var AParent: TWinControl;
534 + begin
535 +  Result := nil;
536 +  AParent := Parent;
537 +  while (AParent <> nil) and  not (AParent is TCustomForm) do
538 +    AParent := AParent.Parent;
539 +  if (AParent <> nil) and (AParent is TCustomForm)then
540 +      Result := TCustomForm(AParent).ActiveControl;
541 + end;
542 +
543   procedure TDBControlGrid.EmptyGrid;
544   var
545    OldFixedRows: Integer;
546   begin
547    OldFixedRows := FixedRows;
548    Clear;
549 +  FRowCache.ClearCache;
550    RowCount := OldFixedRows + 1;
551    if dgpIndicator in FOptions then
552      ColWidths[0]:=12;
# Line 580 | Line 599 | begin
599      and ValidDataSet and FDatalink.DataSet.CanModify;
600   end;
601  
583
602   procedure TDBControlGrid.DoDrawRow(aRow: integer; aRect: TRect;
603    aState: TGridDrawState);
604   var CachedRow: TBitmap;
# Line 593 | Line 611 | begin
611      begin
612        FCacheRefreshQueued := true;
613        Application.QueueAsyncCall(@DoMoveRecord,PtrInt(aRow));
614 <    end
614 >    end;
615 >    Canvas.FillRect(aRect);
616    end
617    else
618       Canvas.Draw(aRect.Left,aRect.Top,CachedRow)
# Line 608 | Line 627 | begin
627    aRow := integer(Data);
628    FInCacheRefresh := true;
629    if assigned(FDataLink.DataSet) then
630 <    FDatalink.DataSet.MoveBy(aRow - FDrawRow)
630 >    FDatalink.DataSet.MoveBy(aRow - FDrawRow);
631   end;
632  
633   procedure TDBControlGrid.DoSetupDrawPanel(Data: PtrInt);
# Line 644 | Line 663 | end;
663   procedure TDBControlGrid.KeyDownHandler(Sender: TObject; var Key: Word;
664    Shift: TShiftState);
665   var Done: boolean;
666 +    AControl: TControl;
667   begin
668    if Visible and assigned(FDrawPanel) and FDrawPanel.Visible and FWeHaveFocus then
669    begin
670 +    AControl := ActiveControl;
671 +    if (AControl <> nil) and (AControl is TCustomComboBox)
672 +                         and ((Key in [VK_UP,VK_DOWN]) or
673 +                         (TCustomComboBox(AControl).DroppedDown and (Key = VK_RETURN)) or
674 +                         ((TCustomComboBox(AControl).Text <> '') and (Key =  VK_ESCAPE))) then
675 +      Exit; {ignore these keys if we are in a  combobox}
676 +
677 +    if (AControl <> nil) and (AControl is TCustomMemo)
678 +                         and (Key in [VK_RETURN,VK_UP,VK_DOWN]) then Exit; {Ignore Return in a CustomMemo}
679 +
680 +    if (AControl <> nil) and (AControl is TCustomGrid)
681 +                         and (Key in [VK_RETURN,VK_UP,VK_DOWN,VK_TAB]) then Exit; {Ignore Return in a CustomMemo}
682 +
683 +    if (AControl <> nil) and ((AControl is TDateEdit) or (AControl is TCustomMaskedit))
684 +                         and (Key in [VK_RETURN,VK_UP,VK_DOWN,
685 +                               VK_ESCAPE,VK_LEFT,VK_RIGHT]) then Exit; {Ignore Return in a CustomMemo}
686      Done := false;
687      if assigned(FOnKeyDownHander) then
688        OnKeyDownHander(Sender,Key,Shift,Done);
# Line 668 | Line 704 | begin
704        and (FModified or (FRowCache.IsEmpty(aDataSet.RecNo))) then
705    begin
706      RecNo := aDataSet.RecNo;
671    Application.ProcessMessages;  {A couple of trips round the message loop seems to be necessary}
707      Application.ProcessMessages;
708      if RecNo = aDataSet.RecNo then   {Guard against sudden changes}
709 <      FRowCache.Add2Cache(aDataSet.RecNo,FDrawPanel);
709 >      FRowCache.Add2Cache(RecNo,FDrawPanel);
710    end;
711   end;
712  
713   procedure TDBControlGrid.OnDataSetChanged(aDataSet: TDataSet);
714   begin
715 <  if (aDataSet.State = dsBrowse) and (FLastRecordCount >  GetRecordCount) then
715 >  if aDataSet.State = dsBrowse then
716    begin
717 <    {must be delete}
718 <    FRowCache.MarkAsDeleted(FSelectedRecNo);
719 <    Dec(FSelectedRow);
717 >    if GetRecordCount = 0 then
718 >    begin
719 >      {Must be closed/reopened}
720 >      FRowCache.ClearCache;
721 >      FSelectedRow := 0;
722 >    end
723 >    else
724 >    if FLastRecordCount >  GetRecordCount then
725 >    begin
726 >      {must be delete}
727 >      FRowCache.MarkAsDeleted(FSelectedRecNo);
728 >      Dec(FSelectedRow);
729 >    end;
730      LayoutChanged;
731    end;
732    FLastRecordCount := GetRecordCount;
# Line 820 | Line 865 | end;
865  
866   procedure TDBControlGrid.SetupDrawPanel(aRow: integer);
867   begin
868 +  if FDrawPanel = nil then Exit;
869    if ValidDataSet and FRowCache.AlternateColor[FDataLink.DataSet.RecNo] then
870      FDrawPanel.Color := AlternateColor
871    else
# Line 1131 | Line 1177 | begin
1177      result := dsInactive;
1178   end;
1179  
1134 var
1135  DataCol: Integer;
1180   begin
1181    PrepareCanvas(aCol, aRow, aState);
1182  
1183    if aCol < FixedCols then
1184       DrawIndicator(Canvas,aRow, aRect,GetDataSetState,false)
1185    else
1186 <  if FDrawPanel = nil then
1187 <    DrawFillRect(Canvas,aRect)    else
1186 >  if (FDrawPanel = nil) or not FDataLink.Active then
1187 >    DrawFillRect(Canvas,aRect)
1188 >  else
1189    if not FDrawingActiveRecord and FDataLink.Active then
1190        DoDrawRow(aRow,aRect,aState);
1191    {if we are drawing the active record then this is rendered by the Draw Panel
# Line 1242 | Line 1287 | end;
1287   procedure TDBControlGrid.KeyDown(var Key: Word; Shift: TShiftState);
1288   type
1289    TOperation=(opMoveBy,opCancel,opAppend,opInsert,opDelete);
1245 var
1246  DeltaCol,DeltaRow: Integer;
1290  
1291    procedure DoOnKeyDown;
1292    begin
# Line 1386 | Line 1429 | begin
1429      FInCacheRefresh := false;
1430      FCacheRefreshQueued := false;
1431      Row := FixedRows;
1432 +    FDrawingActiveRecord := false;
1433 +    FSelectedRecNo := 0;
1434 +    FSelectedRow := 0;
1435 +    FRequiredRecNo := 0;
1436    end;
1437    FRowCache.UseAlternateColors := AlternateColor <> Color;
1438    FRowCache.AltColorStartNormal := AltColorStartNormal;
# Line 1641 | Line 1688 | begin
1688      FDataLink.Free;
1689    end;
1690    if assigned(FRowCache) then FRowCache.Free;
1691 +  Application.RemoveAsyncCalls(self);
1692    inherited Destroy;
1693   end;
1694  
# Line 1679 | Line 1727 | begin
1727   end;
1728  
1729   end.
1730 +

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines