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 27 by tony, Tue Apr 14 13:10:23 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 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
#	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 467 | Line 473 | begin
473		until false;
474		end;
475
476	+	procedure TRowCache.InvalidateRowImage(RecNo: integer);
477	+	begin
478	+	Dec(RecNo); {adjust to zero base}
479	+	if (RecNo < 0) or (RecNo >= Length(FList)) then
480	+	Exit;
481	+
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;
489	+
490		function TRowCache.IsEmpty(RecNo: integer): boolean;
491		begin
492		Dec(RecNo);
#	Line 509 | 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 567 | Line 599 | begin
599		and ValidDataSet and FDatalink.DataSet.CanModify;
600		end;
601
570	–
602		procedure TDBControlGrid.DoDrawRow(aRow: integer; aRect: TRect;
603		aState: TGridDrawState);
604		var CachedRow: TBitmap;
#	Line 580 | 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 595 | 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 631 | 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 655 | Line 704 | begin
704		and (FModified or (FRowCache.IsEmpty(aDataSet.RecNo))) then
705		begin
706		RecNo := aDataSet.RecNo;
658	–	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 765 | Line 823 | begin
823		RemoveFreeNotification(FDrawPanel);
824		FDrawPanel.RemoveAllHandlersOfObject(self);
825		theForm := Parent;
826	<	while not (theForm is TCustomForm) and (theForm.Parent <> nil) do
826	>	while not ((theForm is TCustomForm) or (theForm is TCustomFrame))
827	>	and (theForm.Parent <> nil) do
828		theForm := theForm.Parent;
829		FDrawPanel.Parent := theForm;
830		end;
#	Line 782 | Line 841 | begin
841		FDrawPanel.Visible := false;
842		FRowCache.Height := FDrawPanel.Height;
843		FRowCache.Width := FDrawPanel.Width;
844	<	AddHandlerOnResize(@OnDrawPanelResize);
844	>	FDrawPanel.AddHandlerOnResize(@OnDrawPanelResize);
845		FreeNotification(FDrawPanel);
846		end;
847		except
#	Line 806 | 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 1117 | Line 1177 | begin
1177		result := dsInactive;
1178		end;
1179
1120	–	var
1121	–	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) 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 1226 | Line 1287 | end;
1287		procedure TDBControlGrid.KeyDown(var Key: Word; Shift: TShiftState);
1288		type
1289		TOperation=(opMoveBy,opCancel,opAppend,opInsert,opDelete);
1229	–	var
1230	–	DeltaCol,DeltaRow: Integer;
1290
1291		procedure DoOnKeyDown;
1292		begin
#	Line 1370 | 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 1559 | Line 1622 | begin
1622		PrevRow := Row;
1623		Row := FDrawRow;
1624		if not FInCacheRefresh then
1625	+	begin
1626		FSelectedRow := FDrawRow;
1627	+	if FDatalink.DataSet.State <> dsInsert then
1628	+	FRowCache.InvalidateRowImage(FSelectedRecNo);
1629	+	end;
1630		InvalidateRow(PrevRow);
1631		SetupDrawPanel(FDrawRow);
1632		end;
#	Line 1621 | 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 1659 | Line 1727 | begin
1727		end;
1728
1729		end.
1730	+

Diff Legend

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