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 217 by tony, Fri Mar 16 10:27:26 2018 UTC

#	Line 1 | Line 1
1	+
2		{
3		/***************************************************************************
4		DBControlGrid.pas
#	Line 97 | Line 98 | type
98		procedure ClearCache;
99		function Add2Cache(RecNo: Longint; Control: TWinControl): TBitmap;
100		function GetRowImage(RecNo, Offset: integer): TBitmap;
101	+	procedure InvalidateRowImage(RecNo: integer);
102		function IsEmpty(RecNo: integer): boolean;
103		procedure MarkAsDeleted(RecNo: integer);
104		property AlternateColor[RecNo: integer]: boolean read GetAlternateColor;
#	Line 151 | Line 153 | type
153		FLastMouseButton: TMouseButton;
154		FLastMouseShiftState: TShiftState;
155
156	+	function ActiveControl: TControl;
157		procedure EmptyGrid;
158		function GetDataSource: TDataSource;
159		function GetRecordCount: Integer;
#	Line 236 | Line 239 | type
239		property Color;
240		property Constraints;
241		property DataSource: TDataSource read GetDataSource write SetDataSource;
239	–	property DefaultRowHeight;
242		property DefaultPositionAtEnd: boolean read  FDefaultPositionAtEnd write FDefaultPositionAtEnd;
243		property DragCursor;
244		property DragMode;
#	Line 284 | Line 286 | end;
286
287		implementation
288
289	<	uses LCLType, Math, LCLIntf, Forms, LCLMessageGlue;
289	>	uses LCLType, Math, LCLIntf, Forms, LCLMessageGlue, EditBtn, MaskEdit;
290
291		{ TDBControlGridDataLink }
292
#	Line 299 | Line 301 | end;
301
302		function TRowCache.Render(Control: TWinControl): TBitmap;
303		var Container: TBitmap;
302	–	Msg: TLMPaint;
304		begin
305		Container := TBitmap.Create;
306		try
#	Line 365 | Line 366 | begin
366		for i := StartIndex to Length(FList) - 1 do
367		begin
368		FList[i].FState := rcEmpty;
369	+	FList[i].FBitmap := nil;
370		FList[i].FAlternateColor := altColor;
371		if UseAlternateColors then
372		altColor := not altColor;
#	Line 412 | Line 414 | end;
414		procedure TRowCache.ClearCache;
415		begin
416		FreeImages(true);
417	+	SetLength(FList,0);
418		end;
419
420		function TRowCache.Add2Cache(RecNo: Longint; Control: TWinControl): TBitmap;
418	–	var i: integer;
421		begin
422		Dec(RecNo); {Adust to zero base}
423		ExtendCache(RecNo + 1);
424		FList[RecNo].FState := rcPresent;
425	+	if FList[RecNo].FBitmap <> nil then
426	+	FList[RecNo].FBitmap.Free;
427		FList[RecNo].FBitmap := Render(Control);
428		Result := FList[RecNo].FBitmap;
429		end;
#	Line 467 | Line 471 | begin
471		until false;
472		end;
473
474	+	procedure TRowCache.InvalidateRowImage(RecNo: integer);
475	+	begin
476	+	Dec(RecNo); {adjust to zero base}
477	+	if (RecNo < 0) or (RecNo >= Length(FList)) then
478	+	Exit;
479	+
480	+	if FList[RecNo].FState = rcPresent then
481	+	begin
482	+	FList[RecNo].FBitmap.Free;
483	+	FList[RecNo].FBitmap := nil;
484	+	FList[RecNo].FState := rcEmpty;
485	+	end;
486	+	end;
487	+
488		function TRowCache.IsEmpty(RecNo: integer): boolean;
489		begin
490		Dec(RecNo);
#	Line 509 | Line 527 | end;
527
528		{ TDBControlGrid }
529
530	+	function TDBControlGrid.ActiveControl: TControl;
531	+	var AParent: TWinControl;
532	+	begin
533	+	Result := nil;
534	+	AParent := Parent;
535	+	while (AParent <> nil) and  not (AParent is TCustomForm) do
536	+	AParent := AParent.Parent;
537	+	if (AParent <> nil) and (AParent is TCustomForm)then
538	+	Result := TCustomForm(AParent).ActiveControl;
539	+	end;
540	+
541		procedure TDBControlGrid.EmptyGrid;
542		var
543		OldFixedRows: Integer;
544		begin
545		OldFixedRows := FixedRows;
546		Clear;
547	+	FRowCache.ClearCache;
548		RowCount := OldFixedRows + 1;
549		if dgpIndicator in FOptions then
550		ColWidths[0]:=12;
#	Line 567 | Line 597 | begin
597		and ValidDataSet and FDatalink.DataSet.CanModify;
598		end;
599
570	–
600		procedure TDBControlGrid.DoDrawRow(aRow: integer; aRect: TRect;
601		aState: TGridDrawState);
602		var CachedRow: TBitmap;
#	Line 580 | Line 609 | begin
609		begin
610		FCacheRefreshQueued := true;
611		Application.QueueAsyncCall(@DoMoveRecord,PtrInt(aRow));
612	<	end
612	>	end;
613	>	Canvas.FillRect(aRect);
614		end
615		else
616		Canvas.Draw(aRect.Left,aRect.Top,CachedRow)
#	Line 595 | Line 625 | begin
625		aRow := integer(Data);
626		FInCacheRefresh := true;
627		if assigned(FDataLink.DataSet) then
628	<	FDatalink.DataSet.MoveBy(aRow - FDrawRow)
628	>	FDatalink.DataSet.MoveBy(aRow - FDrawRow);
629		end;
630
631		procedure TDBControlGrid.DoSetupDrawPanel(Data: PtrInt);
#	Line 631 | Line 661 | end;
661		procedure TDBControlGrid.KeyDownHandler(Sender: TObject; var Key: Word;
662		Shift: TShiftState);
663		var Done: boolean;
664	+	AControl: TControl;
665		begin
666		if Visible and assigned(FDrawPanel) and FDrawPanel.Visible and FWeHaveFocus then
667		begin
668	+	AControl := ActiveControl;
669	+	if (AControl <> nil) and (AControl is TCustomComboBox)
670	+	and ((Key in [VK_UP,VK_DOWN]) or
671	+	(TCustomComboBox(AControl).DroppedDown and (Key = VK_RETURN)) or
672	+	((TCustomComboBox(AControl).Text <> '') and (Key =  VK_ESCAPE))) then
673	+	Exit; {ignore these keys if we are in a  combobox}
674	+
675	+	if (AControl <> nil) and (AControl is TCustomMemo)
676	+	and (Key in [VK_RETURN,VK_UP,VK_DOWN]) then Exit; {Ignore Return in a CustomMemo}
677	+
678	+	if (AControl <> nil) and (AControl is TCustomGrid)
679	+	and (Key in [VK_RETURN,VK_UP,VK_DOWN,VK_TAB]) then Exit; {Ignore Return in a CustomMemo}
680	+
681	+	if (AControl <> nil) and ((AControl is TDateEdit) or (AControl is TCustomMaskedit))
682	+	and (Key in [VK_RETURN,VK_UP,VK_DOWN,
683	+	VK_ESCAPE,VK_LEFT,VK_RIGHT]) then Exit; {Ignore Return in a CustomMemo}
684		Done := false;
685		if assigned(FOnKeyDownHander) then
686		OnKeyDownHander(Sender,Key,Shift,Done);
#	Line 655 | Line 702 | begin
702		and (FModified or (FRowCache.IsEmpty(aDataSet.RecNo))) then
703		begin
704		RecNo := aDataSet.RecNo;
658	–	Application.ProcessMessages;  {A couple of trips round the message loop seems to be necessary}
705		Application.ProcessMessages;
706		if RecNo = aDataSet.RecNo then   {Guard against sudden changes}
707	<	FRowCache.Add2Cache(aDataSet.RecNo,FDrawPanel);
707	>	FRowCache.Add2Cache(RecNo,FDrawPanel);
708		end;
709		end;
710
711		procedure TDBControlGrid.OnDataSetChanged(aDataSet: TDataSet);
712		begin
713	<	if (aDataSet.State = dsBrowse) and (FLastRecordCount >  GetRecordCount) then
713	>	if aDataSet.State = dsBrowse then
714		begin
715	<	{must be delete}
716	<	FRowCache.MarkAsDeleted(FSelectedRecNo);
717	<	Dec(FSelectedRow);
715	>	if GetRecordCount = 0 then
716	>	begin
717	>	{Must be closed/reopened}
718	>	FRowCache.ClearCache;
719	>	FSelectedRow := 0;
720	>	end
721	>	else
722	>	if FLastRecordCount >  GetRecordCount then
723	>	begin
724	>	{must be delete}
725	>	FRowCache.MarkAsDeleted(FSelectedRecNo);
726	>	Dec(FSelectedRow);
727	>	end;
728		LayoutChanged;
729		end;
730		FLastRecordCount := GetRecordCount;
#	Line 765 | Line 821 | begin
821		RemoveFreeNotification(FDrawPanel);
822		FDrawPanel.RemoveAllHandlersOfObject(self);
823		theForm := Parent;
824	<	while not (theForm is TCustomForm) and (theForm.Parent <> nil) do
824	>	while not ((theForm is TCustomForm) or (theForm is TCustomFrame))
825	>	and (theForm.Parent <> nil) do
826		theForm := theForm.Parent;
827		FDrawPanel.Parent := theForm;
828		end;
#	Line 782 | Line 839 | begin
839		FDrawPanel.Visible := false;
840		FRowCache.Height := FDrawPanel.Height;
841		FRowCache.Width := FDrawPanel.Width;
842	<	AddHandlerOnResize(@OnDrawPanelResize);
842	>	FDrawPanel.AddHandlerOnResize(@OnDrawPanelResize);
843		FreeNotification(FDrawPanel);
844		end;
845		except
#	Line 806 | Line 863 | end;
863
864		procedure TDBControlGrid.SetupDrawPanel(aRow: integer);
865		begin
866	+	if FDrawPanel = nil then Exit;
867		if ValidDataSet and FRowCache.AlternateColor[FDataLink.DataSet.RecNo] then
868		FDrawPanel.Color := AlternateColor
869		else
#	Line 1117 | Line 1175 | begin
1175		result := dsInactive;
1176		end;
1177
1120	–	var
1121	–	DataCol: Integer;
1178		begin
1179		PrepareCanvas(aCol, aRow, aState);
1180
1181		if aCol < FixedCols then
1182		DrawIndicator(Canvas,aRow, aRect,GetDataSetState,false)
1183		else
1184	+	if (FDrawPanel = nil) or not FDataLink.Active then
1185	+	DrawFillRect(Canvas,aRect)
1186	+	else
1187		if not FDrawingActiveRecord and FDataLink.Active then
1188		DoDrawRow(aRow,aRect,aState);
1189		{if we are drawing the active record then this is rendered by the Draw Panel
#	Line 1226 | Line 1285 | end;
1285		procedure TDBControlGrid.KeyDown(var Key: Word; Shift: TShiftState);
1286		type
1287		TOperation=(opMoveBy,opCancel,opAppend,opInsert,opDelete);
1229	–	var
1230	–	DeltaCol,DeltaRow: Integer;
1288
1289		procedure DoOnKeyDown;
1290		begin
#	Line 1370 | Line 1427 | begin
1427		FInCacheRefresh := false;
1428		FCacheRefreshQueued := false;
1429		Row := FixedRows;
1430	+	FDrawingActiveRecord := false;
1431	+	FSelectedRecNo := 0;
1432	+	FSelectedRow := 0;
1433	+	FRequiredRecNo := 0;
1434		end;
1435		FRowCache.UseAlternateColors := AlternateColor <> Color;
1436		FRowCache.AltColorStartNormal := AltColorStartNormal;
#	Line 1559 | Line 1620 | begin
1620		PrevRow := Row;
1621		Row := FDrawRow;
1622		if not FInCacheRefresh then
1623	+	begin
1624		FSelectedRow := FDrawRow;
1625	+	if FDatalink.DataSet.State <> dsInsert then
1626	+	FRowCache.InvalidateRowImage(FSelectedRecNo);
1627	+	end;
1628		InvalidateRow(PrevRow);
1629		SetupDrawPanel(FDrawRow);
1630		end;
#	Line 1621 | Line 1686 | begin
1686		FDataLink.Free;
1687		end;
1688		if assigned(FRowCache) then FRowCache.Free;
1689	+	Application.RemoveAsyncCalls(self);
1690		inherited Destroy;
1691		end;
1692
#	Line 1659 | Line 1725 | begin
1725		end;
1726
1727		end.
1728	+

Diff Legend

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