ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/branches/journaling/ibcontrols/DBControlGrid.pas

Comparing:
ibx/trunk/ibcontrols/DBControlGrid.pas (file contents), Revision 23 by tony, Fri Mar 13 10:26:52 2015 UTC vs.
ibx/branches/journaling/ibcontrols/DBControlGrid.pas (file contents), Revision 362 by tony, Tue Dec 7 13:27:39 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 158 | Line 163 | type
163		function  GridCanModify: boolean;
164		procedure DoDrawRow(aRow: integer; aRect: TRect; aState: TGridDrawState);
165		procedure DoMoveRecord(Data: PtrInt);
166	+	procedure DoSelectNext(Data: PtrInt);
167		procedure DoScrollDataSet(Data: PtrInt);
168		procedure DoSetupDrawPanel(Data: PtrInt);
169		procedure DoSendMouseClicks(Data: PtrInt);
#	Line 235 | Line 241 | type
241		property Color;
242		property Constraints;
243		property DataSource: TDataSource read GetDataSource write SetDataSource;
238	–	property DefaultRowHeight;
244		property DefaultPositionAtEnd: boolean read  FDefaultPositionAtEnd write FDefaultPositionAtEnd;
245		property DragCursor;
246		property DragMode;
#	Line 283 | 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 298 | Line 303 | end;
303
304		function TRowCache.Render(Control: TWinControl): TBitmap;
305		var Container: TBitmap;
301	–	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 364 | 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 411 | 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;
417	–	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 466 | 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 508 | 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 566 | Line 601 | begin
601		and ValidDataSet and FDatalink.DataSet.CanModify;
602		end;
603
569	–
604		procedure TDBControlGrid.DoDrawRow(aRow: integer; aRect: TRect;
605		aState: TGridDrawState);
606		var CachedRow: TBitmap;
#	Line 579 | 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 594 | 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 630 | 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 654 | Line 707 | begin
707		and (FModified or (FRowCache.IsEmpty(aDataSet.RecNo))) then
708		begin
709		RecNo := aDataSet.RecNo;
657	–	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;
736		if aDataSet.State = dsInsert then
737	+	begin
738		FRequiredRecNo := aDataSet.RecNo + 1;
739	+	Application.QueueAsyncCall(@DoSelectNext,0);
740	+	end;
741		UpdateActive
742		end;
743
#	Line 761 | 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 778 | 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 802 | 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 1066 | Line 1133 | begin
1133		FDataLink.DataSet.MoveBy(integer(Data) - FDataLink.DataSet.RecNo);
1134		end;
1135
1136	+	procedure TDBControlGrid.DoSelectNext(Data: PtrInt);
1137	+	begin
1138	+	FDataLink.DataSet.MoveBy(1);
1139	+	end;
1140	+
1141		procedure TDBControlGrid.DrawAllRows;
1142		begin
1143		inherited DrawAllRows;
#	Line 1108 | Line 1180 | begin
1180		result := dsInactive;
1181		end;
1182
1111	–	var
1112	–	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 1217 | Line 1290 | end;
1290		procedure TDBControlGrid.KeyDown(var Key: Word; Shift: TShiftState);
1291		type
1292		TOperation=(opMoveBy,opCancel,opAppend,opInsert,opDelete);
1220	–	var
1221	–	DeltaCol,DeltaRow: Integer;
1293
1294		procedure DoOnKeyDown;
1295		begin
#	Line 1361 | 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 1550 | 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 1612 | 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 1650 | Line 1732 | begin
1732		end;
1733
1734		end.
1735	+

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines