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.
Revision 315 by tony, Thu Feb 25 11:56:36 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		Control.PaintTo(Container.Canvas,0,0);
312		except
313		Container.Free;
#	Line 364 | Line 369 | begin
369		for i := StartIndex to Length(FList) - 1 do
370		begin
371		FList[i].FState := rcEmpty;
372	+	FList[i].FBitmap := nil;
373		FList[i].FAlternateColor := altColor;
374		if UseAlternateColors then
375		altColor := not altColor;
#	Line 411 | Line 417 | end;
417		procedure TRowCache.ClearCache;
418		begin
419		FreeImages(true);
420	+	SetLength(FList,0);
421		end;
422
423		function TRowCache.Add2Cache(RecNo: Longint; Control: TWinControl): TBitmap;
417	–	var i: integer;
424		begin
425		Dec(RecNo); {Adust to zero base}
426		ExtendCache(RecNo + 1);
427		FList[RecNo].FState := rcPresent;
428	+	if FList[RecNo].FBitmap <> nil then
429	+	FList[RecNo].FBitmap.Free;
430		FList[RecNo].FBitmap := Render(Control);
431		Result := FList[RecNo].FBitmap;
432		end;
#	Line 466 | Line 474 | begin
474		until false;
475		end;
476
477	+	procedure TRowCache.InvalidateRowImage(RecNo: integer);
478	+	begin
479	+	Dec(RecNo); {adjust to zero base}
480	+	if (RecNo < 0) or (RecNo >= Length(FList)) then
481	+	Exit;
482	+
483	+	if FList[RecNo].FState = rcPresent then
484	+	begin
485	+	FList[RecNo].FBitmap.Free;
486	+	FList[RecNo].FBitmap := nil;
487	+	FList[RecNo].FState := rcEmpty;
488	+	end;
489	+	end;
490	+
491		function TRowCache.IsEmpty(RecNo: integer): boolean;
492		begin
493		Dec(RecNo);
#	Line 508 | Line 530 | end;
530
531		{ TDBControlGrid }
532
533	+	function TDBControlGrid.ActiveControl: TControl;
534	+	var AParent: TWinControl;
535	+	begin
536	+	Result := nil;
537	+	AParent := Parent;
538	+	while (AParent <> nil) and  not (AParent is TCustomForm) do
539	+	AParent := AParent.Parent;
540	+	if (AParent <> nil) and (AParent is TCustomForm)then
541	+	Result := TCustomForm(AParent).ActiveControl;
542	+	end;
543	+
544		procedure TDBControlGrid.EmptyGrid;
545		var
546		OldFixedRows: Integer;
547		begin
548		OldFixedRows := FixedRows;
549		Clear;
550	+	FRowCache.ClearCache;
551		RowCount := OldFixedRows + 1;
552		if dgpIndicator in FOptions then
553		ColWidths[0]:=12;
#	Line 566 | Line 600 | begin
600		and ValidDataSet and FDatalink.DataSet.CanModify;
601		end;
602
569	–
603		procedure TDBControlGrid.DoDrawRow(aRow: integer; aRect: TRect;
604		aState: TGridDrawState);
605		var CachedRow: TBitmap;
#	Line 579 | Line 612 | begin
612		begin
613		FCacheRefreshQueued := true;
614		Application.QueueAsyncCall(@DoMoveRecord,PtrInt(aRow));
615	<	end
615	>	end;
616	>	Canvas.FillRect(aRect);
617		end
618		else
619		Canvas.Draw(aRect.Left,aRect.Top,CachedRow)
#	Line 594 | Line 628 | begin
628		aRow := integer(Data);
629		FInCacheRefresh := true;
630		if assigned(FDataLink.DataSet) then
631	<	FDatalink.DataSet.MoveBy(aRow - FDrawRow)
631	>	FDatalink.DataSet.MoveBy(aRow - FDrawRow);
632		end;
633
634		procedure TDBControlGrid.DoSetupDrawPanel(Data: PtrInt);
#	Line 630 | Line 664 | end;
664		procedure TDBControlGrid.KeyDownHandler(Sender: TObject; var Key: Word;
665		Shift: TShiftState);
666		var Done: boolean;
667	+	AControl: TControl;
668		begin
669	<	if Visible and assigned(FDrawPanel) and FDrawPanel.Visible and FWeHaveFocus then
669	>	if Visible and assigned(FDrawPanel) and FDrawPanel.Visible and FWeHaveFocus
670	>	and (Self.Owner=Screen.ActiveForm) then
671		begin
672	+	AControl := ActiveControl;
673	+	if (AControl <> nil) and (AControl is TCustomComboBox)
674	+	and ((Key in [VK_UP,VK_DOWN]) or
675	+	(TCustomComboBox(AControl).DroppedDown and (Key = VK_RETURN)) or
676	+	((TCustomComboBox(AControl).Text <> '') and (Key =  VK_ESCAPE))) then
677	+	Exit; {ignore these keys if we are in a  combobox}
678	+
679	+	if (AControl <> nil) and (AControl is TCustomMemo)
680	+	and (Key in [VK_RETURN,VK_UP,VK_DOWN]) then Exit; {Ignore Return in a CustomMemo}
681	+
682	+	if (AControl <> nil) and (AControl is TCustomGrid)
683	+	and (Key in [VK_RETURN,VK_UP,VK_DOWN,VK_TAB]) then Exit; {Ignore Return in a CustomMemo}
684	+
685	+	if (AControl <> nil) and ((AControl is TDateEdit) or (AControl is TCustomMaskedit))
686	+	and (Key in [VK_RETURN,VK_UP,VK_DOWN,
687	+	VK_ESCAPE,VK_LEFT,VK_RIGHT]) then Exit; {Ignore Return in a CustomMemo}
688		Done := false;
689		if assigned(FOnKeyDownHander) then
690		OnKeyDownHander(Sender,Key,Shift,Done);
#	Line 654 | Line 706 | begin
706		and (FModified or (FRowCache.IsEmpty(aDataSet.RecNo))) then
707		begin
708		RecNo := aDataSet.RecNo;
657	–	Application.ProcessMessages;  {A couple of trips round the message loop seems to be necessary}
709		Application.ProcessMessages;
710		if RecNo = aDataSet.RecNo then   {Guard against sudden changes}
711	<	FRowCache.Add2Cache(aDataSet.RecNo,FDrawPanel);
711	>	FRowCache.Add2Cache(RecNo,FDrawPanel);
712		end;
713		end;
714
715		procedure TDBControlGrid.OnDataSetChanged(aDataSet: TDataSet);
716		begin
717	<	if (aDataSet.State = dsBrowse) and (FLastRecordCount >  GetRecordCount) then
717	>	if aDataSet.State = dsBrowse then
718		begin
719	<	{must be delete}
720	<	FRowCache.MarkAsDeleted(FSelectedRecNo);
721	<	Dec(FSelectedRow);
719	>	if GetRecordCount = 0 then
720	>	begin
721	>	{Must be closed/reopened}
722	>	FRowCache.ClearCache;
723	>	FSelectedRow := 0;
724	>	end
725	>	else
726	>	if FLastRecordCount >  GetRecordCount then
727	>	begin
728	>	{must be delete}
729	>	FRowCache.MarkAsDeleted(FSelectedRecNo);
730	>	Dec(FSelectedRow);
731	>	end;
732		LayoutChanged;
733		end;
734		FLastRecordCount := GetRecordCount;
735		if aDataSet.State = dsInsert then
736	+	begin
737		FRequiredRecNo := aDataSet.RecNo + 1;
738	+	Application.QueueAsyncCall(@DoSelectNext,0);
739	+	end;
740		UpdateActive
741		end;
742
#	Line 761 | Line 825 | begin
825		RemoveFreeNotification(FDrawPanel);
826		FDrawPanel.RemoveAllHandlersOfObject(self);
827		theForm := Parent;
828	<	while not (theForm is TCustomForm) and (theForm.Parent <> nil) do
828	>	while not ((theForm is TCustomForm) or (theForm is TCustomFrame))
829	>	and (theForm.Parent <> nil) do
830		theForm := theForm.Parent;
831		FDrawPanel.Parent := theForm;
832		end;
#	Line 778 | Line 843 | begin
843		FDrawPanel.Visible := false;
844		FRowCache.Height := FDrawPanel.Height;
845		FRowCache.Width := FDrawPanel.Width;
846	<	AddHandlerOnResize(@OnDrawPanelResize);
846	>	FDrawPanel.AddHandlerOnResize(@OnDrawPanelResize);
847		FreeNotification(FDrawPanel);
848		end;
849		except
#	Line 802 | Line 867 | end;
867
868		procedure TDBControlGrid.SetupDrawPanel(aRow: integer);
869		begin
870	+	if FDrawPanel = nil then Exit;
871		if ValidDataSet and FRowCache.AlternateColor[FDataLink.DataSet.RecNo] then
872		FDrawPanel.Color := AlternateColor
873		else
#	Line 1066 | Line 1132 | begin
1132		FDataLink.DataSet.MoveBy(integer(Data) - FDataLink.DataSet.RecNo);
1133		end;
1134
1135	+	procedure TDBControlGrid.DoSelectNext(Data: PtrInt);
1136	+	begin
1137	+	FDataLink.DataSet.MoveBy(1);
1138	+	end;
1139	+
1140		procedure TDBControlGrid.DrawAllRows;
1141		begin
1142		inherited DrawAllRows;
#	Line 1108 | Line 1179 | begin
1179		result := dsInactive;
1180		end;
1181
1111	–	var
1112	–	DataCol: Integer;
1182		begin
1183		PrepareCanvas(aCol, aRow, aState);
1184
1185		if aCol < FixedCols then
1186		DrawIndicator(Canvas,aRow, aRect,GetDataSetState,false)
1187		else
1188	+	if (FDrawPanel = nil) or not FDataLink.Active then
1189	+	DrawFillRect(Canvas,aRect)
1190	+	else
1191		if not FDrawingActiveRecord and FDataLink.Active then
1192		DoDrawRow(aRow,aRect,aState);
1193		{if we are drawing the active record then this is rendered by the Draw Panel
#	Line 1217 | Line 1289 | end;
1289		procedure TDBControlGrid.KeyDown(var Key: Word; Shift: TShiftState);
1290		type
1291		TOperation=(opMoveBy,opCancel,opAppend,opInsert,opDelete);
1220	–	var
1221	–	DeltaCol,DeltaRow: Integer;
1292
1293		procedure DoOnKeyDown;
1294		begin
#	Line 1361 | Line 1431 | begin
1431		FInCacheRefresh := false;
1432		FCacheRefreshQueued := false;
1433		Row := FixedRows;
1434	+	FDrawingActiveRecord := false;
1435	+	FSelectedRecNo := 0;
1436	+	FSelectedRow := 0;
1437	+	FRequiredRecNo := 0;
1438		end;
1439		FRowCache.UseAlternateColors := AlternateColor <> Color;
1440		FRowCache.AltColorStartNormal := AltColorStartNormal;
#	Line 1550 | Line 1624 | begin
1624		PrevRow := Row;
1625		Row := FDrawRow;
1626		if not FInCacheRefresh then
1627	+	begin
1628		FSelectedRow := FDrawRow;
1629	+	if FDatalink.DataSet.State <> dsInsert then
1630	+	FRowCache.InvalidateRowImage(FSelectedRecNo);
1631	+	end;
1632		InvalidateRow(PrevRow);
1633		SetupDrawPanel(FDrawRow);
1634		end;
#	Line 1612 | Line 1690 | begin
1690		FDataLink.Free;
1691		end;
1692		if assigned(FRowCache) then FRowCache.Free;
1693	+	if not (csDesigning in ComponentState) then
1694	+	Application.RemoveOnKeyDownBeforeHandler( @KeyDownHandler );
1695	+	Application.RemoveAsyncCalls(self);
1696		inherited Destroy;
1697		end;
1698
#	Line 1650 | Line 1731 | begin
1731		end;
1732
1733		end.
1734	+

Diff Legend

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