Delphi控件源码

开发平台：

Delphi

fcdbtreeview.pas：源码内容

begin
Down:= True;
InvalidateRow(MouseRow); { Invalidate button icon }
SetCapture(Handle);
try
while GetCapture = Handle do
begin
GetCursorPos(ACursor);
case Integer(GetMessage(Msg, 0, 0, 0)) of
-1: Break;
0: begin
PostQuitMessage(Msg.WParam);
Break;
end;
end;
case Msg.Message of
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: ;
WM_MOUSEMOVE: MouseLoop_MouseMove(X, Y, ACursor);
WM_LBUTTONUP: begin
MouseLoop_MouseUp(X, Y, ACursor);
TranslateMessage(Msg); // So OnMouseUp fires
DispatchMessage(Msg);
if GetCapture = Handle then ReleaseCapture;
end;
else begin
TranslateMessage(Msg); // So OnMouseUp fires
DispatchMessage(Msg);
end;
end;
end;
finally
if GetCapture = Handle then ReleaseCapture;
if Dragging then EndDrag(False);
end;
end;
Function TfcDBCustomTreeView.TextRect(Node: TfcDBTreeNode; Row: integer): TRect;
var R: TRect;
begin
R:= Rect(FixedOffset + (Node.Level+1)*LevelIndent, row*RowHeight, Width,
(row+1)*RowHeight-1);
if Images<>nil then r.Left:= r.Left + TImageList(Images).Width;
if UseStateImages(Node) then r.Left:= r.Left + GetStateImageWidth;
if (Images<>nil) and (UseStateImages(Node)) then
r.Left:= r.Left + 1;
if Header<>nil then
begin
R.Right:= R.Left + ClientWidth + HorzScrollBar.position;
end
else begin
R.Right:= R.Left + FPaintCanvas.TextWidth(Node.Text) + 3;
end;
if not (dtvoShowRoot in Options) then begin
r.Left:= r.Left - LevelIndent;
r.Right:= r.Right - LevelIndent;
end;
result:= R;
end;
Function TfcDBCustomTreeView.LevelRect(Node: TfcDBTreeNode): TRect;
var r: TRect;
row: Integer;
begin
r:= Rect(0,0,0,0);
r.Left:= Node.Level * LevelIndent + FixedOffset;
// if Images<>nil then
r.Right:= r.Left + LevelIndent - 1;
// else r.Right:= r.Left + LevelIndent - 4;
if NodeToRow(Node, Row) then begin
r.Top:= Row * RowHeight;
r.Bottom:= (Row+1) * RowHeight -1;
end
else begin
r.Top:= 0;
r.Bottom:= RowHeight-1;
end;
if not (dtvoShowRoot in Options) then begin
if Node.Level=0 then
begin
r.Left:= 0;
r.Right:= 0;
end
else begin
r.Left:= r.Left - LevelIndent;
r.Right:= r.Right - LevelIndent;
end
end;
result:= r;
end;
Function TfcDBCustomTreeView.GetCenterPoint(ARect: TRect): TPoint;
var r: TRect;
begin
r:= ARect;
if odd(fcRectHeight(r) div 2) then
result.y:= r.Top + (fcRectHeight(r)+2) div 2
else
result.y:= r.Top + (fcRectHeight(r)) div 2;
result.x:= r.Left + (fcRectWidth(r)) div 2
end;
procedure TfcDBCustomTreeView.PaintImage(Node: TfcDBTreeNode);
const ItemChecked: array[Boolean] of Integer = (0, DFCS_CHECKED);
CheckBoxFlat: array[Boolean] of Integer = (0, DFCS_FLAT);
DrawSelected: array[Boolean] of Integer = (ILD_NORMAL, ILD_SELECTED);
var r: TRect;
x: Integer;
Index: Integer;
cp: TPoint;
offset: integer;
ARect: TRect;
{$ifdef fcUseThemeManager}
Details: TThemedElementDetails;
CheckboxStyle: TThemedButton;
PaintRect: TRect;
{$endif}
begin
r := LevelRect(Node);
if not((Images = nil) or (Node.ImageIndex < 0) or
(Node.ImageIndex >= Images.Count)) then
begin
x := r.Right -2;
if UseStateImages(Node) then
begin
inc(x, GetStateImageWidth+1);
end;
Index := Node.ImageIndex;
ImageList_DrawEx(Images.Handle, Index, FPaintCanvas.Handle,
x, r.Top + (r.Bottom - r.Top - TImageList(Images).Height) div 2, 0, 0,
CLR_NONE, ColorToRGB(TImageList(Images).BlendColor),
DrawSelected[Node.Selected and (TImageList(Images).BlendColor <> clNone)
and not (dtvoRowSelect in Options)]);
end;
if UseStateImages(Node) then
begin
if MultiSelectCheckboxNeeded(Node) then begin
cp:= GetCenterPoint(r);
Offset:= 6;
ARect:= Rect(r.right+1, cp.y-offset, r.Right + 2*offset + 2, cp.y+offset+1);
if fcUseThemes(self) then
begin
{$ifdef fcUseThemeManager}
if Node.multiselected then CheckboxStyle:= tbCheckboxCheckedNormal
else CheckboxStyle:= tbCheckboxUnCheckedNormal;
Details := ThemeServices.GetElementDetails(CheckboxStyle);
PaintRect := ARect;
ThemeServices.DrawElement(Canvas.Handle, Details, PaintRect);
PaintRect := ThemeServices.ContentRect(Canvas.Handle, Details, PaintRect);
{$endif}
end
else begin
DrawFrameControl(FPaintCanvas.Handle, ARect,
DFC_BUTTON, DFCS_BUTTONCHECK or CheckBoxFlat[dtvoFlatCheckBoxes in Options] or ItemChecked[Node.MultiSelected])
end
end
else
StateImages.Draw(FPaintCanvas, r.right-2, r.Top + (r.Bottom-r.Top-TImageList(StateImages).Height) div 2, Node.StateIndex)
// StateImages.Draw(FPaintCanvas, r.Right, r.Top, Node.StateIndex)
end;
end;
Function TfcDBCustomTreeView.GetStartX(Node: TfcDBTreeNode): integer;
var Offset : integer;
r: TRect;
begin
r := LevelRect(Node);
Offset:= (((r.Bottom - r.Top) div 2) div 2)+2;
Offset:= fcMin(Offset, 7);
result:= r.Left + offset + 1; //r.Right + Offset + 1;
end;
procedure TfcDBCustomTreeView.PaintLines(Node: TfcDBTreeNode);
var LevelNode: TfcDBTreeNode;
LineStartX:integer;
LineTop, LineBottom: TPoint;
y:integer;
size: integer;
r, OrigRect: TRect;
begin
if (dtvoShowLines in Options) and
((dtvoShowRoot in Options) or (Node.Level<>0)) then
begin
// FPaintCanvas.Pen.Color := clBtnShadow;
LevelNode := Node;
OrigRect := LevelRect(Node);
while (LevelNode <> nil) and ((LevelNode.Level = 0) or (LevelNode.Parent <> nil)) do
begin
if (LevelNode.Level=0) and (not (dtvoShowRoot in Options)) then break;
r := LevelRect(LevelNode);
r.Top := OrigRect.Top;
r.Bottom := OrigRect.Bottom;
LineStartX:= GetStartX(LevelNode);
if (dtvoExpandButtons3D in Options) then
begin
LineTop:= Point(LineStartX, r.Top);
LineBottom:= Point(LineStartX, r.Bottom);
end
else begin
LineTop:= Point(LineStartX, r.Top);
LineBottom:= Point(LineStartX, r.Bottom);
end;
if LevelNode.Level = Node.Level then
begin
if (not Node.HasPrevSibling) and (Node.Parent = nil) then
begin
inc(LineTop.y, GetCenterPoint(r).y);
end;
if (not Node.HasNextSibling) then
dec(LineBottom.y, (r.bottom-r.top) div 2)
else if (PaintingRow >= CacheSize-1) then
LineBottom.y:= LineBottom.y+2;
end;
if (LevelNode.HasNextSibling) or (LevelNode.Level = Node.Level) then
FPaintCanvas.DottedLine(LineTop, LineBottom);
LevelNode := LevelNode.Parent;
end;
r := LevelRect(Node);
if (dtvoShowRoot in Options) or (Node.Level <> 0) then
begin
y:= GetCenterPoint(r).y;
if (Node.MultiSelected or (Node.Selected and Focused)) and
UseStateImages(Node) and MultiSelectCheckboxNeeded(Node) and
(dtvoRowSelect in Options) then
r.right:= r.right - 4;
if dtvoExpandButtons3D in Options then
FPaintCanvas.DottedLine(Point(GetStartX(Node), y), Point(r.Right, y))
else
FPaintCanvas.DottedLine(Point(GetStartX(Node), y), Point(r.Right, y));
end
end;
if (Node.HasChildren) then begin
// 06/17/2000 - PYW - Correct painting bug when dtvoShowRoot is not in options and paintbutton is called on the root node
if (not (dtvoShowRoot in Options)) and (Node.Level = 0) then exit;
size:= ((r.bottom-r.top) div 2);
size:= fcMax(size, 8);
PaintButton(Node,
Point(GetStartX(Node), GetCenterPoint(r).y), size, Node.Expanded)
end
end;
procedure TfcDBCustomTreeView.PaintButton(Node: TfcDBTreeNode;
pt: TPoint; Size: integer; Expanded: Boolean);
var offset: integer;
drawRect: TRect;
OrigColor: TColor;
StateFlags: Word;
{$ifdef fcUseThemeManager}
Details: TThemedElementDetails;
{$endif}
begin
OrigColor:= FPaintCanvas.Brush.Color;
if not (dtvoShowButtons in Options) then Exit;
offset:= Size;
Offset:= Offset div 2;
DrawRect.Left:= pt.x - offset;
DrawRect.Right:= pt.x + offset+1;
DrawRect.Top:= pt.y-offset;
DrawRect.Bottom:= pt.y+offset+1;
if dtvoExpandButtons3D in Options then
begin
FPaintCanvas.Brush.Color := clBtnFace;
FPaintCanvas.FillRect(DrawRect);
FPaintCanvas.Brush.Color := clBtnShadow;
StateFlags:= DFCS_BUTTONPUSH;
if Down and (MouseRow=PaintingRow) then
StateFlags := StateFlags or DFCS_PUSHED;
with DrawRect do
DrawFrameControl(FPaintCanvas.Handle, Rect(Left, Top, Right+1, Bottom+1),
DFC_BUTTON, StateFlags);
if ColorToRGB(Color)=clWhite then
begin
with DrawRect, FPaintCanvas do begin
Pen.Color := clBtnFace;
Polyline([Point(Left-1, Bottom), Point(Left-1, Top-1), Point(Right+1, Top-1)]);
end;
end;
if Down and (MouseRow = PaintingRow) then
begin
pt.x:= pt.x+1;
pt.y:= pt.y+1;
DrawRect.Left:= DrawRect.Left + 1;
DrawRect.Top:= DrawRect.Top + 1;
DrawRect.Right:= DrawRect.Right + 1;
DrawRect.Bottom:= DrawRect.Bottom + 1;
end;
FPaintCanvas.Brush.Color := Color;
FPaintCanvas.Pen.Color := clBlack;
if not Expanded then
FPaintCanvas.Polyline([Point(pt.x, DrawRect.Top+Offset div 2), Point(pt.x, DrawRect.Bottom-Offset div 2)]);
FPaintCanvas.Polyline([Point(DrawRect.Left+Offset div 2, pt.y), Point(DrawRect.Right-Offset div 2, pt.y)]);
FPaintCanvas.Brush.Color:= OrigColor;
end
else begin
if fcUseThemes(self) then
begin
{$ifdef fcUseThemeManager}
if expanded then
Details := ThemeServices.GetElementDetails(ttGlyphOpened)
else
Details := ThemeServices.GetElementDetails(ttGlyphClosed);
ThemeServices.DrawElement(FPaintCanvas.Handle, Details, DrawRect);
{$endif}
end
else begin
FPaintCanvas.Brush.Color := clWhite;
FPaintCanvas.FillRect(DrawRect);
FPaintCanvas.Brush.Color := clBtnShadow;
FPaintCanvas.FrameRect(DrawRect);
FPaintCanvas.Brush.Color := Color;
FPaintCanvas.Pen.Color := clBlack;
if not Expanded then
FPaintCanvas.Polyline([Point(pt.x, DrawRect.Top+Offset div 2), Point(pt.x, DrawRect.Bottom-Offset div 2)]);
FPaintCanvas.Polyline([Point(DrawRect.Left+Offset div 2, pt.y), Point(DrawRect.Right-Offset div 2, pt.y)]);
FPaintCanvas.Brush.Color:= OrigColor;
end
end
end;
procedure TfcDBCustomTreeView.SetBorderStyle(Value: TBorderStyle);
begin
if FBorderStyle <> Value then
begin
FBorderStyle := Value;
RecreateWnd;
end;
end;
procedure TfcDBCustomTreeView.SetLineColor(Value: TColor);
begin
if FLineColor <> Value then
begin
FLineColor:= Value;
InvalidateClient;
end;
end;
procedure TfcDBCustomTreeView.SetInactiveFocusColor(Value: TColor);
begin
if FInactiveFocusColor <> Value then
begin
FInactiveFocusColor:= Value;
InvalidateClient;
end;
end;
procedure TfcDBCustomTreeView.SetOptions(Value: TfcDBTreeViewOptions);
const
LayoutOptions = [dtvoShowHorzScrollBar, dtvoShowVertScrollBar];
var ChangedOptions: TfcDBTreeViewOptions;
begin
if Value<>FOptions then
begin
ChangedOptions := (FOptions + Value) - (FOptions * Value);
FOptions:= Value;
if ChangedOptions * LayoutOptions <> [] then begin
{ 1/20/2000 - Support dtvoShowVertScrollBar }
if dtvoShowVertScrollBar in ChangedOptions then
begin
if HandleAllocated then begin
if (dtvoShowVertScrollBar in Options) then
begin
VertScrollBar.visible:= true;
if not HideUpDownButtons then
begin
UpTreeButton.visible:= true;
DownTreeButton.visible:= true;
end
else begin
UpTreeButton.visible:= false;
DownTreeButton.visible:= false;
end
end
else begin
VertScrollBar.visible:= false;
UpTreeButton.visible:= false;
DownTreeButton.visible:= false;
end;
UpdateScrollBarPosition;
end
end;
LayoutChanged;
end
else begin
invalidate;
end
end
end;
procedure TfcDBCustomTreeView.SetLastVisibleDataSet(DataSet: TDataSet);
begin
if FLastVisibleDataSet<>DataSet then
begin
// DoChangeLastExpandedDataSet;
FLastVisibleDataSet:= DataSet;
end;
end;
procedure TfcDBCustomTreeView.SetActiveDataSet(DataSet: TDataSet);
var DataLinkChild, DataLinkParent: TfcTreeDataLink;
begin
if ActiveDataSet=DataSet then exit;
if DataSet<>nil then
begin
DataLinkChild:= GetChildDataLink(ActiveDataSet);
DataLinkParent:= GetParentDataLink(ActiveDataSet);
if (DataLinkChild<>nil) and (DataLinkChild.DataSet = DataSet) then begin
{ Expanding }
FreeHintWindow;
end
else if (DataLinkParent<>nil) and (DataLinkParent.dataset = DataSet) then begin
{ Collapsing }
FreeHintWindow;
end
end;
{ 1/17/2000 - If insert state then allow changing to this dataset }
if (not (DataSet.Bof and DataSet.eof)) or (dataset.state=dsinsert) then
begin
FActiveDataSet:= DataSet;
ActiveDataSetChanged:= True; { Next paint event will trigger Change event }
// if GetDataLink(LastVisibleDataSet)<>Nil then LastVisibleDataSet:= DataSet; { 5/15/99 - Commented out this line }
// if LastVisibleDataSet=nil then LastVisibleDataSet:= DataSet;
end;
if FScrollWithinLevel then UpdateScrollBar;
end;
procedure TfcDBCustomTreeView.ScrollLeft;
var scrollpos: integer;
begin
scrollpos:= HorzScrollBar.position;
if scrollpos>0 then
begin
scrollpos:= fcmax(0, scrollpos - 10);
HorzScrollBar.position:= scrollpos;
invalidateClient;
end
end;
procedure TfcDBCustomTreeView.ScrollRight;
var scrollpos: integer;
begin
scrollpos:= HorzScrollBar.position;
if scrollpos + (ClientRect.right - ClientRect.Left) <MaxTextWidth then
begin
scrollpos:= fcmin(MaxTextWidth, scrollpos + 10);
HorzScrollBar.position:= scrollpos;
invalidateClient;
end
end;
procedure TfcDBCustomTreeView.KeyDown(var Key: Word; Shift: TShiftState);
var DataLink: TfcTreeDataLink;
begin
DataLink:= GetDataLink(ActiveDataSet);
case key of
vk_down: begin
NextRow(dtvoKeysScrollLevelOnly in Options);
end;
vk_up: begin
PriorRow(dtvoKeysScrollLevelOnly in Options);
end;
vk_multiply, vk_add, vk_right:
begin
if ssCtrl in Shift then
ScrollRight
else Expand(ActiveNode);
end;
vk_subtract, vk_left:
begin
if ssCtrl in Shift then
begin
ScrollLeft;
end
else begin
if (ActiveNode<>nil) then
begin
if (ActiveNode.Parent<>nil) then
Collapse(ActiveNode.Parent)
else
Collapse(ActiveNode);
end
end;
end;
vk_home:
if (ssCtrl in Shift)then
begin
ActiveDataSet:= TfcTreeDataLink(FDataLinks[0]).DataSet;
LastVisibleDataSet := ActiveDataSet;
ResetStartOffsets(ActiveDataSet);
TfcTreeDataLink(FDataLinks[0]).dataset.first;
end
else
DataLink.dataset.first;
vk_end:
if (ssCtrl in Shift)then
begin
ActiveDataSet:= TfcTreeDataLink(FDataLinks[0]).DataSet;
LastVisibleDataSet := ActiveDataSet;
ResetStartOffsets(ActiveDataSet);
TfcTreeDataLink(FDataLinks[0]).dataset.last;
end
else
DataLink.dataset.last;
vk_next:
NextPage(dtvoKeysScrollLevelOnly in Options);
vk_prior:
PriorPage(dtvoKeysScrollLevelOnly in Options);
vk_space: ToggleMultiSelection(not MultiSelectAttributes.MultiSelectCheckbox, Shift);
end;
if key in [vk_right, vk_left, vk_down, vk_up, vk_next, vk_prior, vk_space] then key:= 0;
if Assigned(OnKeyDown) then OnKeyDown(self, Key, Shift); { 7/4/99 - Fire OnKeyDown event }
end;
function TfcDBCustomTreeView.IsChildDataSetOfActive(DataSet: TDataSet): boolean;
var DataLinkParent: TfcTreeDataLink;
begin
result:= False;
DataLinkParent:= GetDataLink(DataSet);
if DataLinkParent=nil then exit;
repeat
DataLinkParent:= GetParentDataLink(DataLinkParent.DataSet);
until (DataLinkParent=nil) or (DataLinkParent.DataSet = ActiveDataSet);
if (DataLinkParent<>nil) then result:= True;
end;
function TfcDBCustomTreeView.IsMasterDataSetOfActive(DataSet: TDataSet): boolean;
var DataLinkChild: TfcTreeDataLink;
begin
result:= False;
if DataSet=nil then
begin
result:= True;
exit;
end;
DataLinkChild:= GetDataLink(DataSet);
if DataLinkChild=nil then exit;
repeat
DataLinkChild:= GetChildDataLink(DataLinkChild.DataSet);
until (DataLinkChild=nil) or (DataLinkChild.DataSet = ActiveDataSet);
if (DataLinkChild<>nil) then result:= True;
end;
procedure TfcDBCustomTreeView.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
inherited;
message.result:= DLGC_WANTARROWS;
end;
function TfcDBCustomTreeView.GetHitTestInfoAt(X, Y: Integer): TfcTreeHitTests;
var
cbPoint: TPoint;
Node: TfcDBTreeNode;
Row: integer;
r: TRect;
StateImageOffset: integer;
begin
X:= X + HorzScrollBar.position;
Result := [];
MouseToRow(X, Y, Row);
if not RowToNode(Row, Node) then exit;
r:= LevelRect(Node);
if Node=ActiveNode then
result:= result + [fchtdOnActiveNode];
if dtvoShowButtons in Options then
begin
if (r.Left<>r.right) and (r.Top<>r.Bottom) then begin
cbPoint:= GetCenterPoint(r);
if (abs(GetStartX(Node)-x) <7) and (abs(cbPoint.y-y)<7) then
begin
result:= result + [fchtdOnButton];
exit;
end
end;
end;
StateImageOffset:= 0;
if UseStateImages(Node) then begin
StateImageOffset:= GetStateImageWidth;
if (x>r.Right) and (x<r.Right + StateImageOffset) then
begin
result:= result + [fchtdOnStateIcon];
exit;
end
end;
if (Images<>nil) and (x>r.Right + StateImageOffset) and
(x<r.Right + StateImageOffset + TImageList(Images).Width) then
begin
result:= result + [fchtdOnImageIcon];
exit;
end;
R:= TextRect(Node, Row);
if (x>=R.Left) and (x<=R.Right) then
begin
result:= result + [fchtdOnText];
exit;
end;
// THitTest = (htAbove, htBelow, htNowhere, htOnItem, htOnButton, htOnIcon,
// htOnIndent, htOnLabel, htOnRight, htOnStateIcon, htToLeft, htToRight);
end;
procedure TfcDBCustomTreeView.ResetStartOffsets(ActiveDataSet: TDataSet);
var i: integer;
clear: boolean;
begin
Clear:= False;
for i:= 0 to FDataLinks.Count-1 do begin
if ActiveDataSet = TfcTreeDataLink(FDataLinks[i]).dataset then
Clear:= True;
if Clear then StartOffsets[i]:= 0;
end;
end;
Procedure TfcDBCustomTreeView.SetStartOffset(ActiveDataSet: TDataSet; val: integer);
var i: integer;
begin
for i:= 0 to FDataLinks.Count-1 do
if ActiveDataSet = TfcTreeDataLink(FDataLinks[i]).DataSet then
StartOffsets[i]:= val;
end;
Function TfcDBCustomTreeView.GetStartOffset: integer;
var StartOffset: integer;
Function GetOffset(Dataset: TDataSet): integer;
var i: integer;
begin
result:= 0;
for i:= 0 to FDataLinks.Count-1 do
begin
result:= fcmax(result, StartOffsets[i]);
if DataSet = TfcTreeDataLink(FDataLinks[i]).DataSet then
begin
break;
end
end;
end;
begin
StartOffset:= GetOffset(LastVisibleDataSet);
if ActiveNodeIndex<StartOffset then StartOffset:= GetOffset(ActiveDataSet);
result:= StartOffset;
end;
procedure TfcDBCustomTreeView.SetImages(Value: TCustomImageList);
begin
FImages := Value;
invalidateClient;
end;
procedure TfcDBCustomTreeView.SetStateImages(Value: TCustomImageList);
begin
FStateImages := Value;
invalidateClient;
end;
function TfcDBCustomTreeView.UseStateImages(Node: TfcDBTreeNode): Boolean;
begin
result := ((StateImages <> nil) and (Node.StateIndex >= 0) and
(Node.StateIndex < StateImages.Count));
if not Result then
if MultiSelectCheckBoxNeeded(Node) then result:= True
end;
procedure TfcDBCustomTreeView.WMSetFocus(var Message: TWMSetFocus);
begin
inherited;
invalidateClient;
end;
procedure TfcDBCustomTreeView.CMExit(var Message: TMessage);
begin
inherited;
invalidateClient;
end;
procedure TfcDBCustomTreeView.UpdateScrollBar;
var
recCount: longint;
DataLink: TfcTreeDataLink;
OldMax, OldPosition: integer;
begin
// if not FShowVertScrollBar then exit;
if FDataLinks.count<=0 then exit;
if FScrollWithinLevel then
DataLink:= GetDataLink(ActiveDataSet)
else DataLink:= nil;
if DataLink=Nil then DataLink:= TfcTreeDataLink(FDataLinks[0]);
if Datalink.Active and HandleAllocated then
begin
// recNum:= 0;
// recCount:= 0;
{ Set scroll bar precisely }
if datalink.dataset.active and { 3/21/00 - Check for active }
DataLink.DataSet.isSequenced then with DataLink.DataSet do
begin
DataLink.DataSet.UpdateCursorPos;
recCount:= DataLink.DataSet.RecordCount;
// recNum:= DataLink.DataSet.RecNo;
with VertScrollBar do begin
FixedThumbSize:= False;
OldMax:= Max;
OldPosition:= Position;
PageSize:= CacheSize;
Min:=1;
Max:= fcMax(recCount + PageSize-1, PageSize+1);
if State in [dsInactive, dsBrowse, dsEdit] then
begin
if BOF then position := 0
else if EOF then position := fcMax(recCount, 2)
else position:= recNo;
end
else Position := RecNo; // else keep old pos
if (OldPosition<>Position) or (Max<>OldMax) then
begin
VertScrollBar.invalidate;
end;
end;
end
else with Datalink.DataSet do
begin
with VertScrollBar do begin
OldPosition:= Position;
PageSize:= 1;
Min:=0;
Max:= 40;
if BOF then Position := 0
else if EOF then Position := 40
else Position := 20;
if (not FixedThumbSize) or (OldPosition<>Position) then
begin
FixedThumbSize:= True;
VertScrollBar.invalidate;
end;
end
end
end
end;
procedure TfcDBCustomTreeView.CreateWnd;
begin
inherited CreateWnd;
UpdateScrollBarPosition;
LayoutChanged;
UpdateScrollBar;
end;
procedure TfcDBCustomTreeView.HScroll(ScrollCode: integer; Position: integer);
begin
if Position<>HorzScrollBar.PriorPosition then
begin
if Header<>nil then
begin
Header.HeaderControl.Width:= Width+HorzScrollBar.position;
Header.HeaderControl.Left:= -HorzScrollBar.position;
end;
invalidateClient;
end;
end;
procedure TfcDBCustomTreeView.NextRow(WithinLevel: boolean);
var ActiveDataLink: TfcTreeDataLink;
begin
ActiveDataLink:= GetDataLink(ActiveDataSet);
if ActiveDataLink=Nil then ActiveDataLink:= TfcTreeDataLink(FDataLinks[0]);
if WithinLevel then
begin
if ActiveDataLink.ActiveRecord>=ActiveDataLink.RecordCount-1 then
begin
ActiveDataLink.DataSet.MoveBy(1);
end
else begin
ActiveDataLink.DataSet.Next;
end;
exit;
end;
with ActiveDatalink.Dataset do
begin
if Eof and (ActiveDataLink.ActiveRecord>=0) and
(ActiveDataLink.ActiveRecord<ActiveDataLink.RecordCount-1) and not (State=dsInsert) then
begin
ActiveDataLink.ActiveRecord:= ActiveDataLink.ActiveRecord + 1
end
else begin
Next;
if Eof then begin
if GetParentDataLink(ActiveDataSet)<>nil then
begin
ActiveDataSet:= GetParentDataLink(ActiveDataSet).DataSet;
LastVisibleDataSet:= ActiveDataSet; { 12/7/98 }
NextRow(False);
end
end
end
end;
end;
{ Move to next node for activedataset }
procedure TfcDBCustomTreeView.NextPage(WithinLevel: boolean);
var ActiveDataLink: TfcTreeDataLink;
begin
ActiveDataLink:= GetDataLink(ActiveDataSet);
if ActiveDataLink=Nil then ActiveDataLink:= TfcTreeDataLink(FDataLinks[0]);
if WithinLevel then begin
ActiveDataLink.DataSet.MoveBy(CacheSize);
exit;
end;
with ActiveDatalink.Dataset do
begin
ActiveDataLink.DataSet.MoveBy(CacheSize);
if Eof then begin
if GetParentDataLink(ActiveDataSet)<>nil then
begin
ActiveDataSet:= GetParentDataLink(ActiveDataSet).DataSet;
LastVisibleDataSet:= ActiveDataSet; { 12/7/98 }
NextRow(False);
end
end
end;
end;
procedure TfcDBCustomTreeView.PriorRow(WithinLevel: boolean);
var ActiveDataLink: TfcTreeDataLink;
begin
ActiveDataLink:= GetDataLink(ActiveDataSet);
if ActiveDataLink=Nil then ActiveDataLink:= TfcTreeDataLink(FDataLinks[0]);
if WithinLevel then
begin
if ActiveDataLink.ActiveRecord<=0 then
begin
ActiveDataLink.DataSet.MoveBy(-1);
if ActiveDataLink.DataSet.Bof then
begin
StartOffsets[GetDataLinkIndex(ActiveDataLink.DataSet)]:= 0;
InvalidateClient; { 4/9/99 }
end
end
else begin
ActiveDataLink.DataSet.Prior;
end;
exit;
end;
with ActiveDatalink.Dataset do
if BOF and (ActiveDataLink.ActiveRecord>0) then
ActiveDataLink.ActiveRecord:= ActiveDataLink.ActiveRecord - 1
else begin
Prior;
if bof then begin
if GetParentDataLink(ActiveDataSet)<>nil then
begin
ActiveDataSet:= GetParentDataLink(ActiveDataSet).DataSet;
LastVisibleDataSet:= ActiveDataSet; { 12/7/98 }
invalidateClient;
end
end
end;
end;
procedure TfcDBCustomTreeView.PriorPage(WithinLevel: boolean);
var ActiveDataLink: TfcTreeDataLink;
begin
ActiveDataLink:= GetDataLink(ActiveDataSet);
if ActiveDataLink=Nil then ActiveDataLink:= TfcTreeDataLink(FDataLinks[0]);
if WithinLevel then
begin
ActiveDataLink.DataSet.MoveBy(-CacheSize);
if ActiveDataLink.DataSet.Bof then begin
StartOffsets[GetDataLinkIndex(ActiveDataLink.DataSet)]:= 0;
InvalidateClient; { 4/9/99 }
end;
exit;
end;
with ActiveDatalink.Dataset do begin
ActiveDataLink.DataSet.MoveBy(-CacheSize);
if BOF then begin
if GetParentDataLink(ActiveDataSet)<>nil then
begin
ActiveDataSet:= GetParentDataLink(ActiveDataSet).DataSet;
LastVisibleDataSet:= ActiveDataSet; { 12/7/98 }
InvalidateClient;
end
end
end
end;
procedure TfcDBCustomTreeView.VScroll(ScrollCode: integer; Position: integer);
var DataLink: TfcTreeDataLink;
Function Sequencable: boolean;
begin
result:= DataLink.DataSet.isSequenced;
end;
procedure ParadoxPosition;
var recNum : Longint;
begin
with DataLink.DataSet do begin
recNum:= position;
checkBrowseMode;
RecNo:= recNum;
resync([]);
end;
end;
procedure MoveToFirst;
var ActiveDataLink: TfcTreeDataLink;
begin
ActiveDataLink:= GetDataLink(ActiveDataSet);
if ActiveDataLink=Nil then ActiveDataLink:= TfcTreeDataLink(FDataLinks[0]);
StartOffsets[GetDataLinkIndex(ActiveDataLink.DataSet)]:= 0;
InvalidateClient;
end;
begin
if not CanFocus then Exit;
if not HaveValidDataLinks then exit;
SetFocus;
if FScrollWithinLevel then
DataLink:= GetDataLink(ActiveDataSet)
else DataLink:= nil;
if DataLink=Nil then DataLink:= TfcTreeDataLink(FDataLinks[0]);
if Datalink.Active then
with DataLink.DataSet, Datalink do begin
case ScrollCode of
SB_LINEUP: PriorRow(FScrollWithinLevel);
SB_LINEDOWN: NextRow(FScrollWithinLevel);
SB_PAGEUP: PriorPage(FScrollWithinLevel);
SB_PAGEDOWN: NextPage(FScrollWithinLevel);
SB_THUMBPOSITION:
begin
if Sequencable then begin
LastVisibleDataSet:= DataLink.DataSet;
if position<=1 then
begin
First;
MoveToFirst;
end
else if position>=DataLink.DataSet.recordCount then
Last
else ParadoxPosition;
end
else begin
if position=0 then begin
LastVisibleDataSet:= DataLink.DataSet;
First;
MoveToFirst;
end
else if position=40 then begin
LastVisibleDataSet:= DataLink.DataSet;
Last;
end
else if Bof then begin
MoveBy(CacheSize);
end
else if Eof then begin
MoveBy(-CacheSize);
end
else if position<20 then begin
MoveBy(-CacheSize);
end
else if position>20 then begin
MoveBy(CacheSize);
end
else if position<20 then begin
MoveBy(-CacheSize);
end;
{ case Position of
0: begin
LastVisibleDataSet:= DataLink.DataSet;
First;
end;
1: MoveBy(-CacheSize);
2: exit;
3: MoveBy(CacheSize);
4: begin
LastVisibleDataSet:= DataLink.DataSet;
Last;
end;
end;}
end
end;
SB_BOTTOM: begin
LastVisibleDataSet:= DataLink.DataSet;
Last;
end;
SB_TOP: begin
LastVisibleDataSet:= DataLink.DataSet;
First;
end;
end;
end;
end;
(*
procedure TfcDBCustomTreeView.WMVScroll(var Message: TWMVScroll);
var DataLink: TfcTreeDataLink;
Function Sequencable: boolean;
begin
result:= DataLink.DataSet.isSequenced;
end;
procedure ParadoxPosition;
var recNum : Longint;
{$ifndef wwDelphi3Up}
recCount: Longint;
{$endif}
begin
with DataLink.DataSet do begin
recNum:= Message.Pos; // * recordCount) div GridScrollSize;
checkBrowseMode;
RecNo:= recNum;
LastVisibleDataSet:= DataLink.DataSet;
resync([]);
end;
end;
begin
if not CanFocus then Exit;
if not HaveValidDataLinks then exit;
SetFocus;
DataLink:= TfcTreeDataLink(FDAtaLinks[0]);
if Datalink.Active then
with Message, DataLink.DataSet, Datalink do
case ScrollCode of
SB_LINEUP: PriorRow(FScrollWithinLevel);
SB_LINEDOWN: NextRow(FScrollWithinLevel);
SB_PAGEUP: PriorPage(FScrollWithinLevel);
SB_PAGEDOWN: NextPage(FScrollWithinLevel);
SB_THUMBPOSITION:
begin
if Sequencable then begin
if pos<=1 then
First
else if pos>=DataLink.DataSet.recordCount then
Last
else ParadoxPosition;
end
else begin
case Pos of
0: First;
1: MoveBy(-CacheSize);
2: exit;
3: MoveBy(CacheSize);
4: Last;
end;
end
end;
SB_BOTTOM: Last;
SB_TOP: First;
end;
end;
*)
Function TfcDBCustomTreeView.MultiSelectCheckboxNeeded(Node: TfcDBTreeNode): boolean;
begin
with FMultiSelectAttributes do
result:= Enabled and MultiSelectCheckbox and (ValidMultiSelectLevel(Node.Level))
end;
function TfcDBCustomTreeView.ValidMultiSelectLevel(ALevel: Integer): Boolean;
begin
result := (FMultiSelectAttributes.MultiSelectLevel = ALevel) or
(FMultiSelectAttributes.MultiSelectLevel = -1);
end;
constructor TfcDBMultiSelectAttributes.Create(Owner: TComponent);
begin
TreeView:= Owner as TfcDBCustomTreeView;
FAutoUnselect:= False;
FMultiSelectCheckbox:= True;
end;
procedure TfcDBMultiSelectAttributes.Assign(Source: TPersistent);
var tsa: TfcDBMultiSelectAttributes;
begin
If Source is TfcDBMultiSelectAttributes then
begin
tsa:= TfcDBMultiSelectAttributes(Source);
Enabled:= tsa.Enabled;
MultiSelectCheckbox:= tsa.MultiSelectCheckbox;
MultiSelectLevel:= tsa.MultiSelectLevel;
end
else inherited Assign(Source);
end;
procedure TfcDBMultiSelectAttributes.SetEnabled(val: boolean);
//var Node: TfcDBTreeNode;
begin
if val<>FEnabled then
begin
FEnabled:= val;
TreeView.invalidateClient;
end
end;
procedure TfcDBMultiSelectAttributes.SetMultiSelectCheckBox(val: boolean);
begin
if val<>FMultiSelectCheckbox then
begin
FMultiSelectCheckbox:= val;
TreeView.invalidateClient;
end
end;
procedure TfcDBMultiSelectAttributes.SetMultiSelectLevel(val: integer);
begin
if val<>FMultiSelectLevel then
begin
FMultiSelectLevel:= val;
(TreeView as TfcDBCustomTreeView).UnselectAll;
TreeView.InvalidateClient;
end
end;
{$ifdef fcDelphi4Up}
procedure TfcDBCustomTreeView.SelectAll(ADataSet: TDataSet);
var saveBK : TBookmark;
MultiSelectItem: TfcMultiSelectItem;
begin
UnselectAll;
with ADataset do
begin
saveBK := GetBookmark; { Save current record position }
CheckBrowseMode; { bookmarks don't work in edit mode }
DisableControls;
First;
while (not Eof) do begin
MultiSelectItem:= TfcMultiSelectItem.create;
with MultiSelectItem do
begin
Bookmark:= GetBookmark;
DataSet:= ADataSet;
end;
FMultiSelectList.Add(MultiSelectItem);
Next;
end;
GotoBookmark(saveBK); { Restore original record position}
Freebookmark(saveBK);
EnableControls;
end
end;
{$endif}
procedure TfcDBCustomTreeView.UnselectAll;
var i: integer;
begin
for i:= 0 to FMultiSelectList.Count-1 do
begin
FreeMem(MultiSelectList[i].Bookmark); { 5/20/00 - Don't reference dataset in case its already been destroyed }
// MultiSelectList[i].DataSet.Freebookmark(MultiSelectList[i].Bookmark);
MultiSelectList[i].Free;
end;
FMultiSelectList.Clear;
if not (csDestroying in ComponentState) then InvalidateClient; { 2/14/2000 }
end;
procedure TfcDBCustomTreeView.SelectRecord;
var MultiSelectItem: TfcMultiSelectItem;
begin
MultiSelectItem:= TfcMultiSelectItem.create;
with MultiSelectItem do
begin
ActiveDataSet.CheckBrowseMode; { bookmarks don't work in edit mode }
if IsSelectedRecord then exit;
Bookmark:= ActiveDataSet.GetBookmark;
DataSet:= ActiveDataSet;
end;
FMultiSelectList.Add(MultiSelectItem);
InvalidateClient;
end;
Procedure TfcDBCustomTreeView.UnselectRecord;
var MultiSelectItem: TfcMultiSelectItem;
MultiSelectItemIndex: integer;
begin
MultiSelectItemIndex:= FindCurrentMultiSelectIndex(ActiveDataSet);
if MultiSelectItemIndex<0 then exit; { Can't unselect since its not selected }
MultiSelectItem:= MultiSelectList[MultiSelectItemIndex];
MultiSelectItem.DataSet.Freebookmark(MultiSelectItem.Bookmark);
MultiSelectItem.Free;
FMultiSelectList.Delete(MultiSelectItemIndex);
InvalidateClient;
end;
Function TfcDBCustomTreeView.IsSelectedRecord: boolean;
begin
result:= FindCurrentMultiSelectIndex(ActiveDataSet)>=0;
end;
Function TfcDBCustomTreeView.FindCurrentMultiSelectIndex(DataSet: TDataSet): integer;
var i: integer;
curBookmark: Tbookmark;
thisTable: TDataset;
res: CmpBkmkRslt;
begin
thisTable:= DataSet;
if (thisTable.state=dsEdit) or (thisTable.state=dsInsert) then begin
result:= -1;
exit;
end;
curBookmark:= thisTable.getBookmark;
result:= -1;
if curBookmark=Nil then exit;
for i:= 0 to FMultiSelectList.count-1 do begin
if thisTable<>MultiSelectList[i].DataSet then continue;
if MultiSelectList[i]=nil then continue;
res:= thisTable.CompareBookmarks(MultiSelectList[i].Bookmark, curBookmark);
if (res=CMPKeyEql) or (res=CMPEql) then begin
result:= i;
break;
end
end;
thisTable.freebookmark(curBookmark);
end;
function TfcDBCustomTreeView.GetMultiSelectItem(Index: integer): TfcMultiSelectItem;
begin
result:= TfcMultiSelectItem(FMultiSelectList[Index]);
end;
procedure TfcDBCustomTreeView.CMFontChanged(var Message: TMessage);
begin
inherited;
LayoutChanged;
end;
procedure TfcDBCustomTreeView.LayoutChanged;
var i: Integer;
DataLink: TfcTreeDataLink;
// SINew: TScrollInfo;
NewCacheSize: integer;
begin
Canvas.Font := Font;
RowHeight:= Canvas.Textheight('W') + 2;
RowHeight:= fcmax(RowHeight, 16);
if StateImages<>nil then
RowHeight:= fcmax(RowHeight, TImageList(StateImages).Height);
if Images<>nil then
RowHeight:= fcmax(RowHeight, TImageList(Images).Height);
RowHeight:= ((RowHeight+1) div 2) * 2; { Row height must be even }
if BorderStyle=bsNone then { 5/25/99 }
NewCacheSize:= Height div RowHeight
else
NewCacheSize:= (Height-4) div RowHeight;
if (dtvoShowHorzScrollBar in Options) and HandleAllocated then begin
if HorzScrollBar.PageSize<HorzScrollBar.Max then
begin
if BorderStyle=bsNone then { 5/25/99 }
NewCacheSize:= (Height-GetSystemMetrics(SM_CYHSCROLL)) div RowHeight
else
NewCacheSize:= (Height-GetSystemMetrics(SM_CYHSCROLL) - 4) div RowHeight
end
end;
if NewCacheSize<>CacheSize then begin
CacheSize:= NewCacheSize;
for i:= 0 to FDataLinks.Count-1 do
begin
DataLink:= TfcTreeDataLink(FDataLinks[i]);
// if DataLink.Active then { 3/31/99- Still set BufferCount so that its accurate}
begin
DataLink.BufferCount:= CacheSize;
end
end;
end;
if InPaint then
CheckMaxWidthGrow:= True { 3/10/99 }
else
CheckMaxWidth:= True;
InvalidateClient;
end;
procedure TfcDBCustomTreeView.Loaded;
begin
inherited Loaded;
if DataSources<>'' then
RefreshDataLinks(FFirstDataLink.DataSource, FLastDataLink.DataSource);
LayoutChanged;
end;
procedure TfcDBCustomTreeView.FreeHintWindow;
begin
HintTimerCount:= 0;
SkipErase:= True;
HintWindow.Free;
SkipErase:= False;
HintWindow:= nil;
if HintTimer<>nil then
HintTimer.enabled:= False;
// LastHintRow:= -1;
end;
procedure TfcDBCustomTreeView.HintTimerEvent(Sender: TObject);
var
sp, cp: TPoint;
OutsideClient: boolean;
begin
if (dtvoHotTracking in Options) or (HintWindow<>nil) then
begin
GetCursorPos(cp);
sp:= self.ClientToScreen(Point(0, 0));
if (cp.x<sp.x) or (cp.x>sp.x+ClientRect.Right-ClientRect.Left) or
(cp.y<sp.y) or (cp.y>sp.y+ClientRect.Bottom-ClientRect.Top) then
begin
OutsideClient:= True;
end
else OutsideClient:= False;
end
else exit;
if (dtvoHotTracking in Options) then
begin
if Outsideclient and (HotTrackRow>=0) then
InvalidateClient;
exit; { Don't display hint window if hot-tracking }
end;
{ Process Hint Timer clean-up}
if OutsideClient then
begin
FreeHintWindow;
LastHintRow:= -1;
exit;
end;
inc(HintTimerCount);
if HintTimerCount>16 then
begin
FreeHintWindow;
exit;
end;
end;
procedure TfcDBCustomTreeView.MouseMove(Shift: TShiftState; X, Y: Integer);
var Row: integer;
Node: TfcDBTreeNode;
R: TRect;
SP: TPoint;
HintText: string;
DoDefault: boolean;
ValidNode: boolean;
begin
inherited MouseMove(Shift, X, Y);
if not (Assigned(FOnMouseMove) or (dtvoShowNodeHint in Options)) then exit;
sp:= self.ClientToScreen(Point(0, 0));
MouseToRow(X, Y, Row);
ValidNode:= RowToNode(Row, Node);
if (dtvoHotTracking in Options) and ValidNode then begin
if (Row<>HotTrackRow) then
begin
InvalidateClient;
HotTrackRow:= Row;
end
else begin
InvalidateClient;
end;
FreeHintWindow;
HintTimer.Free;
HintTimer:= nil;
HintTimer:= TTimer.create(self);
HintTimer.OnTimer:=HintTimerEvent;
HintTimer.Interval:=250;
HintTimer.Enabled:= True;
if Assigned(FOnMouseMove) then FOnMouseMove(self, Node, Shift, X, Y);
exit;
end;
if Assigned(FOnMouseMove) then FOnMouseMove(self, Node, Shift, X, Y);
if not ValidNode then exit;
if not (dtvoShowNodeHint in Options) then exit;
if Header<>nil then exit; // Currently do not support hints when have header control
{ Show hint window on node that mouse is over}
sp:= self.ClientToScreen(Point(0, 0));
MouseToRow(X, Y, Row);
if not RowToNode(Row, Node) then exit;
if (x < LevelRect(Node).Right) then exit;
if (Row<>LastHintRow) and (Row>=0) then begin
FreeHintWindow;
HintTimer.Free;
HintTimer:= nil;
if TextRect(Node, Row).Left+Canvas.TextWidth(Node.Text)>
Width-GetSystemMetrics(SM_CXHThumb)-6 then
begin
HintWindow:= CreateHintWindow;
HintTimer:= TTimer.create(self);
HintTimer.OnTimer:=HintTimerEvent;
HintTimer.Interval:=250;
HintTimer.Enabled:= True;
with HintWindow do
begin
R:= TextRect(Node, Row);
// R.Left:= r.left + sp.x - 2 - GetScrollPos(self.Handle, SB_HORZ);
R.Left:= r.left + sp.x - 2 - HorzScrollBar.position; //GetScrollPos(self.Handle, SB_HORZ);
R.Right:= r.Right + sp.x + 2;
if not odd(fcRectHeight(R) div 2) then
begin
R.Top:= R.Top + sp.y - 3;
R.Bottom:= R.Bottom + sp.y - 3;
end
else begin
R.Top:= R.Top + sp.y - 2;
R.Bottom:= R.Bottom + sp.y - 2;
end;
HintText:= Node.Text;
DoDefault:= True;
// DoActivateHint(HintWindow, Node, HintText, DoDefault);
if DoDefault then begin
R.Right:= R.Left + FPaintCanvas.TextWidth(HintText) + 6;
ActivateHint(R, HintText);
end;
end;
end;
LastHintRow:= Row;
end
end;
procedure TfcDBCustomTreeView.InvalidateRow(Row: integer);
var r: TRect;
begin
r.Top:= Row * RowHeight;
r.Bottom:= (Row+1) * RowHeight -1;
r.Left:= 0;
r.Right:= GetClientRect.Right; //Width;
InvalidateRect(Handle, @r, True);
end;
procedure TfcDBCustomTreeView.InvalidateNode(Node: TfcDBTreeNode);
var r: TRect;
begin
r:= LevelRect(Node);
r.Left:= 0;
r.Right:= Width;
InvalidateRect(Handle, @r, True);
end;
function TfcDBCustomTreeView.GetMultiSelectListCount: integer;
begin
result:= FMultiSelectList.Count;
end;
procedure TfcDBCustomTreeView.Change(FSelected: TfcDBTreeNode);
begin
if Assigned(FOnChange) then
FOnChange(Self, FSelected);
end;
procedure TfcDBCustomTreeView.DoUserExpand(Node: TfcDBTreeNode);
begin
if Assigned(FOnUserExpand) then
FOnUserExpand(Self, Node);
end;
procedure TfcDBCustomTreeView.DoUserCollapse(Node: TfcDBTreeNode);
begin
if Assigned(FOnUserCollapse) then
FOnUserCollapse(Self, Node);
end;
{procedure TfcDBCustomTreeView.DoActivateHint(
HintWindow: THintWindow; FSelected: TfcDBTreeNode;
var HintText: string; var DoDefault: boolean);
begin
if Assigned(FOnActivateHint) then
begin
DoDefault:= True;
FOnActivateHint(Self, HintWindow, FSelected, HintText, DoDefault);
end
end;
}
type
TfcDBTreeHintWindow=class(THintWindow)
protected
procedure Paint; override;
// public
// Node: TfcTreeNode;
end;
procedure TfcDBTreeHintWindow.Paint;
var
R: TRect;
begin
R := ClientRect;
Inc(R.Left, 2);
Inc(R.Top, 2);
Canvas.Font.Color := clInfoText;
SetBkMode(Canvas.Handle, TRANSPARENT);
DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_LEFT or DT_NOPREFIX or
DT_WORDBREAK);
end;
Function TfcDBCustomTreeView.CreateHintWindow: THintWindow;
begin
HintWindow:= TfcDBTreeHintWindow.create(self);
HintWindow.Color:= GetSysColor(COLOR_INFOBK);
HintWindow.Canvas.Brush.Color:= GetSysColor(COLOR_INFOBK);
HintWindow.Canvas.Font:= self.Font;
HintWindow.Canvas.Font.Color:= GetSysColor(COLOR_INFOTEXT);
HintWindow.Canvas.Pen.Color:= clBlack;
result:= HintWindow;
end;
Function TfcDBCustomTreeView.GetStateImageWidth: integer;
begin
if StateImages<>nil then result:= TImageList(StateImages).Width
else result:= 16;
end;
Function TfcDBCustomTreeView.HaveValidDataLinks: boolean;
var i: Integer;
begin
result:= FDataLinks.Count>0;
for i:= 0 to FDataLinks.count-1 do
begin
if TfcTreeDataLink(FDataLinks[i]).DataSet=nil then result:= False;
if not TfcTreeDataLink(FDataLinks[i]).Active then result:= False;
end;
{
result:= false;
if FDataLinks.count<=0 then exit;
DataLink:= TfcTreeDataLink(FDataLinks[0]);
if datalink.dataset = nil then exit;
if not datalink.active then exit;
result:= true;}
end;
Procedure TfcDBCustomTreeView.ToggleMultiSelection(
RequireControlKey: boolean; Shift: TShiftState);
begin
if (ActiveNode<>nil) then begin
if MultiSelectAttributes.Enabled and
(ValidMultiSelectLevel(ActiveNode.Level)) then
begin
if RequireControlKey then
begin
if (ssCtrl in Shift) then
begin
if IsSelectedRecord then UnselectRecord
else SelectRecord;
end;
end
else begin
if IsSelectedRecord then UnselectRecord
else SelectRecord;
end
end;
end;
end;
procedure TfcDBCustomTreeView.WMSize(var Message: TWMSize);
begin
inherited;
ResetScroll:= True;
UpdateScrollBarPosition;
LayoutChanged;
end;
{$ifdef fcDelphi4Up}
procedure TfcDBCustomTreeView.SetHideUpDownButtons(val: boolean);
begin
if val<>FHideUpDownButtons then
begin
FHideUpDownButtons:=val;
UpTreeButton.visible:= not val;
DownTreeButton.visible:= not val;
UpdateScrollBarPosition;
end
end;
{$endif}
procedure TfcDBCustomTreeView.UpdateScrollBarPosition;
var
VertHeight: integer;
// curBottom: integer;
ButtonHeight: integer;
begin
{ 5/25/99 - Fix BorderStyle=bsNone bug where horizontal scrollbar and
buttons drawn in wrong position }
ButtonHeight := GetSystemMetrics(SM_CXVSCROLL) + 1;
if (VertScrollBar<>nil) then
begin
if BorderStyle=bsNone then
VertHeight:= Height
else
VertHeight:= Height - 4;
{$ifdef fcDelphi4Up}
if UpTreeButton.visible and (not FHideUpDownButtons) then
{$else}
if UpTreeButton.visible then
{$endif}
VertHeight:= VertHeight - ButtonHeight + 1;
VertScrollBar.Height:= VertHeight;
VertScrollBar.Width:= ButtonHeight - 1;
VertScrollBar.Left:= GetClientRect.Right;
end;
if (HorzScrollBar<>nil) then with HorzScrollBar do
begin
Left:= 0;
if VertScrollBar.visible then
begin
if BorderStyle=bsNone then
Width:= fcMax(0, self.Width - VertScrollBar.Width)
else
Width:= fcMax(0, self.Width - 4 - VertScrollBar.Width);
end
else begin
if BorderStyle=bsNone then
Width:= fcMax(0, self.Width)
else
Width:= fcMax(0, self.Width - 4);
end;
Height:=
GetSystemMetrics(SM_CYHSCROLL);
if BorderStyle=bsNone then
Top:= self.Height - Height
else
Top:= self.Height - Height - 4;
end;
with UpTreeButton do
begin
Height:= ButtonHeight;
Width:= ButtonHeight;
Top:= VertScrollBar.height;
Left:= VertScrollBar.Left;
end;
with DownTreeButton do
begin
Height:= ButtonHeight;
Width:= ButtonHeight;
Top:= VertScrollBar.height;
Left:= VertScrollBar.Left;
end;
end;
procedure TfcDBCustomTreeView.SetLevelIndent(val: integer);
begin
if FLevelIndent<>val then
begin
FLevelIndent:= val;
InvalidateClient;
end
end;
procedure TfcDBCustomTreeView.SetDisplayFields(Value: TStrings);
begin
FDisplayFields.Assign(Value);
InvalidateClient;
end;
procedure TfcDBCustomTreeView.MakeActiveDataSet(DataSet: TDataSet; Collapse: boolean);
begin
// self.Update; { Finish painting operations }
ActiveDataSet:= DataSet;
if Collapse then LastVisibleDataSet:= DataSet
else begin
if IsMasterDataSetOfActive(LastVisibleDataSet) then
LastVisibleDataSet:= DataSet;
end;
invalidateClient;
end;
{ Make room for scroll bar if its shown }
function TfcDBCustomTreeView.GetClientRect: TRect;
begin
result:= inherited GetClientRect;
if (VertScrollBar<>nil) and (VertScrollBar.visible) then
begin
result.Right:= result.Right - VertScrollBar.Width;
end;
if InComputeHorzWidthOnly then exit;
if (HorzScrollBar<>nil) and
(HorzScrollBar.Max-HorzScrollBar.Min>HorzScrollBar.PageSize) then
begin
result.Bottom:= result.Bottom - HorzScrollBar.Height;
if not HorzScrollBar.visible then begin
HorzScrollBar.visible:= True;
LayoutChanged;
HorzScrollBar.invalidate;
end
end
else begin
if HorzScrollBar.visible then begin
HorzScrollBar.visible:= False;
HorzScrollBar.Max:= 5;
HorzScrollBar.PageSize:= 10;
LayoutChanged;
end
end;
end;
procedure TfcDBCustomTreeView.InvalidateClient;
var r: TRect;
begin
if not HandleAllocated then exit;
r:= GetClientRect;
InvalidateRect(Handle, @r, False);
end;
procedure TfcDBCustomTreeView.TreeUpClick(Sender : TObject);
begin
if ActiveNode=nil then exit;
if (ActiveNode.Parent<>nil) then
Collapse(ActiveNode.Parent)
else
Collapse(ActiveNode);
end;
procedure TfcDBCustomTreeView.TreeDownClick(Sender : TObject);
begin
Expand(ActiveNode);
end;
procedure TfcTreeVertScrollBar.Scroll(ScrollCode: integer; Position: integer);
begin
inherited;
(Parent as TfcDBCustomTreeView).VScroll(ScrollCode, Position);
end;
procedure TfcTreeHorzScrollBar.Scroll(ScrollCode: integer; Position: integer);
begin
inherited;
(Parent as TfcDBCustomTreeView).HScroll(ScrollCode, Position);
end;
function TfcDBCustomTreeView.CreateUpTreeButton: TfcShapeBtn;
var bm: TBitmap;
resName: string;
begin
UpTreeButton:= TfcShapeBtn.create(self);
with UpTreeButton do begin
Width := 17;
Height := 17;
Color := clBtnFace;
Orientation := soUp;
PointList.Add('0,0');
PointList.Add('Width,0');
PointList.Add('0,Height');
PointList.Add('0,0');
ShadeColors.Btn3DLight := clWhite;
ShadeColors.BtnHighlight := clBtnFace;
ShadeColors.BtnBlack := clBlack;
Shape := bsCustom;
TabStop:= False;
offsets.glyphx:= 1;
offsets.glyphy:= 1;
bm := TBitmap.Create;
bm.Transparent := True;
resName:= 'FCTREEUP';
bm.LoadFromResourceName(HINSTANCE, resName);
glyph.assign(bm);
bm.Free;
parent:= self;
OnClick:= TreeUpClick;
end;
result:= UpTreeButton;
end;
function TfcDBCustomTreeView.CreateDownTreeButton: TfcShapeBtn;
var bm: TBitmap;
resName: string;
begin
DownTreeButton:= TfcShapeBtn.create(self);
with DownTreeButton do begin
Width := 17;
Height := 17;
Color := clBtnFace;
Orientation := soDown;
PointList.Add('0,0');
PointList.Add('Width,0');
PointList.Add('0,Height');
PointList.Add('0,0');
Shape := bsCustom;
TabStop:= False;
offsets.glyphx:= 6;
offsets.glyphy:= 6;
bm := TBitmap.Create;
bm.Transparent := True;
resName:= 'FCTREEDOWN';
bm.LoadFromResourceName(HINSTANCE, resName);
glyph.assign(bm);
bm.Free;
parent:= self;
OnClick:= TreeDownClick;
end;
result:= DownTreeButton;
end;
procedure TfcDBCustomTreeView.DrawColumnText(
Node: TfcDBTreeNode; ARect: TRect);
const
AlignFlags : array [TAlignment] of Integer =
( DT_LEFT or DT_END_ELLIPSIS,
DT_RIGHT or DT_END_ELLIPSIS,
DT_CENTER or DT_END_ELLIPSIS);
var i,DrawFlags: integer;
s:String;
TempRect:TRect;
// l, r: integer;
RootDataSet: TDataSet;
curField: TField;
OrigColor: TColor;
OrigFontColor: TColor;
DoDefault: boolean;
begin
TempRect:=ARect;
TempRect.Right := ClientWidth + HorzScrollBar.position;
TempRect.Top := TempRect.Top-1;
TempRect.Bottom := TempRect.Bottom+1;
// Canvas.FillRect(TempRect); // Comment as it does not work with imager, and
// seems uncessary otherwise. If there is a problem
// with commenting out, then check if imager assigned.
OrigColor:= Canvas.Brush.Color;
OrigFontColor:= Canvas.Font.Color;
RootDataSet:= TfcTreeDataLink(FDataLinks[0]).DataSet;
if (RootDataSet=nil) then exit;
// ARect.Right := Header.Sections[0].Width-5;
for i:=0 to Header.Sections.count-1 do begin
curField:= RootDataSet.FindField(Header.Sections[i].FieldName);
if curField<>nil then
DrawFlags:= AlignFlags[curField.Alignment]
else
DrawFlags:= AlignFlags[taLeftJustify];
ARect.Right:= Header.Sections[i].right;
if i>0 then ARect.Left:= Header.Sections[i].Left;
s:= fcGetToken(Node.Text, #9, i);
ARect.Top:= ARect.Top-1;
ARect.Bottom:= ARect.Bottom+1;
Canvas.Font.Color:= OrigFontColor;
Canvas.Brush.Color:= OrigColor;
DoCalcSectionAttributes(Node, Header.Sections[i], S);
if OrigColor<>Canvas.Brush.Color then
FPaintCanvas.FillRect(ARect);
ARect.Right:= ARect.Right-2;
ARect.Left:= ARect.Left+2;
ARect.Top:= ARect.Top+1;
ARect.Bottom:= ARect.Bottom-1;
DoDefault:= True;
DoDrawSection(Node, Header.Sections[i], ARect, S, DoDefault);
if DoDefault then
DrawText(Canvas.Handle,PChar(s), length(s), ARect, DrawFlags);
{ ARect.Left := ARect.Right+8;
if I<> Header.Sections.Count-1 then
ARect.Right := ARect.Left+Header.Sections[i+1].Width-5;}
end;
end;
procedure TfcDBCustomTreeView.DoDrawText(TreeView: TfcDBCustomTreeView;
Node: TfcDBTreeNode; ARect: TRect;
var DefaultDrawing: boolean);
begin
DefaultDrawing:= True;
if Assigned(FOnDrawText) then FOnDrawText(Self, Node, ARect, defaultDrawing);
end;
procedure TfcDBCustomTreeView.WMNCHitTest(var Message: TWMNCHitTest);
begin
DefaultHandler(Message);
end;
//procedure TfcdbCustomTreeView.CMDesignHitTest(var Message: TCMDesignHitTest);
//begin
// message.result:= 1;
// inherited;
//end;
procedure TfcDBCustomTreeView.WndProc(var Message: TMessage);
begin
{ if (csDesigning in ComponentState) then
begin
if (Message.Msg = wm_lbuttondown) then
begin
ControlState := ControlState + [csLButtonDown];
Dispatch(Message);
exit;
end;
end;
}
inherited WndProc(Message);
end;
Function TfcDBCustomTreeView.GetNodeAt(X,Y: integer): TfcDBTreeNode;
var Row: integer;
begin
MouseToRow(X, Y, Row);
if not RowToNode(Row, Result) then Result:= nil;
end;
Function TfcDBTreeNode.GetFieldValue(FieldName: string): Variant;
var PrevActiveRecord: integer;
curField: TField;
begin
PrevActiveRecord:= DataLink.ActiveRecord;
DataLink.ActiveRecord:= ActiveRecord;
curField:= DataSet.FindField(FieldName);
if curField=nil then result:= NULL
else result:= curField.Value;
DataLink.ActiveRecord:= PrevActiveRecord;
end;
procedure TfcDBCustomTreeView.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) then
begin
if AComponent = Header then Header:= nil;
if AComponent = Images then Images := nil;
if AComponent = StateImages then StateImages := nil;
if (AComponent = FImager) then FImager := nil
end;
end;
{ Sorts by level, and then by bookmark order }
procedure TfcDBCustomTreeView.SortMultiSelectList;
var res: CmpBkmkRslt;
Function LessThan(item1, item2: TfcMultiSelectItem): boolean;
begin
if item1.DataSet = item2.DataSet then begin
res:= (item1.DataSet as TDataSet).CompareBookmarks(item1.bookmark, item2.bookmark);
result:= integer(res)=CmpLESS;
end
else begin
result:= GetDataLinkIndex(item1.dataset)<GetDataLinkIndex(item2.dataset)
end
end;
Function GreaterThan(item1, item2: TfcMultiSelectItem): boolean;
begin
if item1.DataSet = item2.DataSet then begin
res:= (item1.DataSet as TDataSet).CompareBookmarks(item1.bookmark, item2.bookmark);
result:= integer(res)=CmpGtr;
end
else begin
result:= GetDataLinkIndex(item1.dataset)>GetDataLinkIndex(item2.dataset)
end
end;
procedure Partition(var i, j: integer);
var Pivot, Temp: TfcMultiSelectItem;
begin
Pivot:= MultiSelectList[(i+j) div 2];
repeat
while LessThan(MultiSelectList[i], Pivot) do i:= i + 1;
while GreaterThan(MultiSelectList[j], Pivot) do j:= j - 1;
if (i<=j) then begin
Temp:= FMultiSelectList[i];
FMultiSelectList[i]:= FMultiSelectList[j];
FMultiSelectList[j]:= Temp;
i:= i +1;
j:= j-1;
end
until (i>j);
end;
procedure QuickSort(m, n: integer);
var i,j: integer;
begin
if (m<n) then begin
i:= m; j:= n;
Partition(i, j);
QuickSort(m,j);
QuickSort(i,n);
end
end;
begin
QuickSort(0, MultiSelectListCount-1);
end;
procedure TfcDBCustomTreeview.SetImager(Value: TfcCustomImager);
begin
if FImager <> nil then FImager.UnRegisterChanges(FChangeLink);
if Value <> nil then
begin
Value.FreeNotification(self);
Value.RegisterChanges(FChangeLink);
Value.Parent := self;
if Value.DrawStyle <> dsStretch then
Value.DrawStyle := dsTile;
// Value.Align := alClient;
Value.Visible := False;
Value.Left:= 0;
Value.Top:= 0;
Value.Width:= 25;
Value.Height:= 25;
end;
if Value<>FImager then InvalidateClient;
FImager := Value;
end;
procedure TfcDBCustomTreeView.ImagerChange(Sender: TObject);
begin
invalidate;
end;
{$ifdef fcDelphi4Up}
function TfcDBCustomTreeView.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
NextRow(dtvoKeysScrollLevelOnly in Options);
result := True;
end;
function TfcDBCustomTreeView.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
PriorRow(dtvoKeysScrollLevelOnly in Options);
result := True;
end;
{$endif}
procedure TfcDBCustomTreeView.SetHeader(Value: TFcTreeHeader);
begin
if FHeader<>nil then
begin
TfcTreeHeader(Header).HeaderControl.Tree:=nil;
end;
FHeader:= Value;
if Value<>nil then
TfcTreeHeader(Value).HeaderControl.Tree:=self;
end;
function TfcDBCustomTreeView.ComputeHeaderWidth: integer;
var i: integer;
NewMaxTextWidth: integer;
begin
NewMaxTextWidth:= 0;
with TfcTreeHeader(Header) do begin
for i:= 0 to Sections.count-1 do
NewMaxTextWidth:= NewMaxTextWidth + Sections[i].width;
end;
result:= NewMaxTextWidth;
end;
{procedure TfcDBCustomTreeView.WMHScroll(var Message: TWMHScroll);
begin
inherited;
exit;
end;
}
end.