{ +-------------------------------------------------------------+ } { | | } { | GM-Software | } { | =========== | } { | | } { | Project: All Projects | } { | | } { | Description: Complex controls not based on a window | } { | handle. | } { | | } { | Copyright (C) - 2007 - Gerrit Moeller. | } { | | } { | Source code distributed under MIT license. | } { | | } { | See: https://www.gm-software.de | } { | | } { +-------------------------------------------------------------+ } {$INCLUDE GMCompilerSettings.inc} unit GMxCmplxCtrls; interface uses {$IFNDEF JEDIAPI}Windows{$ELSE}jwaWinType{$ENDIF} ,GMMessages, GMIntf, GMCommon, GMCollections, GMGdi, GMUICore, GMxCtrls; const cDfltRowHeight = 18; cDfltGridRowAlign: TGMAreaAlignRec = (EdgeAlign: (ealAligned, ealFixed, ealAligned, ealFixed); ShrinkRestX: False; ShrinkRestY: False); cDfltRowColor = clrWindow; type { ------------------------------------- } { ---- Base classes of rowed areas ---- } { ------------------------------------- } TGMRowedAreaBase = class; TGMRowsIteratorBase = class(TGMRefCountedObj, IGMIterator) protected FRowedArea: TGMRowedAreaBase; FCurrentIdx: PtrInt; FReverse: Boolean; FThreadLock: RGMCriticalSectionLock; // IUnknown; public constructor Create(const ARowedArea: TGMRowedAreaBase; const AReverse: Boolean = False; const AConcurrentThreadLock: Boolean = False; const ARefLifeTime: Boolean = True); reintroduce; function NextEntry(out AEntry): Boolean; virtual; abstract; procedure Reset; virtual; abstract; end; TGMAllRowsIterator = class(TGMRowsIteratorBase) public function NextEntry(out AEntry): Boolean; override; procedure Reset; override; end; TGMSelectedRowsIterator = class(TGMRowsIteratorBase) public function NextEntry(out AEntry): Boolean; override; procedure Reset; override; end; TGMRowAreaBase = class(TGMUiArea) protected FContainer: TGMRowedAreaBase; FAbsoluteRowIdx: Integer; FData: IUnknown; FClickPos: TPoint; FCallFinishClickSelect: Boolean; procedure WMLButtonDown(var Msg: TWMMouse); message WM_LBUTTONDOWN; procedure WMLButtonUp(var Msg: TWMMouse); message WM_LBUTTONUP; procedure WMMouseMove(var Msg: TWMMouse); message WM_MOUSEMOVE; procedure WMRButtonDown(var Msg: TWMMouse); message WM_RBUTTONDOWN; procedure SetAbsoluteRowIdx(const Value: Integer); virtual; public constructor Create(const ARefLifeTime: Boolean = False); override; constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ABkgndColor: COLORREF = cDfltColor; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); override; constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AAbsoluteRowIdx: Integer = cInvalidItemIdx; const AData: IUnknown = nil; const ABkgndColor: COLORREF = cDfltColor; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; // virtual; destructor Destroy; override; procedure ScrollVisible; procedure SetSelected(const AValue: Boolean); procedure AfterSelectionStateChanged; virtual; function PaintSelected: Boolean; function Selected: Boolean; procedure ClickSelect(const AKeyStates: SGMKeyStates); virtual; procedure FinishClickSelect; function BkgndColor: COLORREF; override; function FontColor: COLORREF; override; procedure ScheduleRepaint; override; // function CanSelect: Boolean; // <- Use Container CanSelectAbsIdx to change CanSelect Behaviour function CanDropHighLite: Boolean; virtual; procedure Focus; virtual; //function PaintArea(const DC: HDC; const RSurface: TRect): Boolean; override; function InternalPaintToRect(const DC: HDC; const RSurface: TRect): Boolean; override; property AbsoluteRowIdx: Integer read FAbsoluteRowIdx write SetAbsoluteRowIdx; property Container: TGMRowedAreaBase read FContainer; property Data: IUnknown read FData write FData; //property Selected: Boolean read GetSelected; // write SetSelected; end; TGMRowChildArea = class(TGMUiArea) protected FContainer: TGMRowedAreaBase; FRow: TGMRowAreaBase; public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ABkgndColor: COLORREF = cDfltColor; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); override; property Row: TGMRowAreaBase read FRow; property Container: TGMRowedAreaBase read FContainer; end; //TEditorState = class(TGMRefCountedObj, IGMassignFromIntf, IGMAssignToIntf) // protected // //FContainer: TObject; // //FEditorParent: TObject; // FEditorLayoutBounds: TRect; // FEditorAreaAlign: TGMAreaAlignRec; // // public // constructor Create(const AContainer: TObject; const AEditor: IUnknown; const ARefLifeTime: Boolean = True); reintroduce; // procedure AssignFromIntf(const ASource: IUnknown); stdcall; // procedure AssignToIntf(const ADest: IUnknown); stdcall; //end; TGMRowAreaNotifyProc = procedure (const ARow: TGMRowAreaBase) of Object; TGMRowedAreaBase = class(TGMUiArea) protected FExtendSelAbsIdx: Integer; FSelectedIndexes: IGMIntegerMap; FDropHighliteIdx: Integer; FEditorState: IGMAssignToIntf; FRowAreaCount: Integer; procedure WMGetDlgCode(var Msg: TMessage); message WM_GETDLGCODE; // TWMGetDlgCode procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS; procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS; procedure WMRButtonDown(var Msg: TWMMouse); message WM_RBUTTONDOWN; procedure WMMouseWheel(var Msg: TWMMouseWheel); message WM_MOUSEWHEEL; procedure WMKeyDown(var Msg: TWMKey); message WM_KEYDOWN; procedure WMChar(var Msg: TWMKey); message WM_CHAR; procedure ScrollChildAreaVisible(const AAreaRect: TRect); procedure NotifyAfterFocusedRowChange(const ARow: TGMRowAreaBase); virtual; procedure SetDropHighliteIdx(const Value: Integer); procedure AfterSelectionChanged; virtual; procedure StartDrag(const ADragOffs: TPoint; const ARow: TGMRowAreaBase); virtual; // procedure HideEditor; virtual; public FEditor: IUnknown; FTabStop: Boolean; FWasTabStop: Boolean; FScrollBar: TObject; FWithoutSelection: Boolean; FMultiSelect: Boolean; FFocusedRowIdx: Integer; OnAfterFocusedRowChange: TGMRowAreaNotifyProc; OnAfterSelectionChange: TGMObjNotifyProc; constructor Create(const ARefLifeTime: Boolean = False); override; procedure OnScrollPosChange(const AOldPos, ANewPos: Integer); virtual; procedure ScrollVisible(const AAbsoluteIndex: Integer); virtual; procedure SetFocusedRowByAbsIdx(const AAbsoluteRowIdx: Integer); function RowAreaIdxFromAbsRowIdx(const AAbsoluteRowIdx: Integer): Integer; virtual; function RowAreaForAbsIdx(const AAbsoluteRowIdx: Integer): TObject; procedure SelectedIndexesChanged(const AAbsRowIdx: PtrInt); virtual; function InternalPaintToRect(const ADC: HDC; const ARSurface: TRect): Boolean; override; function IsTabStop: Boolean; override; // CanSelect cannot be decided by the row area. We need to be able to answer this even if there is // no row area for the index because it has been scrolled out in TGMVirtualRowsArea! function CanSelectAbsIdx(const AAbsoluteRowIdx: PtrInt): Boolean; virtual; procedure RepaintSelectedEntries; procedure SelectAll; procedure RemoveSelectedEntries; virtual; procedure RemoveEntry(const AAbsoluteIndex: Integer); virtual; function SubtractContainedAreas(const ARect: TRect; const ARegion: HRGN): Boolean; override; // procedure SetSelectionRange(AStartAbsoluteIdx, AEndAbsoluteIdx: PtrInt); function RowAreaCount: Integer; function TotalRowCount: Integer; virtual; function IsEmpty: Boolean; procedure ExecContextMenu; virtual; // procedure ShowEditor(const ARow: TGMRowAreaBase); virtual; procedure CloseEditor(const AApplyChanges: Boolean; const AOpaqueData: IUnknown = nil); virtual; property SelectedIndexes: IGMIntegerMap read FSelectedIndexes; property DropHighliteIdx: Integer read FDropHighliteIdx write SetDropHighliteIdx; end; { ------------------------------------------------------------ } { ---- Row Container where rows may have different height ---- } { ------------------------------------------------------------ } TGMBoundingRowArea = class; TGMListArea = class; TGMBoundingRowArea = class(TGMRowAreaBase) // // List rows have bounding layouting behaviour! // protected FPaddSpace: TPoint; public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const APaddSpace: TPoint; const AAbsoluteRowIdx: Integer = cInvalidItemIdx; const AData: IUnknown = nil; const ABkgndColor: COLORREF = cDfltColor; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; virtual; function InternalCalcWidth(const ANewSize: TPoint): Integer; override; function InternalCalcHeight(const ANewSize: TPoint): Integer; override; function RootForRelayout: TObject; override; property PaddSpace: TPoint read FPaddSpace write FPaddSpace; end; TGMListCtrlNotifyProc = procedure (const ALine: TGMBoundingRowArea) of Object; TGMListArea = class(TGMRowedAreaBase) protected procedure RemoveOwnedArea(const AIdx: Integer); procedure AdjustAfterRemove(const AOldFocusIdx: Integer); procedure BeforeRemoveRow(const ARow: TGMRowAreaBase); virtual; public AlwaysShowScrollBar: Boolean; function AddRow(const ANewRow: TGMRowAreaBase; const AFocus: Boolean = True; const AAddToOwned: Boolean = False): TGMRowAreaBase; procedure LayoutContainedAreas(const ARepaint: Boolean); override; // : TPoint; procedure RemoveAllEntries(const ANotifyUI: Boolean = True; ARowAreaClass: TClass = nil); procedure RemoveSelectedEntries; override; procedure RemoveEntry(const AAbsoluteIndex: Integer); override; procedure MoveRow(const AAbsoluteRowIdx, ADelta: Integer); virtual; end; { ----------------------------------------------------------- } { ---- Row Container where all rows have the same height ---- } { ----------------------------------------------------------- } TGMVirtualRowsArea = class; TGMVirtualRow = class(TGMRowAreaBase) protected procedure SetAbsoluteRowIdx(const AValue: Integer); override; public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ABkgndColor: COLORREF = cDfltColor; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); override; // When accessing the the containers items in LoadValues it must be secured to be in range 0..count-1 // because there is one more visible row for partial visibility when scrolling. procedure LoadValues(const ASource: IUnknown; const AClearValues: Boolean = False); virtual; function GetLayoutBounds: TRect; override; end; TGMVirtualRowClass = class of TGMVirtualRow; TGMVirtualRowsArea = class(TGMRowedAreaBase) protected FRowHeight: Integer; FRowAlign: TGMAreaAlignRec; FDataSource: IUnknown; public constructor Create(const ARefLifeTime: Boolean = False); override; constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ADataSource: IUnknown = nil; const ABkgndColor: COLORREF = cDfltColor; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; virtual; function TotalRowCount: Integer; override; procedure ReloadRows(ARowAreaStartIdx: Integer; const ARepaint: Boolean); procedure AdjustAfterRemove(const ARefreshStartAbsIdx: Integer; const ARepaint: Boolean); procedure OnScrollPosChange(const AOldPos, ANewPos: Integer); override; procedure SetLayoutBounds(const ARect: TRect; const AInvalidate: Boolean); override; function RowAreaIdxFromAbsRowIdx(const AAbsoluteRowIdx: Integer): Integer; override; procedure RemoveAllRows(const ARepaint: Boolean); function RowCreateClass: TGMVirtualRowClass; virtual; function AddRow(const AInsertIdx: Integer): TGMVirtualRow; function AddRowWithLayout(const AInsertIdx: Integer; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec): TGMVirtualRow; procedure ScrollRangeChanged; //procedure LoadValues(const ASource: IUnknown); virtual; procedure RemoveLastRow; procedure AdjustRowCount(const Relayout, Invalidate: Boolean); procedure AdjustVisibleRowCount(const Height: Integer; const Relayout, Invalidate: Boolean); procedure ScrollVisible(const AAbsoluteRowIndex: Integer); override; property DataSource: IUnknown read FDataSource write FDataSource; property RowHeight: Integer read FRowHeight default cDfltRowHeight; property RowAlign: TGMAreaAlignRec read FRowAlign; end; function SetupRowChildArea(const AArea: TObject; const ARedirectMessages: array of TGMWndMsg): TObject; function DfltSetupRowChildArea(const AArea: TObject; const AData: Pointer = nil): Boolean; var vGridOddRowColor: COLORREF = clrLightBlue; vDfltRowParentMessages: array [0..11] of TGMWndMsg = (WM_LBUTTONDOWN, WM_LBUTTONUP, WM_RBUTTONDOWN, WM_RBUTTONUP, WM_LBUTTONDBLCLK, WM_RBUTTONDBLCLK, WM_MOUSEMOVE, UM_MOUSEENTER, UM_MOUSELEAVE, UM_DRAG_QUERYDROP, UM_DRAG_DROPPED, UM_DRAG_CONTROL); vRowBtnParentMessages: array [0..4] of TGMWndMsg = (WM_RBUTTONDOWN, WM_RBUTTONUP, UM_DRAG_QUERYDROP, UM_DRAG_DROPPED, UM_DRAG_CONTROL); implementation {$IFDEF JEDIAPI} uses jwaWinUser, jwaWinGdi; {$ENDIF} { ------------------------- } { ---- Global Routines ---- } { ------------------------- } function SetupRowChildArea(const AArea: TObject; const ARedirectMessages: array of TGMWndMsg): TObject; var Row: TGMRowAreaBase; begin Result := AArea; if not GMfindParentObj(AArea, TGMRowAreaBase, Row) then Exit; if AArea is TGMUiAreaBase then begin TGMUiAreaBase(AArea).OnGetHBkgndBrush := Row.HBkgndBrush; TGMUiAreaBase(AArea).OnGetBkgndColor := Row.BkgndColor; TGMUiAreaBase(AArea).OnGetFontColor := Row.FontColor; end; if AArea is TGMUiArea then begin //SetLength(TGMUiArea(AArea).DispatchToParentMessages, 0); TGMUiArea(AArea).DispatchToParentMessages.Clear; GMAddDispatchToParentMessages(AArea, ARedirectMessages); //GMAddIntegersToArray(TGMUiArea(AArea).DispatchToParentMessages, ARedirectMessages); end; end; function DfltSetupRowChildArea(const AArea: TObject; const AData: Pointer): Boolean; begin SetupRowChildArea(AArea, vDfltRowParentMessages); Result := True; end; { ----------------------------- } { ---- TGMRowsIteratorBase ---- } { ----------------------------- } constructor TGMRowsIteratorBase.Create(const ARowedArea: TGMRowedAreaBase; const AReverse, AConcurrentThreadLock, ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); FRowedArea := ARowedArea; FReverse := AReverse; //if (ARowedArea <> nil) and AConcurrentThreadLock then FSyncLock := TGMCriticalSectionLock.Create(ARowedArea.ContainedAreas); if (ARowedArea <> nil) and AConcurrentThreadLock then FThreadLock.Lock(ARowedArea.ContainedAreas); Reset; end; { ---------------------------- } { ---- TGMAllRowsIterator ---- } { ---------------------------- } function TGMAllRowsIterator.NextEntry(out AEntry): Boolean; begin if FRowedArea = nil then Result := False else repeat Result := GMIsInRange(FCurrentIdx, 0, FRowedArea.TotalRowCount-1); if not Result then Break; TObject(AEntry) := FRowedArea.RowAreaForAbsIdx(FCurrentIdx); if FReverse then Dec(FCurrentIdx) else Inc(FCurrentIdx); Result := TObject(AEntry) is TGMRowAreaBase; until Result; end; procedure TGMAllRowsIterator.Reset; begin if FRowedArea <> nil then if FReverse then FCurrentIdx := FRowedArea.TotalRowCount-1 else FCurrentIdx := 0; end; { --------------------------------- } { ---- TGMSelectedRowsIterator ---- } { --------------------------------- } function TGMSelectedRowsIterator.NextEntry(out AEntry): Boolean; begin if FRowedArea = nil then Result := False else begin Result := GMIsInRange(FCurrentIdx, 0, FRowedArea.SelectedIndexes.Obj.Count-1); if Result then begin TObject(AEntry) := FRowedArea.RowAreaForAbsIdx(FRowedArea.SelectedIndexes.Obj[FCurrentIdx]); if FReverse then Dec(FCurrentIdx) else Inc(FCurrentIdx); end; end; end; procedure TGMSelectedRowsIterator.Reset; begin if FRowedArea <> nil then if FReverse then FCurrentIdx := FRowedArea.SelectedIndexes.Obj.Count-1 else FCurrentIdx := 0; end; { ------------------------ } { ---- TGMRowAreaBase ---- } { ------------------------ } constructor TGMRowAreaBase.Create(const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); FAbsoluteRowIdx := cInvalidItemIdx; // <- Allow SetAbsoluteRowIdx(0) FClickPos := cInvalidUIPoint; GMAddDispatchToParentMessages(Self, [UM_DRAG_CONTROL]); end; constructor TGMRowAreaBase.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ABkgndColor: COLORREF; const AVisible, ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, ABkgndColor, AVisible, ARefLifeTime); GMCheckFindParentObj(Self, TGMRowedAreaBase, FContainer); if FContainer <> nil then Inc(FContainer.FRowAreaCount); end; constructor TGMRowAreaBase.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AAbsoluteRowIdx: Integer; const AData: IUnknown; const ABkgndColor: COLORREF; const AVisible, ARefLifeTime: Boolean); begin Create(AParent, APosition, AAreaAlign, ABkgndColor, AVisible, ARefLifeTime); FData := AData; // <- better assign data before setting AbsoluteRowIdx AbsoluteRowIdx := AAbsoluteRowIdx; // <- go through set handler end; destructor TGMRowAreaBase.Destroy; begin if FContainer <> nil then Dec(FContainer.FRowAreaCount); inherited; end; function TGMRowAreaBase.PaintSelected: Boolean; begin Result := (Container <> nil) and (((Container.DropHighliteIdx = AbsoluteRowIdx) and CanDropHighLite) or ((Container.DropHighliteIdx < 0) and not Container.FWithoutSelection and Selected)); // Container.SelectedIndexes.Obj.Contains(AbsoluteRowIdx))); end; function TGMRowAreaBase.FontColor: COLORREF; begin if PaintSelected then Result := clrHighlightText else Result := inherited FontColor; end; procedure TGMRowAreaBase.ScheduleRepaint; begin FBkgndBrush := nil; inherited; end; //function TGMRowAreaBase.CanSelect: Boolean; //begin //Result := (Container <> nil) and Container.CanSelectAbsIdx(AbsoluteRowIdx); //end; function TGMRowAreaBase.CanDropHighLite: Boolean; begin Result := True; end; function TGMRowAreaBase.Selected: Boolean; begin Result := (Container <> nil) and Container.SelectedIndexes.Obj.Contains(AbsoluteRowIdx); end; procedure TGMRowAreaBase.SetSelected(const AValue: Boolean); begin // Decision if the row can be selected is done via SelectedIndexes.OnDecideAddValue which is connected to Container.CanSelectAbsIdx // Repaint will be done via AfterSelectionStateChanged notification if Container <> nil then // and CanSelect then if AValue then Container.SelectedIndexes.Obj.Add(AbsoluteRowIdx) else Container.SelectedIndexes.Obj.Remove(AbsoluteRowIdx); end; procedure TGMRowAreaBase.AfterSelectionStateChanged; begin GMScheduleRepaint(Self); end; function TGMRowAreaBase.BkgndColor: COLORREF; begin if Container = nil then Result := inherited BkgndColor else //if Container.DropHighliteIdx = AbsoluteRowIdx then Result := clNavy //else if PaintSelected then begin if Container.HasFocus then Result := clrHighlight else Result := clrBtnShadow; end else if Odd(AbsoluteRowIdx) then Result := vGridOddRowColor else Result := Container.BkgndColor; end; procedure TGMRowAreaBase.SetAbsoluteRowIdx(const Value: Integer); begin if Value = FAbsoluteRowIdx then Exit; FAbsoluteRowIdx := Value; FBkgndBrush := nil; end; procedure TGMRowAreaBase.Focus; var oldFocusArea: TObject; setBkgndColor: IGMGetSetBkgndColor; begin if (Container = nil) or (Container.FFocusedRowIdx = AbsoluteRowIdx) then Exit; Container.CloseEditor(True); oldFocusArea := Container.RowAreaForAbsIdx(Container.FFocusedRowIdx); Container.FFocusedRowIdx := AbsoluteRowIdx; if oldFocusArea <> nil then GMScheduleRepaint(oldFocusArea); ScheduleRepaint; Container.FExtendSelAbsIdx := AbsoluteRowIdx; if (Container.FEditor <> nil) and GMIsParentObj(Self, GMObjFromIntf(Container.FEditor)) and GMQueryInterface(Container.FEditor, IGMGetSetBkgndColor, setBkgndColor) then setBkgndColor.SetBkgndColor(BkgndColor); Container.NotifyAfterFocusedRowChange(Self); end; procedure TGMRowAreaBase.ScrollVisible; begin Container.ScrollVisible(AbsoluteRowIdx); end; procedure TGMRowAreaBase.ClickSelect(const AKeyStates: SGMKeyStates); begin FCallFinishClickSelect := False; if (Container = nil) or Container.FWithoutSelection then Exit; GMSetFocus(Container); if FContainer.FMultiSelect and (AKeyStates = [ksCtrl]) then SetSelected(not Selected) else if FContainer.FMultiSelect and (AKeyStates = [ksShift]) then begin Container.SelectedIndexes.Obj.SetRange(AbsoluteRowIdx, Container.FFocusedRowIdx); Container.FExtendSelAbsIdx := AbsoluteRowIdx; end else if (AKeyStates = []) and not Selected then FinishClickSelect else FCallFinishClickSelect := True; if not FCallFinishClickSelect then Container.AfterSelectionChanged; end; procedure TGMRowAreaBase.FinishClickSelect; begin ScrollVisible; Container.SelectedIndexes.Obj.Clear(True); SetSelected(True); Focus; Container.AfterSelectionChanged; end; procedure TGMRowAreaBase.WMRButtonDown(var Msg: TWMMouse); begin //inherited; if Container = nil then Exit; if not Selected then ClickSelect(GMKeyDataToKeyState(Msg.Keys)); Container.ExecContextMenu; end; procedure TGMRowAreaBase.WMLButtonDown(var Msg: TWMMouse); begin //if Container = nil then Exit; FClickPos := SmallPointToPoint(Msg.Pos); // <- needed in WMMouseMove to decide when to start dragging ClickSelect(GMKeyDataToKeyState(Msg.Keys)); GMCaptureMouseInput(Self); // <- must be done after setting container focus via clickselect! // needed when picking the row less than GetSystemMetrics(SM_CYDRAG) pixels from the edge //inherited; end; procedure TGMRowAreaBase.WMMouseMove(var Msg: TWMMouse); begin inherited; if FClickPos = cInvalidUIPoint then Exit; if ((Abs(FClickPos.x - Msg.XPos) > GetSystemMetrics(SM_CXDRAG)) or (Abs(FClickPos.y - Msg.YPos) > GetSystemMetrics(SM_CYDRAG))) then begin FCallFinishClickSelect := False; FClickPos := cInvalidUIPoint; // GMClientToScreen(Self, SmallPointToPoint(Msg.Pos)) Container.StartDrag(GMAddPoints(SmallPointToPoint(Msg.Pos), ClientAreaOrigin, -1), Self); end; end; procedure TGMRowAreaBase.WMLButtonUp(var Msg: TWMMouse); begin GMReleaseMouseCapture; FClickPos := cInvalidUIPoint; if FCallFinishClickSelect then begin FCallFinishClickSelect := False; FinishClickSelect; end; //inherited; end; function TGMRowAreaBase.InternalPaintToRect(const DC: HDC; const RSurface: TRect): Boolean; begin Result := inherited InternalPaintToRect(DC, RSurface); if (Container.FFocusedRowIdx = AbsoluteRowIdx) and Container.HasFocus then DrawFocusRect(Dc, RSurface); end; { ------------------------- } { ---- TGMRowChildArea ---- } { ------------------------- } constructor TGMRowChildArea.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ABkgndColor: COLORREF; const AVisible, ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, ABkgndColor, AVisible, ARefLifeTime); GMCheckFindParentObj(Self, TGMRowAreaBase, FRow); GMCheckFindParentObj(Self, TGMRowedAreaBase, FContainer); end; { ---------------------- } { ---- TEditorState ---- } { ---------------------- } {constructor TEditorState.Create(const AContainer: TObject; const AEditor: IUnknown; const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); //FContainer := AContainer; AssignFromIntf(AEditor); end; procedure TEditorState.AssignFromIntf(const ASource: IUnknown); var PIArea: IGMUiArea; //PIParent: IGMGetSetParentObj; begin if GMQueryInterface(ASource, IGMUiArea, PIArea) then begin FEditorLayoutBounds := PIArea.LayoutBounds; FEditorAreaAlign := PIArea.AreaAlign; PIArea.AreaAlign := cFixedPlace; PIArea.SetLayoutBounds(GMRect(-1000000, -1000000, -1000000, -1000000), False); end; //if GMQueryInterface(ASource, IGMGetSetParentObj, PIParent) then // begin // FEditorParent := PIParent.ParentObj; // PIParent.SetParentObj(FContainer); // end; end; procedure TEditorState.AssignToIntf(const ADest: IUnknown); var PIArea: IGMUiArea; //PIParent: IGMGetSetParentObj; begin if GMQueryInterface(ADest, IGMUiArea, PIArea) then begin PIArea.AreaAlign := FEditorAreaAlign; PIArea.SetLayoutBounds(FEditorLayoutBounds, False); end; //if GMQueryInterface(ADest, IGMGetSetParentObj, PIParent) then PIParent.SetParentObj(FEditorParent); end;} { -------------------------- } { ---- TGMRowedAreaBase ---- } { -------------------------- } constructor TGMRowedAreaBase.Create(const ARefLifeTime: Boolean); begin inherited; FSelectedIndexes := TGMIntegerMap.Create(SelectedIndexesChanged, True); FSelectedIndexes.Obj.OnDecideAddValue := CanSelectAbsIdx; FTabStop := True; FWasTabStop := FTabStop; FFocusedRowIdx := cInvalidItemIdx; FDropHighliteIdx := cInvalidItemIdx; end; procedure TGMRowedAreaBase.RemoveEntry(const AAbsoluteIndex: Integer); begin // Noting! end; procedure TGMRowedAreaBase.RemoveSelectedEntries; begin // Noting! end; procedure TGMRowedAreaBase.ExecContextMenu; begin // Noting! end; procedure TGMRowedAreaBase.StartDrag(const ADragOffs: TPoint; const ARow: TGMRowAreaBase); begin // Nothing, override in derived class! end; procedure TGMRowedAreaBase.AfterSelectionChanged; begin if Assigned(OnAfterSelectionChange) then OnAfterSelectionChange(Self); end; function TGMRowedAreaBase.CanSelectAbsIdx(const AAbsoluteRowIdx: PtrInt): Boolean; begin // CanSelect cannot be decided by the row area. We need to be able to answer this even if there is // no visible row area for the index, because it has been scrolled out in TGMVirtualRowsArea! Result := True; end; //procedure TGMRowedAreaBase.HideEditor; //begin //if Editor <> nil then FEditorstate := TEditorState.Create(Self, Editor, True); //end; //procedure TGMRowedAreaBase.ShowEditor(const ARow: TGMRowAreaBase); //begin //FWasTabStop := FTabStop; //FTabStop := False; //if FEditorState <> nil then // begin // FEditorState.AssignToIntf(FEditor); // FEditorState := nil; // end; //end; procedure TGMRowedAreaBase.CloseEditor(const AApplyChanges: Boolean; const AOpaqueData: IUnknown); //var Param: IUnknown; begin if FEditor <> nil then begin FTabStop := FWasTabStop; // if not AUpdatePersistentStorage then Param := TGMRefCountedObj.Create(True); // <- used just as boolean information if AApplyChanges then GMExecuteOperation(FEditor, Ord(roApplyChanges), AOpaqueData); // FEditorstate := TEditorState.Create(Self, Editor, True); FEditor := nil; ScheduleRepaint; GMSetFocus(Self); end; end; function TGMRowedAreaBase.IsTabStop: Boolean; begin Result := FTabStop; end; function TGMRowedAreaBase.RowAreaIdxFromAbsRowIdx(const AAbsoluteRowIdx: Integer): Integer; begin Result := AAbsoluteRowIdx; end; function TGMRowedAreaBase.InternalPaintToRect(const ADC: HDC; const ARSurface: TRect): Boolean; var PIDragVisible: IGMSetVisible; begin if GMQueryInterface(vGMDragPainter, IGMSetVisible, PIDragVisible) then PIDragVisible.SetVisible(False, False); try Result := inherited InternalPaintToRect(ADC, ARSurface); finally if PIDragVisible <> nil then PIDragVisible.SetVisible(True, False); end; end; function TGMRowedAreaBase.SubtractContainedAreas(const ARect: TRect; const ARegion: HRGN): Boolean; var RgnChild: IGMGetHandle; rCovered: TRect; lastRow: TObject; begin Result := False; if ARegion = 0 then Exit; lastRow := ContainedAreas.Last; if not (lastRow is TGMUiAreaBase) then Exit; rCovered := GMRect(cNullPoint, GMRectSize(ARect)); rCovered.Bottom := Min(rCovered.Bottom, TGMUiAreaBase(lastRow).LayoutBounds.Bottom + ScrollOffset.y); rCovered := GMMoveRect(rCovered, GMAddPoints(ARect.TopLeft, ScrollOffset)); RgnChild := TGMGdiRegion.CreateRect(0, rCovered); if CombineRgn(ARegion, ARegion, RgnChild.Handle, RGN_DIFF) = NULLREGION then Result := True; end; function TGMRowedAreaBase.RowAreaForAbsIdx(const AAbsoluteRowIdx: Integer): TObject; var childIdx: Integer; begin if AAbsoluteRowIdx = cInvalidItemIdx then begin Result := nil; Exit; end; childIdx := RowAreaIdxFromAbsRowIdx(AAbsoluteRowIdx); if ContainedAreas.IsValidIndex(childIdx) then Result := ContainedAreas[childIdx] else Result := nil; end; procedure TGMRowedAreaBase.SetFocusedRowByAbsIdx(const AAbsoluteRowIdx: Integer); var row: TObject; begin row := RowAreaForAbsIdx(AAbsoluteRowIdx); if row is TGMRowAreaBase then begin TGMRowAreaBase(row).ClickSelect([]); TGMRowAreaBase(row).Focus; end; end; procedure TGMRowedAreaBase.SelectedIndexesChanged(const AAbsRowIdx: PtrInt); var row: TObject; begin row := RowAreaForAbsIdx(AAbsRowIdx); if row is TGMRowAreaBase then TGMRowAreaBase(row).AfterSelectionStateChanged; end; procedure TGMRowedAreaBase.NotifyAfterFocusedRowChange(const ARow: TGMRowAreaBase); begin if Assigned(OnAfterFocusedRowChange) then OnAfterFocusedRowChange(ARow); end; function TGMRowedAreaBase.RowAreaCount: Integer; begin Result := FRowAreaCount; end; function TGMRowedAreaBase.TotalRowCount: Integer; begin Result := RowAreaCount; end; function TGMRowedAreaBase.IsEmpty: Boolean; begin Result := TotalRowCount <= 0; // ContainedAreas.IsEmpty; end; procedure TGMRowedAreaBase.WMKillFocus(var Msg: TWMKillFocus); begin inherited; RepaintSelectedEntries; end; procedure TGMRowedAreaBase.WMSetFocus(var Msg: TWMSetFocus); begin inherited; if GMObjFromIntf(FEditor) <> nil then GMSetFocus(GMObjFromIntf(FEditor)) else RepaintSelectedEntries; end; procedure TGMRowedAreaBase.WMGetDlgCode(var Msg: TMessage); begin //inherited; Msg.Result := Msg.Result or DLGC_WANTARROWS; end; procedure TGMRowedAreaBase.WMRButtonDown(var Msg: TWMMouse); begin inherited; ExecContextMenu; end; //procedure TGMRowedAreaBase.SetSelectionRange(AStartAbsoluteIdx, AEndAbsoluteIdx: PtrInt); //var absIdx: PtrInt; //begin //if AEndAbsoluteIdx < AStartAbsoluteIdx then GMExchangePtrInt(AStartAbsoluteIdx, AEndAbsoluteIdx); //// ////for absIdx := Max(AStartAbsoluteIdx, 0) to Min(AEndAbsoluteIdx, TotalRowCount-1) do //// if CanSelectAbsIdx(absIdx) then SelectedIndexes.Obj.Add(absIdx); // //SelectedIndexes.Obj.SetRange(Max(AStartAbsoluteIdx, 0), Min(AEndAbsoluteIdx, TotalRowCount-1)); //end; procedure TGMRowedAreaBase.SelectAll; begin SelectedIndexes.Obj.SetRange(0, TotalRowCount-1); AfterSelectionChanged; end; procedure TGMRowedAreaBase.RepaintSelectedEntries; var i: Integer; begin for i:=0 to SelectedIndexes.Obj.Count-1 do GMScheduleRepaint(RowAreaForAbsIdx(SelectedIndexes.Obj[i])); GMScheduleRepaint(RowAreaForAbsIdx(FFocusedRowIdx)); end; procedure TGMRowedAreaBase.SetDropHighliteIdx(const Value: Integer); var oldRow, newRow: TObject; begin if Value = FDropHighliteIdx then Exit; oldRow := RowAreaForAbsIdx(FDropHighliteIdx); newRow := RowAreaForAbsIdx(Value); FDropHighliteIdx := Value; if not (oldRow is TGMRowAreaBase) or TGMRowAreaBase(oldRow).CanDropHighLite then GMScheduleRepaint(oldRow); if not (newRow is TGMRowAreaBase) or TGMRowAreaBase(newRow).CanDropHighLite then GMScheduleRepaint(newRow); if (oldRow = nil) or (newRow = nil) then RepaintSelectedEntries; end; procedure TGMRowedAreaBase.WMChar(var Msg: TWMKey); begin inherited; case Chr(Msg.CharCode) of ^A: SelectAll; // FPassMessageToOriginalHandler := False; end; end; procedure TGMRowedAreaBase.WMKeyDown(var Msg: TWMKey); var keyState: SGMKeyStates; extendSelection: Boolean; oldIdx: Integer; rowArea: TObject; begin inherited; keyState := GMKeyDataToKeyState(Msg.KeyData); //if (Msg.CharCode = VK_DELETE) and (keyState = []) then begin RemoveSelectedEntries; if IsEmpty then Exit; end; extendSelection := FMultiSelect and (ksShift in keyState); keyState := keyState - [ksShift]; if not extendSelection and (keyState = []) then FExtendSelAbsIdx := FFocusedRowIdx; oldIdx := FExtendSelAbsIdx; if keyState = [] then case Msg.CharCode of VK_UP: Dec(FExtendSelAbsIdx); VK_DOWN: Inc(FExtendSelAbsIdx); VK_PRIOR: Dec(FExtendSelAbsIdx, Max(0, RowAreaCount-1)); VK_NEXT: Inc(FExtendSelAbsIdx, Max(0, RowAreaCount-1)); VK_HOME: FExtendSelAbsIdx := 0; VK_END: FExtendSelAbsIdx := TotalRowCount-1; VK_DELETE: begin RemoveSelectedEntries; if IsEmpty then begin AfterSelectionChanged; Exit; end; end; else Exit; // <- NOTE: Exit Here! end; //if keyState = [ksCtrl] then // begin // end; FExtendSelAbsIdx := GMBoundedInt(FExtendSelAbsIdx, 0, TotalRowCount-1, False); if FExtendSelAbsIdx = oldIdx then Exit; // <- NOTE: Exit Here! ScrollVisible(FExtendSelAbsIdx); // <- must be done before new selection is set! if extendSelection then begin SelectedIndexes.Obj.SetRange(FFocusedRowIdx, FExtendSelAbsIdx); end else begin SelectedIndexes.Obj.Clear(True); rowArea := RowAreaForAbsIdx(FExtendSelAbsIdx); if rowArea is TGMRowAreaBase then with TGMRowAreaBase(rowArea) do begin SetSelected(True); Focus; end; // else // begin // FFocusedRowIdx := FExtendSelAbsIdx; // SelectedIndexes.Obj.Add(FFocusedRowIdx); // end; end; AfterSelectionChanged; end; procedure TGMRowedAreaBase.WMMouseWheel(var Msg: TWMMouseWheel); //const cSign: array [Boolean] of Integer = (1, -1); cPercent: array [Boolean] of Double = (0.125, 0.66); var scroll: IGMScrollBar; begin if GMGetInterface(FScrollBar, IGMScrollBar, scroll) then //scroll.Position := scroll.Position - Round(ClientAreaSize.y * cSign[Msg.WheelDelta < 0] * cPercent[GetKeyState(VK_CONTROL) < 0]); scroll.Position := scroll.Position - GMWheelScrollDelta(ClientAreaSize.y, Msg.WheelDelta); Msg.Result := 1; end; procedure TGMRowedAreaBase.OnScrollPosChange(const AOldPos, ANewPos: Integer); var wnd: HWnd; rScroll, rUpdate: Trect; //DC: HDC; begin if not Visible or (AOldPos = ANewPos) or not GMFindAllocatedParentHandle(Parent, wnd) then Exit; rScroll := GMCalculateClientRect(Frame, PaintingRect); // CalculateSurfaceRect(LayoutBounds)); ScrollWindowEx(wnd, 0, AOldPos - ANewPos, @rScroll, @rScroll, 0, @rUpdate, SW_INVALIDATE or SW_ERASE or SW_SCROLLCHILDREN); //DC := GetDC(wnd); //if DC = 0 then Exit; //try // ScrollDC(DC, 0, AOldPos - ANewPos, rScroll, rScroll, 0, @rUpdate); //finally // ReleaseDC(wnd, DC); //end; ScrollOffset.y := -ANewPos; SurfaceOriginChanged; InvalidateRect(wnd, @rUpdate, False); end; procedure TGMRowedAreaBase.ScrollChildAreaVisible(const AAreaRect: TRect); var RSurface: TRect; PIScroll: IGMScrollBar; begin if not GMGetInterface(FScrollBar, IGMScrollBar, PIScroll) then Exit; RSurface := GMRect(GMPoint(0, 0), ClientAreaSize); //PaintingRect; if AAreaRect.Top + ScrollOffset.y < RSurface.Top then PIScroll.Position := AAreaRect.Top // + RSurface.Top else if AAreaRect.Bottom + ScrollOffset.y > RSurface.Bottom then PIScroll.Position := Min(AAreaRect.Top, AAreaRect.Bottom - GMRectSize(RSurface).y); //PIScroll.Position := Min(AAreaRect.Top + RSurface.Top, AAreaRect.Bottom - GMRectSize(RSurface).y + RSurface.Top); end; procedure TGMRowedAreaBase.ScrollVisible(const AAbsoluteIndex: Integer); var PIArea: IGMUiArea; // row: TObject; begin if GMGetInterface(RowAreaForAbsIdx(AAbsoluteIndex), IGMUiArea, PIArea) then ScrollChildAreaVisible(PIArea.LayoutBounds); //if GMIsInRange(AAbsoluteIndex, 0, TotalRowCount-1) and // ContainedAreas[RowAreaIdxFromAbsRowIdx(AAbsoluteIndex)].GetInterface(IGMUiArea, PIArea) then // ScrollChildAreaVisible(PIArea.LayoutBounds); {begin RSurface := GMRect(GMPoint(0, 0), ClientAreaSize); //PaintingRect; RBounds := PIArea.LayoutBounds; if RBounds.Top + ScrollOffset.y < RSurface.Top then ScrollBar.Position := RBounds.Top + RSurface.Top //OnScrollPosChange(-ScrollOffset.y, RBounds.Top + RSurface.Top) //VScroll(SB_THUMBPOSITION, RBounds.Top + RSurface.Top, True) else if RBounds.Bottom + ScrollOffset.y > RSurface.Bottom then ScrollBar.Position := RBounds.Bottom - GMRectSize(RSurface).y + RSurface.Top; //OnScrollPosChange(-ScrollOffset.y, RBounds.Bottom - GMRectSize(RSurface).y + RSurface.Top); //VScroll(SB_THUMBPOSITION, RBounds.Bottom - GMRectSize(RSurface).y + RSurface.Top, True); end;} end; { ---------------------------- } { ---- TGMBoundingRowArea ---- } { ---------------------------- } constructor TGMBoundingRowArea.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const APaddSpace: TPoint; const AAbsoluteRowIdx: Integer; const AData: IUnknown; const ABkgndColor: COLORREF; const AVisible, ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, AAbsoluteRowIdx, AData, ABkgndColor, AVisible, ARefLifeTime); FPaddSpace := APaddSpace; end; function TGMBoundingRowArea.RootForRelayout: TObject; begin // Child Text change => child size change => relayout parent (us) // since our size depends on child sizes we need to forward re-layout to our parent. Result := GMParentRootForRelayout(Self); end; function TGMBoundingRowArea.InternalcalcHeight(const ANewSize: TPoint): Integer; begin // The caller will assign his layoutbounds just after this. // So temporary setting our bounds to be able to correctly layout childs does no harm. Result := GMCalcBoundingHeight(Self, ANewSize) + FPaddSpace.y; end; function TGMBoundingRowArea.InternalCalcWidth(const ANewSize: TPoint): Integer; begin // The caller will assign his layoutbounds just after this. // So temporary setting our bounds to be able to correctly layout childs does no harm. Result := GMCalcBoundingWidth(Self, ANewSize) + FPaddSpace.x; end; { --------------------- } { ---- TGMListArea ---- } { --------------------- } procedure TGMListArea.LayoutContainedAreas(const ARepaint: Boolean); // : TPoint; var vScrollMax, vScrollPgSz: Integer; scrollBarArea: IGMUiArea; scroll: IGMScrollBar; // PIVisible: IGMGetSetVisible; begin inherited LayoutContainedAreas(ARepaint); //if (ScrollBar = nil) then Exit; // or not ScrollBar.HandleAllocated if not GMGetInterface(FScrollBar, IGMScrollBar, scroll) then Exit; if ContainedAreas.Last is TGMUiAreaBase then vScrollMax := Max(0, TGMUiAreaBase(ContainedAreas.Last).LayoutBounds.Bottom-1) else vScrollMax := 0; vScrollPgSz := Max(0, ClientAreaSize.y); if GMGetInterface(FScrollBar, IGMUiArea, scrollBarArea) then begin if AlwaysShowScrollBar then scrollBarArea.SetVisible(true) else if (scrollBarArea.Visible <> (vScrollMax >= vScrollPgSz)) then scrollBarArea.SetVisible(vScrollMax >= vScrollPgSz); end; scroll.MaxPosition := vScrollMax; //ScrollBar.PageSize := vScrollPgSz; //if HandleAllocated then ScrollOffset.y := -GMScrollDataFromWnd(Handle, SB_VERT, SIF_POS).nPos; end; function TGMListArea.AddRow(const ANewRow: TGMRowAreaBase; const AFocus: Boolean; const AAddToOwned: Boolean): TGMRowAreaBase; begin //Result := OwnArea(TGMBoundingRowArea.Create(Self, ContainedAreas.Count, AEntries, AData, AOwnData)) as TGMBoundingRowArea; Result := ANewRow; if ANewRow <> nil then begin if AAddToOwned then OwnArea(ANewRow); LayoutContainedAreas(False); if AFocus then begin SelectedIndexes.Obj.Clear(True); if not FWithoutSelection then Result.SetSelected(True); Result.Focus; end; end; end; procedure TGMListArea.BeforeRemoveRow(const ARow: TGMRowAreaBase); begin //if Assigned(OnBeforeRemove) then OnBeforeRemove(ARow); end; procedure TGMListArea.RemoveOwnedArea(const AIdx: Integer); begin if OwnedAreas[AIdx] is TGMBoundingRowArea then BeforeRemoveRow(OwnedAreas[AIdx] as TGMBoundingRowArea); OwnedAreas.RemoveByIdx(AIdx); // <- will remove itself from our ContainedAreas list! end; procedure TGMListArea.RemoveAllEntries(const ANotifyUI: Boolean; ARowAreaClass: TClass); var i: Integer; begin if ARowAreaClass = nil then ARowAreaClass := TGMRowAreaBase; for i:=OwnedAreas.Count-1 downto 0 do if OwnedAreas[i] is ARowAreaClass then RemoveOwnedArea(i); FFocusedRowIdx := cInvalidItemIdx; SelectedIndexes.Obj.Clear(False); if ANotifyUI then begin NotifyAfterFocusedRowChange(nil); ScheduleRepaint; end; end; procedure TGMListArea.RemoveEntry(const AAbsoluteIndex: Integer); var ownedIdx, oldFocusIdx: Integer; begin oldFocusIdx := FFocusedRowIdx; ownedIdx := OwnedAreas.IndexOfObj(ContainedAreas[AAbsoluteIndex]); if OwnedAreas.IsValidIndex(ownedIdx) then begin RemoveOwnedArea(ownedIdx); SelectedIndexes.Obj.Remove(AAbsoluteIndex); inherited; AdjustAfterRemove(oldFocusIdx); end; end; procedure TGMListArea.RemoveSelectedEntries; var i, oldFocusIdx: Integer; begin if SelectedIndexes.Obj.IsEmpty then Exit; oldFocusIdx := FFocusedRowIdx; for i:=OwnedAreas.Count-1 downto 0 do if (OwnedAreas[i] is TGMBoundingRowArea) and SelectedIndexes.Obj.Contains((OwnedAreas[i] as TGMBoundingRowArea).AbsoluteRowIdx) then RemoveOwnedArea(i); SelectedIndexes.Obj.Clear(False); inherited; AdjustAfterRemove(oldFocusIdx); end; procedure TGMListArea.AdjustAfterRemove(const AOldFocusIdx: Integer); var i, rowIdx: Integer; row: TObject; searchDown: Boolean; begin //if TotalRowCount = 0 then FFocusedRowIdx := cInvalidItemIdx; // <- The Focused index may stay valid but the row may be a different one -> force a NotifyAfterFocusedRowChange call! for i:=0 to ContainedAreas.Count-1 do if ContainedAreas[i] is TGMRowAreaBase then (ContainedAreas[i] as TGMBoundingRowArea).AbsoluteRowIdx := i; if TotalRowCount = 0 then NotifyAfterFocusedRowChange(nil) else if not FWithoutSelection then begin rowIdx := GMBoundedInt(AOldFocusIdx, 0, ContainedAreas.Count-1); searchDown := rowIdx <= 0; repeat row := RowAreaForAbsIdx(rowIdx); if searchDown then Inc(rowIdx) else Dec(rowIdx); until (row = nil) or CanSelectAbsIdx(rowIdx); if row = nil then begin FFocusedRowIdx := cInvalidItemIdx; NotifyAfterFocusedRowChange(nil); end else begin TGMRowAreaBase(row).SetSelected(True); TGMRowAreaBase(row).Focus; TGMRowAreaBase(row).ScrollVisible; end; end; LayoutContainedAreas(False); ScheduleRepaint; end; procedure TGMListArea.MoveRow(const AAbsoluteRowIdx, ADelta: Integer); var rowIdx: Integer; begin if (ADelta = 0) then Exit; // or not ContainedAreas.IsValidIndex(AAbsoluteRowIdx) or not ContainedAreas.IsValidIndex(AAbsoluteRowIdx + ADelta) then Exit; ContainedAreas.Exchange(AAbsoluteRowIdx, AAbsoluteRowIdx + ADelta); // Echange AbsoluteRowIdx values rowIdx := (ContainedAreas[AAbsoluteRowIdx] as TGMBoundingRowArea).AbsoluteRowIdx; (ContainedAreas[AAbsoluteRowIdx] as TGMBoundingRowArea).AbsoluteRowIdx := (ContainedAreas[AAbsoluteRowIdx + ADelta] as TGMBoundingRowArea).AbsoluteRowIdx; (ContainedAreas[AAbsoluteRowIdx + ADelta] as TGMBoundingRowArea).AbsoluteRowIdx := rowIdx; // Correct FFocusedRowIdx if FFocusedRowIdx = AAbsoluteRowIdx then FFocusedRowIdx := AAbsoluteRowIdx + ADelta else if FFocusedRowIdx = AAbsoluteRowIdx + ADelta then FFocusedRowIdx := AAbsoluteRowIdx - ADelta; // Correct SelectedIndexes if SelectedIndexes.Obj.Contains(AAbsoluteRowIdx) <> SelectedIndexes.Obj.Contains(AAbsoluteRowIdx + ADelta) then begin SelectedIndexes.Obj.Toggle(AAbsoluteRowIdx); SelectedIndexes.Obj.Toggle(AAbsoluteRowIdx + ADelta); end; LayoutContainedAreas(False); ScheduleRepaint; end; { ----------------------- } { ---- TGMVirtualRow ---- } { ----------------------- } constructor TGMVirtualRow.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ABkgndColor: COLORREF; const AVisible, ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, ABkgndColor, AVisible, ARefLifeTime); GMCheckFindParentObj(Self, TGMVirtualRowsArea, FContainer); end; function TGMVirtualRow.GetLayoutBounds: TRect; begin Result := inherited GetLayoutBounds; Result.Top := AbsoluteRowIdx * TGMVirtualRowsArea(Container).RowHeight; Result.Bottom := Result.Top + TGMVirtualRowsArea(Container).RowHeight; end; procedure TGMVirtualRow.LoadValues(const ASource: IUnknown; const AClearValues: Boolean); begin // Nothing! Override in derived classes to fill the row contents. Data := ASource; end; procedure TGMVirtualRow.SetAbsoluteRowIdx(const AValue: Integer); //var PIArea: IGMUiArea; begin if AValue = FAbsoluteRowIdx then Exit; //if (Container.FFocusedRowIdx = FAbsoluteRowIdx) and (FAbsoluteRowIdx <> cInvalidItemIdx) and (Container.Editor <> nil) then Container.HideEditor; inherited SetAbsoluteRowIdx(AValue); // <- sets FAbsoluteRowIdx member //if (Container.FFocusedRowIdx = AValue) and (Container.Editor <> nil) then Container.ShowEditor(Self); if Container is TGMVirtualRowsArea then LoadValues(TGMVirtualRowsArea(Container).DataSource, True); end; { ---------------------------- } { ---- TGMVirtualRowsArea ---- } { ---------------------------- } constructor TGMVirtualRowsArea.Create(const ARefLifeTime: Boolean); begin inherited; FRowHeight := cDfltRowHeight; FRowAlign := cDfltGridRowAlign; end; constructor TGMVirtualRowsArea.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ADataSource: IUnknown; const ABkgndColor: COLORREF; const AVisible, ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, ABkgndColor, AVisible, ARefLifeTime); //GMCheckFindParentObj(Self, TGMGridCtrl, FGrid); FDataSource := ADataSource; ClippedPainting := True; // <- with scrolling rows may overflow other areas end; function TGMVirtualRowsArea.RowCreateClass: TGMVirtualRowClass; begin Result := TGMVirtualRow; end; function TGMVirtualRowsArea.RowAreaIdxFromAbsRowIdx(const AAbsoluteRowIdx: Integer): Integer; begin if (RowAreaCount = 0) or not (ContainedAreas.First is TGMRowAreaBase) then Result := AAbsoluteRowIdx else Result := AAbsoluteRowIdx - TGMRowAreaBase(ContainedAreas.First).AbsoluteRowIdx; end; function TGMVirtualRowsArea.TotalRowCount: Integer; var PICount: IGMGetCount; begin if GMQueryInterface(DataSource, IGMGetCount, PICount) then Result := PICount.Count else Result := 0; end; procedure TGMVirtualRowsArea.ReloadRows(ARowAreaStartIdx: Integer; const ARepaint: Boolean); var i: Integer; begin ARowAreaStartIdx := Max(0, ARowAreaStartIdx); for i:=ARowAreaStartIdx to ContainedAreas.Count-1 do if ContainedAreas[i] is TGMVirtualRow then begin TGMVirtualRow(ContainedAreas[i]).LoadValues(DataSource, False); if ARepaint then TGMVirtualRow(ContainedAreas[i]).ScheduleRepaint; end; end; procedure TGMVirtualRowsArea.AdjustAfterRemove(const ARefreshStartAbsIdx: Integer; const ARepaint: Boolean); var RefreshChildIdx: Integer; begin AdjustRowCount(False, ARepaint); ScrollRangeChanged; if not FWithoutSelection then if GMGetIntfCount(DataSource) = 0 then FFocusedRowIdx := cInvalidItemIdx else begin FFocusedRowIdx := GMBoundedInt(FFocusedRowIdx, 0, GMGetIntfCount(DataSource)-1); SelectedIndexes.Obj.Add(FFocusedRowIdx); end; if ARefreshStartAbsIdx < 0 then RefreshChildIdx := 0 else RefreshChildIdx := RowAreaIdxFromAbsRowIdx(ARefreshStartAbsIdx); ReloadRows(RefreshChildIdx, ARepaint); // <- AdjustRowCount scheduled repaint before end; procedure TGMVirtualRowsArea.RemoveAllRows(const ARepaint: Boolean); var i: Integer; // , OldCount begin SelectedIndexes.Obj.Clear(True); NotifyAfterFocusedRowChange(nil); //OldCount := OwnedAreas.Count; for i:=OwnedAreas.Count-1 downto 0 do if OwnedAreas[i] is TGMVirtualRow then OwnedAreas.RemoveByIdx(i); // <- will remove itself from our ContainedAreas list! if ARepaint then ScheduleRepaint; //if OldCount <> OwnedAreas.Count then ScrollRangeChanged; end; procedure TGMVirtualRowsArea.SetLayoutBounds(const ARect: TRect; const AInvalidate: Boolean); begin if (ARect.Bottom - ARect.Top) <> GMRectSize(LayoutBounds).y then AdjustVisibleRowCount((ARect.Bottom - ARect.Top), False, False); inherited SetLayoutBounds(ARect, AInvalidate); end; procedure TGMVirtualRowsArea.ScrollVisible(const AAbsoluteRowIndex: Integer); begin ScrollChildAreaVisible(GMRect(0, AAbsoluteRowIndex * RowHeight, 0, (AAbsoluteRowIndex + 1) * RowHeight)); end; procedure TGMVirtualRowsArea.AdjustRowCount(const Relayout, Invalidate: Boolean); begin AdjustVisibleRowCount(ClientAreaSize.y, Relayout, Invalidate); // GMRectSize(LayoutBounds).y end; function TGMVirtualRowsArea.AddRowWithLayout(const AInsertIdx: Integer; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec): TGMVirtualRow; begin Assert(RowCreateClass <> nil); Result := OwnArea(RowCreateClass.Create(Self, APosition, AAreaAlign, BkgndColor)) as TGMVirtualRow; if AInsertIdx < ContainedAreas.Count-1 then ContainedAreas.Exchange(AInsertIdx, ContainedAreas.Count-1); // // Setting AbsoluteRowIdx must be range secured here if not done in RowArea.LoadValues method // Result.AbsoluteRowIdx := AInsertIdx - ScrollOffset.y div RowHeight; // <- ScrollOffset.y is <= 0! if GMParentHandleAllocated(Self) then Result.CreateHandle; end; function TGMVirtualRowsArea.AddRow(const AInsertIdx: Integer): TGMVirtualRow; begin // GMRect(0, ContainedAreas.Count * RowHeight, 0, (ContainedAreas.Count + 1) * RowHeight) Result := AddRowWithLayout(AInsertIdx, cNullRect, FRowAlign); end; procedure TGMVirtualRowsArea.RemoveLastRow; begin // // Note: ContainedAreas may be rotated! // //OwnedAreas.Delete(OwnedAreas.IndexOfObj(ContainedAreas.Last)); OwnedAreas.RemoveByInstance(ContainedAreas.Last); end; procedure TGMVirtualRowsArea.ScrollRangeChanged; var scroll: IGMScrollBar; count: IGMGetCount; begin if not GMGetInterface(FScrollBar, IGMScrollBar, scroll) or not GMQueryInterface(DataSource, IGMGetCount, count) then Exit; scroll.MaxPosition := count.Count * RowHeight - 1; if FFocusedRowIdx >= 0 then FFocusedRowIdx := GMBoundedInt(FFocusedRowIdx, 0, count.Count-1, False); end; procedure TGMVirtualRowsArea.AdjustVisibleRowCount(const Height: Integer; const Relayout, Invalidate: Boolean); var rowsNeeded, i, rowCount: Integer; dataSrcCount: IGMGetCount; begin if not GMQueryInterface(DataSource, IGMGetCount, dataSrcCount) then Exit; rowCount := RowAreaCount; rowsNeeded := Max(0, Min(dataSrcCount.Count, (Height + RowHeight - 1) div RowHeight + 1)); if rowCount = rowsNeeded then Exit; if rowCount > rowsNeeded then for i:=0 to rowCount - rowsNeeded - 1 do RemoveLastRow else if rowCount < rowsNeeded then for i:=0 to rowsNeeded - rowCount - 1 do // ScrollOffset.y is always negative (or zero)! if rowCount - ScrollOffset.y div RowHeight >= dataSrcCount.Count then AddRow(0) else AddRow(ContainedAreas.Count); if Relayout then LayoutContainedAreas(False); if Invalidate then ScheduleRepaint; //ScrollRangeChanged; end; procedure TGMVirtualRowsArea.OnScrollPosChange(const AOldPos, ANewPos: Integer); var i, RowDelta: Integer; FocusedRow: TObject; //PICount: IGMGetCount; procedure SetupRowIdx(const Row: TObject; const AAbsoluteRowIdx: Integer); begin // // Its much simpler to secure the range in the RowArea.LoadValues method // if (Row is TGMVirtualRow) then //and ((PICount = nil) or (AAbsoluteRowIdx < PICount.Count)) then TGMVirtualRow(Row).AbsoluteRowIdx := AAbsoluteRowIdx; end; begin inherited OnScrollPosChange(AOldPos, ANewPos); RowDelta := (AOldPos div RowHeight) - (ANewPos div RowHeight); if RowDelta = 0 then Exit; //if not GMQueryInterface(DataSource, IGMGetCount, PICount) then PICount := nil; if Abs(RowDelta) >= ContainedAreas.Count then for i:=0 to ContainedAreas.Count-1 do SetupRowIdx(ContainedAreas[i], ANewPos div RowHeight + i) else begin ContainedAreas.Rotate(RowDelta); if RowDelta > 0 then for i:=0 to RowDelta-1 do SetupRowIdx(ContainedAreas[i], ANewPos div RowHeight + i) else // RowDelta less than zero! for i := ContainedAreas.Count + RowDelta to ContainedAreas.Count-1 do SetupRowIdx(ContainedAreas[i], ANewPos div RowHeight + i); end; // // This is only needed because we are windowless and the editor might be windowed! // Can be dropped if we become windowed or the editor becomes wondowless. // if FEditor <> nil then begin FocusedRow := RowAreaForAbsIdx(FFocusedRowIdx); if FocusedRow is TGMUiAreaBase then TGMUiAreaBase(FocusedRow).LayoutContainedAreas(True); end; end; end.