Delphi控件源码

开发平台：

Delphi

fctreeview.pas：源码内容

else begin
if (tvoEditText in Options) then SetComCtlStyle(Self, TVS_EDITLABELS, True);
end;
end;
end;
{procedure TfcCustomTreeView.SetHideSelection(Value: Boolean);
begin
if HideSelection <> Value then
begin
FHideSelection := Value;
SetComCtlStyle(Self, TVS_SHOWSELALWAYS, not Value);
Invalidate;
end;
end;
}
function TfcCustomTreeView.GetNodeAt(X, Y: Integer): TfcTreeNode;
var
HitTest: TTVHitTestInfo;
begin
with HitTest do
begin
pt.X := X;
pt.Y := Y;
if TreeView_HitTest(Handle, HitTest) <> nil then
Result := Items.GetNode(HitTest.hItem)
else Result := nil;
end;
end;
function TfcCustomTreeView.GetHitTestInfoAt(X, Y: Integer): TfcHitTests;
var
HitTest: TTVHitTestInfo;
DisplayRect: TRect;
Node: TfcTreeNode;
begin
Result := [];
with HitTest do
begin
pt.X := X;
pt.Y := Y;
TreeView_HitTest(Handle, HitTest);
if (flags and TVHT_ABOVE) <> 0 then Include(Result, fchtAbove);
if (flags and TVHT_BELOW) <> 0 then Include(Result, fchtBelow);
if (flags and TVHT_NOWHERE) <> 0 then Include(Result, fchtNowhere);
if (flags and TVHT_ONITEM) <> 0 then Include(Result, fchtOnItem);
if (flags and TVHT_ONITEMBUTTON) <> 0 then Include(Result, fchtOnButton);
if (flags and TVHT_ONITEMICON) <> 0 then Include(Result, fchtOnIcon);
if (flags and TVHT_ONITEMINDENT) <> 0 then Include(Result, fchtOnIndent);
if (flags and TVHT_ONITEMLABEL) <> 0 then Include(Result, fchtOnLabel);
if (flags and TVHT_ONITEMRIGHT) <> 0 then Include(Result, fchtOnRight);
if (flags and TVHT_ONITEMSTATEICON) <> 0 then Include(Result, fchtOnStateIcon);
if (flags and TVHT_TOLEFT) <> 0 then Include(Result, fchtToLeft);
if (flags and TVHT_TORIGHT) <> 0 then Include(Result, fchtToRight);
if (fchtOnItem in Result) then
begin
node:= GetNodeAt(X, Y);
if (Images<>Nil) and (node<>nil) and (node.imageindex=-2) then
begin
DisplayRect:= Node.DisplayRect(True);
if (x>=DisplayRect.Left) and (x<=DisplayRect.Right) then
begin
Include(Result, fchtOnLabel);
Exclude(Result, fchtOnIcon);
end
end
end;
end;
end;
procedure TfcCustomTreeView.SeTfcTreeNodes(Value: TfcTreeNodes);
begin
Items.Assign(Value);
end;
procedure TfcCustomTreeView.SetIndent(Value: Integer);
begin
if Value <> Indent then TreeView_SetIndent(Handle, Value);
end;
function TfcCustomTreeView.GetIndent: Integer;
begin
Result := TreeView_GetIndent(Handle)
end;
procedure TfcCustomTreeView.FullExpand;
var
Node: TfcTreeNode;
begin
Node := Items.GetFirstNode;
while Node <> nil do
begin
Node.Expand(True);
Node := Node.GetNextSibling;
end;
ResetStateImages;
end;
procedure TfcCustomTreeView.FullCollapse;
var
Node: TfcTreeNode;
begin
Node := Items.GetFirstNode;
while Node <> nil do
begin
Node.Collapse(True);
Node := Node.GetNextSibling;
end;
end;
procedure TfcCustomTreeView.Loaded;
begin
inherited Loaded;
if csDesigning in ComponentState then FullExpand;
end;
function TfcCustomTreeView.GetTopItem: TfcTreeNode;
begin
if HandleAllocated then
Result := Items.GetNode(TreeView_GetFirstVisible(Handle))
else Result := nil;
end;
procedure TfcCustomTreeView.SetTopItem(Value: TfcTreeNode);
begin
if HandleAllocated and (Value <> nil) then
TreeView_SelectSetFirstVisible(Handle, Value.ItemId);
end;
procedure TfcCustomTreeView.OnChangeTimer(Sender: TObject);
begin
FChangeTimer.Enabled := False;
Change(TfcTreeNode(FChangeTimer.Tag));
end;
function TfcCustomTreeView.GetSelection: TfcTreeNode;
begin
if HandleAllocated then
begin
Result := Items.GetNode(TreeView_GetSelection(Handle));
end
else Result := nil;
end;
procedure TfcCustomTreeView.SetSelection(Value: TfcTreeNode);
begin
if Value <> nil then Value.Selected := True
else TreeView_SelectItem(Handle, nil);
end;
procedure TfcCustomTreeView.SetChangeDelay(Value: Integer);
begin
FChangeTimer.Interval := Value;
end;
function TfcCustomTreeView.GetChangeDelay: Integer;
begin
Result := FChangeTimer.Interval;
end;
function TfcCustomTreeView.GetDropTarget: TfcTreeNode;
begin
if HandleAllocated then
begin
Result := Items.GetNode(TreeView_GetDropHilite(Handle));
if Result = nil then Result := FLastDropTarget;
end
else Result := nil;
end;
procedure TfcCustomTreeView.SetDropTarget(Value: TfcTreeNode);
begin
if HandleAllocated then
if Value <> nil then Value.DropTarget := True
else TreeView_SelectDropTarget(Handle, nil);
end;
function TfcCustomTreeView.GetNodeFromItem(const Item: TTVItem): TfcTreeNode;
begin
with Item do
if (state and TVIF_PARAM) <> 0 then Result := Pointer(lParam)
else Result := Items.GetNode(hItem);
end;
function TfcCustomTreeView.IsEditing: Boolean;
var
ControlHand: HWnd;
begin
ControlHand := TreeView_GetEditControl(Handle);
Result := (ControlHand <> 0) and IsWindowVisible(ControlHand);
end;
function fcWinItemStateTokwItemState(WinItemState: UINT): TfcItemStates;
begin
result := [];
if WinItemState and CDIS_SELECTED <> 0 then include(result, fcisSelected);
if WinItemState and CDIS_GRAYED <> 0 then include(result, fcisGrayed);
if WinItemState and CDIS_DISABLED <> 0 then include(result, fcisDisabled);
if WinItemState and CDIS_CHECKED <> 0 then include(result, fcisChecked);
if WinItemState and CDIS_FOCUS <> 0 then include(result, fcisFocused);
if WinItemState and CDIS_DEFAULT <> 0 then include(result, fcisDefault);
if WinItemState and CDIS_HOT <> 0 then include(result, fcisHot);
if WinItemState and CDIS_MARKED <> 0 then include(result, fcisMarked);
if WinItemState and CDIS_INDETERMINATE <> 0 then include(result, fcisIndeterminate);
end;
procedure TfcCustomTreeView.PaintItem(node: TfcTreeNode);
begin
end;
procedure TfcCustomTreeView.CNNotify(var Message: TWMNotify);
//const
// TVN_BEGINLABELEDIT = TVN_FIRST-10;
var
Node: TfcTreeNode;
MousePos: TPoint;
R: TRect;
DefaultDraw: Boolean;
TmpItem: TTVItem;
ANode: TfcTreeNode;
TempText: string; // -ksw (Added for tvoUnderscoreAllowed option)
begin
with Message do
case NMHdr^.code of
NM_CUSTOMDRAW:
with PNMCustomDraw(NMHdr)^ do
begin
Result := CDRF_DODEFAULT;
if dwDrawStage = CDDS_PREPAINT then
begin
FIndent := TreeView_GetIndent(self.Handle);
if True then // IsCustomDrawn(dtControl, cdPrePaint) then
begin
FCanvas.Handle := dc;
Canvas.Font := Font;
Canvas.Brush := Brush;
R := ClientRect;
BeginPainting;
DisplayedItems:= 0;
{ DefaultDraw := CustomDraw(R, cdPrePaint);
if not DefaultDraw then
begin
Result := CDRF_SKIPDEFAULT;
Exit;
end;}
end;
if True then //IsCustomDrawn(dtControl, cdPostPaint) then
Result := CDRF_NOTIFYPOSTPAINT;
if True then //IsCustomDrawn(dtItem, cdPrePaint) then
Result := Result or CDRF_NOTIFYITEMDRAW else
Result := Result or CDRF_DODEFAULT;
end
else if dwDrawStage = CDDS_ITEMPREPAINT then
begin
FillChar(TmpItem, SizeOf(TmpItem), 0);
TmpItem.hItem := HTREEITEM(dwItemSpec);
Node := GetNodeFromItem(TmpItem);
inc(DisplayedItems);
if Node <> nil then
begin
// {$ifdef fcdelphi4up}
// FCanvas.Handle := hdc;
// {$else}
// FCanvas.Handle := dc;
// {$endif}
Canvas.Font := Font;
Canvas.Brush := Brush;
{ Unlike the list view, the tree view doesn't override the text
foreground and background colors of selected items. }
if uItemState and CDIS_SELECTED <> 0 then
begin
Canvas.Font.Color := clHighlightText;
Canvas.Brush.Color := clHighlight;
end;
Canvas.Font.OnChange := CanvasChanged;
Canvas.Brush.OnChange := CanvasChanged;
DefaultDraw:= True;
// DefaultDraw := CustomDrawItem(Node,
// TCustomDrawState(Word(uItemState)), cdPrePaint);
Result := Result or CDRF_SKIPDEFAULT; {ww}
if DefaultDraw and FCanvasChanged then
begin
FCanvasChanged := False;
Canvas.Font.OnChange := nil;
Canvas.Brush.OnChange := nil;
with PNMTVCustomDraw(NMHdr)^ do
begin
clrText := ColorToRGB(Canvas.Font.Color);
clrTextBk := ColorToRGB(Canvas.Brush.Color);
SelectObject(dc, Canvas.Font.Handle);
Result := Result or CDRF_NEWFONT;
end;
end;
if DefaultDraw then
begin
ANode := TfcTreeNode(lItemlParam);
rc := ANode.DisplayRect(True);
BeginItemPainting(ANode, rc,
fcWinItemStateTokwItemState(uItemState));
EndItemPainting(TfcTreeNode(lItemlParam),
rc, fcWinItemStateTokwItemState(uItemState));
end;
PaintItem(Node);
// FCanvas.Handle := 0;
if True then //IsCustomDrawn(dtItem, cdPostPaint) then
Result := Result or CDRF_NOTIFYPOSTPAINT;
end;
end
else if dwDrawStage = CDDS_POSTPAINT then
begin
// if DisplayedItems>0 then
// begin
EndPainting;
FCanvas.Handle := 0;
// end;
end;
end;
TVN_BEGINDRAG:
begin
FDragged := True;
with PNMTreeView(NMHdr)^ do
FDragNode := GetNodeFromItem(ItemNew);
end;
TVN_BEGINLABELEDIT:
begin
{ Result:= 1;
Node := GetNodeFromItem(PTVDispInfo(NMHdr)^.Item);
DisplayRect:= Node.DisplayRect(True);
if FEditControl=Nil then
begin
FEditControl:= TEdit.create(self);
end;
FEditControl.parent:= self;
TEdit(FEditControl).AutoSize:= False;
FEditControl.Left:= DisplayRect.Left;
FEditControl.Top:= DisplayRect.Top;
FEditControl.Height:= DisplayRect.Bottom - DisplayRect.Top;
FEditControl.Visible:= True;
TEdit(FEditControl).Text:= Node.Text;
// TEdit(FEditControl).Ctl3d:= False;
TEdit(FEditControl).SelectAll;
TEdit(FEditControl).SetFocus;
exit;
}
with PTVDispInfo(NMHdr)^ do
if Dragging or not CanEdit(GetNodeFromItem(item)) then
Result := 1;
if Result = 0 then
begin
FEditHandle := TreeView_GetEditControl(Handle);
FDefEditProc := Pointer(GetWindowLong(FEditHandle, GWL_WNDPROC));
SetWindowLong(FEditHandle, GWL_WNDPROC, LongInt(FEditInstance));
// sp:= self.ClientToScreen(Point(0, 0));
EditNode := GetNodeFromItem(PTVDispInfo(NMHdr)^.Item);
Patch[0]:= True; { 6/14/99 - Skip Validate in EditWndProc }
// DisplayRect:= Node.DisplayRect(True);
//
// GetWindowRect(self.handle, r);
// SetWindowPos(FEditHandle, 0, 1,1,0,0, //sp.x + DisplayRect.Left, sp.y + DisplayRect.Top, 0, 0,
// SWP_NOZORDER OR SWP_NOSIZE OR SWP_NOACTIVATE);
end;
end;
TVN_ENDLABELEDIT:
begin
Edit(PTVDispInfo(NMHdr)^.item);
end;
TVN_ITEMEXPANDING:
if not FManualNotify then
begin
with PNMTreeView(NMHdr)^ do
begin
Node := GetNodeFromItem(ItemNew);
if (action = TVE_EXPAND) and not CanExpand(Node) then
Result := 1
else if (action = TVE_COLLAPSE) and
not CanCollapse(Node) then Result := 1;
end;
end;
TVN_ITEMEXPANDED:
if not FManualNotify then
begin
with PNMTreeView(NMHdr)^ do
begin
Node := GetNodeFromItem(itemNew);
if (action = TVE_EXPAND) then Expand(Node)
else if (action = TVE_COLLAPSE) then Collapse(Node);
end;
end;
TVN_SELCHANGINGA, TVN_SELCHANGINGW:
begin
if SkipChangeMessages then exit; { RSW}
if not CanChange(GetNodeFromItem(PNMTreeView(NMHdr)^.itemNew)) then
Result := 1;
end;
TVN_SELCHANGEDA, TVN_SELCHANGEDW:
begin
if SkipChangeMessages then exit; { RSW}
with PNMTreeView(NMHdr)^ do
if FChangeTimer.Interval > 0 then
with FChangeTimer do
begin
Enabled := False;
Tag := Integer(GetNodeFromItem(itemNew));
Enabled := True;
end
else
Change(GetNodeFromItem(itemNew));
end;
TVN_DELETEITEM:
// if not FStateChanging then {5/16/2000 - PYW - Fix Memory leak from code left over from Delphi 3}
begin
Node := GetNodeFromItem(PNMTreeView(NMHdr)^.itemOld);
if Node <> nil then
begin
Node.FItemId := nil;
FChangeTimer.Enabled := False;
if FStateChanging then Node.Delete
else Items.Delete(Node);
end;
end;
TVN_SETDISPINFO:
with PTVDispInfo(NMHdr)^ do
begin
Node := GetNodeFromItem(item);
if (Node <> nil) and ((item.mask and TVIF_TEXT) <> 0) then
Node.Text := item.pszText;
end;
TVN_GETDISPINFO:
with PTVDispInfo(NMHdr)^ do
begin
Node := GetNodeFromItem(item);
if Node <> nil then
begin
TempText := Node.Text; // -ksw (Added for tvoUnderscoreAllowed option)
// if tvoUnderscoreAllowed in FOptions then TempText := fcStripAmpersands(Node.Text); // -ksw Added
if (item.mask and TVIF_TEXT) <> 0 then
StrLCopy(item.pszText, PChar(TempText), item.cchTextMax); // -ksw (Changed to use the TempText var)
if (item.mask and TVIF_IMAGE) <> 0 then
begin
GetImageIndex(Node);
item.iImage := Node.ImageIndex;
end;
if (item.mask and TVIF_SELECTEDIMAGE) <> 0 then
begin
GetSelectedIndex(Node);
item.iSelectedImage := Node.SelectedIndex;
end;
end;
end;
NM_RCLICK:
begin
GetCursorPos(MousePos);
with PointToSmallPoint(ScreenToClient(MousePos)) do
begin
FRClickNode := GetNodeAt(X, Y);
if RightClickSelects and (FRClickNode<>nil) then Selected:= FRClickNode
else begin
if FRClickNode<>nil then InvalidateNode(FRClickNode);
end;
InvalidateNoErase; { 4/21/99 - Workaround for Microsoft Tree bug which causes last
node to not paint correctly }
Perform(WM_RBUTTONUP, 0, MakeLong(X, Y));
{6/9/2000 - PYW - Prevent default button handling for treeview}
Message.Result := 1;
end;
end;
// TVN_BEGINLABELEDIT:
// begin
// end;
{ TVN_GETINFOTIP:
begin
if fcUpdatedComCtlVersion then begin
ToolTipHandle:= SendMessage(Handle, TVM_GETTOOLTIPS, 0, 0);
with PNMTVGetInfoTip(NMHdr)^ do
begin
Node:= Items.GetNode(hItem);
HintTimer:= TTimer.create(self);
HintTimer.OnTimer:=HintTimerEvent;
HintTimer.Interval:=250;
HintTimer.Enabled:= True;
// strpcopy(pszText, Node.Text);
end;
if (ToolTipHandle <> 0) and (LastHintNode<>Node) then
begin
FreeHintWindow;
sp:= self.ClientToScreen(Point(0, 0));
DisplayRect:= Node.DisplayRect(True);
R.Left:= DisplayRect.Left + sp.x - 1;
R.Top:= DisplayRect.Top + sp.y - 2;
R.Right:= R.Left + Canvas.TextWidth(Node.Text) + 6;
R.Bottom:= R.Top + Canvas.TextHeight(Node.Text) + 2;
if DisplayRect.Left+Canvas.TextWidth(Node.Text)>
GetEffectiveWidth then
begin
LastHintNode:= Node;
HintWindow:= CreateHintWindow;
HintWindow.ActivateHint(R, Node.Text);
end
else LastHintNode:= nil;
end
end;
end;}
end;
end;
function TfcCustomTreeView.GetDragImages: {$ifdef fcDelphi4Up}TDragImageList{$else}TCustomImageList{$endif};
begin
if (FDragImage <> nil) and (FDragImage.Count > 0) then // Added check to make sure FDragImage is not nil -ksw (11/30/98)
Result := FDragImage else
Result := nil;
end;
procedure TfcCustomTreeView.WndProc(var Message: TMessage);
begin
{ if (csDesigning in ComponentState) then
begin
if (Message.Msg = wm_lbuttondown) or (Message.Msg = wm_vscroll) then
begin
ControlState := ControlState + [csLButtonDown];
Dispatch(Message);
exit;
end;
end;
}
{$ifdef fcDelphi4Up}
if not (csDesigning in ComponentState) and ((Message.Msg = WM_LBUTTONDOWN) or
(Message.Msg = WM_LBUTTONDBLCLK)) and not Dragging and
(DragMode = dmAutomatic) and (DragKind = dkDrag) then
begin
if not IsControlMouseMsg(TWMMouse(Message)) then
begin
ControlState := ControlState + [csLButtonDown];
Dispatch(Message);
end;
end
else inherited WndProc(Message);
{$else}
inherited WndProc(Message);
{$endif}
end;
procedure TfcCustomTreeView.DoStartDrag(var DragObject: TDragObject);
var
ImageHandle: HImageList;
DragNode: TfcTreeNode;
P: TPoint;
begin
inherited DoStartDrag(DragObject);
DragNode := FDragNode;
FLastDropTarget := nil;
FDragNode := nil;
if DragNode = nil then
begin
GetCursorPos(P);
with ScreenToClient(P) do DragNode := GetNodeAt(X, Y);
end;
if DragNode <> nil then
begin
ImageHandle := TreeView_CreateDragImage(Handle, DragNode.ItemId);
if ImageHandle <> 0 then
begin
// 2/3/2000 - Optimize imagelist usage so that resources are better
if FDragImage=nil then
begin
{$ifdef fcDelphi4Up}
FDragImage := TDragImageList.CreateSize(32, 32);
{$else}
FDragImage := TImageList.CreateSize(32, 32);
{$endif}
end;
with FDragImage do
begin
Handle := ImageHandle;
SetDragImage(0, 2, 2);
end;
end
end;
end;
procedure TfcCustomTreeView.DoEndDrag(Target: TObject; X, Y: Integer);
begin
inherited DoEndDrag(Target, X, Y);
FLastDropTarget := nil;
end;
procedure TfcCustomTreeView.CMDrag(var Message: TCMDrag);
begin
inherited;
with Message, DragRec^ do
case DragMessage of
dmDragMove:
with ScreenToClient(Pos) do
DoDragOver(Source, X, Y, Message.Result <> 0);
dmDragLeave:
begin
TDragObject(Source).HideDragImage;
FLastDropTarget := DropTarget;
DropTarget := nil;
TDragObject(Source).ShowDragImage;
end;
dmDragDrop: FLastDropTarget := nil;
end;
end;
procedure TfcCustomTreeView.DoDragOver(Source: TDragObject; X, Y: Integer; CanDrop: Boolean);
var
Node: TfcTreeNode;
begin
Node := GetNodeAt(X, Y);
if (Node <> nil) and
((Node <> DropTarget) or (Node = FLastDropTarget)) then
begin
FLastDropTarget := nil;
TDragObject(Source).HideDragImage;
Node.DropTarget := True;
TDragObject(Source).ShowDragImage;
end;
end;
procedure TfcCustomTreeView.GetImageIndex(Node: TfcTreeNode);
begin
if Assigned(FOnGetImageIndex) then FOnGetImageIndex(Self, Node);
end;
procedure TfcCustomTreeView.GetSelectedIndex(Node: TfcTreeNode);
begin
if Assigned(FOnGetSelectedIndex) then FOnGetSelectedIndex(Self, Node);
end;
function TfcCustomTreeView.CanChange(Node: TfcTreeNode): Boolean;
begin
Result := True;
if Assigned(FOnChanging) then FOnChanging(Self, Node, Result);
end;
procedure TfcCustomTreeView.Change(Node: TfcTreeNode);
begin
if Assigned(FOnChange) then FOnChange(Self, Node);
end;
procedure TfcCustomTreeView.Delete(Node: TfcTreeNode);
begin
if Assigned(FOnDeletion) then FOnDeletion(Self, Node);
if Assigned(FOnItemChange) then FOnItemChange(self, Node, icaDelete, NULL);
end;
procedure TfcCustomTreeView.Expand(Node: TfcTreeNode);
begin
if Assigned(FOnExpanded) then FOnExpanded(Self, Node);
end;
function TfcCustomTreeView.CanExpand(Node: TfcTreeNode): Boolean;
begin
Result := True;
if Assigned(FOnExpanding) then FOnExpanding(Self, Node, Result);
{ 5/21/99 - Complete editing }
if IsEditing and (Selected<>nil) and
(Selected.HasAsParent(Node) or (Selected=Node)) then
begin
Selected.EndEdit(False);
result:= False;
end;
if InLoading then result:= False;
end;
procedure TfcCustomTreeView.Collapse(Node: TfcTreeNode);
begin
if Assigned(FOnCollapsed) then FOnCollapsed(Self, Node);
end;
function TfcCustomTreeView.CanCollapse(Node: TfcTreeNode): Boolean;
begin
Result := True;
if Assigned(FOnCollapsing) then FOnCollapsing(Self, Node, Result);
{ 5/21/99 - Complete editing }
if IsEditing and (Selected<>nil) and
(Selected.HasAsParent(Node) or (Selected=Node)) then
begin
Selected.EndEdit(False);
result:= False;
end
end;
function TfcCustomTreeView.CanEdit(Node: TfcTreeNode): Boolean;
begin
Result := True;
if Assigned(FOnEditing) then FOnEditing(Self, Node, Result);
end;
procedure TfcCustomTreeView.Edit(const Item: TTVItem);
var
S: string;
Node: TfcTreeNode;
begin
with Item do
if pszText <> nil then
begin
S := pszText;
Node := GetNodeFromItem(Item);
if Assigned(FOnEdited) then FOnEdited(Self, Node, S);
if Node <> nil then Node.Text := S;
EditNode := Nil;
end;
end;
function TfcCustomTreeView.CreateNode: TfcTreeNode;
begin
Result := NodeClass.Create(Items);
if Assigned(OnItemChange) then OnItemChange(self, result, icaAdd, NULL);
end;
procedure TfcCustomTreeView.SetImageList(Value: HImageList; Flags: Integer);
begin
if HandleAllocated then TreeView_SetImageList(Handle, Value, Flags);
end;
procedure TfcCustomTreeView.ImageListChange(Sender: TObject);
var
ImageHandle: HImageList;
begin
if HandleAllocated then
begin
if TCustomImageList(Sender).HandleAllocated then
ImageHandle := TCustomImageList(Sender).Handle
else
ImageHandle := 0;
if Sender = Images then
SetImageList(ImageHandle, TVSIL_NORMAL)
else if Sender = StateImages then
SetImageList(ImageHandle, TVSIL_STATE);
end;
end;
procedure TfcCustomTreeView.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
begin
if AComponent = Images then Images := nil;
if AComponent = StateImages then StateImages := nil;
end;
end;
procedure TfcCustomTreeView.ResetStateImages;
var Node: TfcTreeNode;
begin
if Images<>nil then begin
Node := Items.GetFirstNode;
while Node <> nil do
begin
if (Node.StateIndex <>(Node.GetStateIndex shr 12) -1) then
Node.StateIndex:= Node.StateIndex;
Node := Node.GetNext;
end
end
end;
procedure TfcCustomTreeView.SetImages(Value: TCustomImageList);
begin
if Images <> nil then
Images.UnRegisterChanges(FImageChangeLink);
FImages := Value;
if Images <> nil then
begin
Images.RegisterChanges(FImageChangeLink);
Images.FreeNotification(Self);
SetImageList(Images.Handle, TVSIL_NORMAL);
{ Imagelist changing after nodes loaded causes stateindex to no longer be -1 }
{ Therefore scan all nodes and reset the ones that are incorrect }
{ 2/1/99 - Reset state images due to Microsoft TreeView resetting StateImage list }
if StateImages <> nil then
begin
SetImageList(StateImages.Handle, TVSIL_STATE)
end;
ResetStateImages;
// if not (csLoading in ComponentState) then RecreateWnd; // 2/2/99
end
else SetImageList(0, TVSIL_NORMAL);
end;
procedure TfcCustomTreeView.SetStateImages(Value: TCustomImageList);
var PrevStateImages: TCustomImageList;
begin
PrevStateImages:= StateImages;
if StateImages <> nil then
StateImages.UnRegisterChanges(FStateChangeLink);
FStateImages := Value;
if StateImages <> nil then
begin
StateImages.RegisterChanges(FStateChangeLink);
StateImages.FreeNotification(Self);
SetImageList(StateImages.Handle, TVSIL_STATE)
end;
// else SetImageList(0, TVSIL_STATE);
if PrevStateImages<>Value then
begin
if (Value=Nil) then
begin
TreeView_SetImageList(Handle, FFixBugImageList.Handle, TVSIL_STATE);
RecreateWnd;
end
end
end;
procedure TfcCustomTreeView.LoadFromFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
procedure TfcCustomTreeView.LoadFromStream(Stream: TStream);
begin
Stream.Position := 0;
Items.ReadData(Stream);
{ with TTreeStrings.Create(Items) do
try
LoadTreeFromStream(Stream);
finally
Free;
end;}
end;
procedure TfcCustomTreeView.SaveToFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end;
procedure TfcCustomTreeView.SaveToStream(Stream: TStream);
begin
Items.WriteData(Stream);
{ with TTreeStrings.Create(Items) do
try
SaveTreeToStream(Stream);
finally
Free;
end;}
end;
procedure TfcCustomTreeView.WMRButtonDown(var Message: TWMRButtonDown);
begin
InvalidateNoErase; { 4/21/99 - Workaround for Microsoft Tree bug which causes last
node to not paint correctly }
inherited;
end;
procedure TfcCustomTreeView.WMRButtonUp(var Message: TWMRButtonUp);
begin
inherited;
end;
procedure TfcCustomTreeView.WMLButtonDown(var Message: TWMLButtonDown);
var
{$ifdef fcDelphi4Up}
Node: TfcTreeNode;
{$endif}
MousePos, SP: TPoint;
hitTest: TfcHitTests;
begin
GetCursorPos(MousePos);
SP:= ScreenToClient(MousePos);
hitTest:= GetHitTestInfoAt(sp.x, sp.y);
BeforeMouseDownNode:= Selected;
ClickedNode:= GetNodeAt(sp.x, sp.y) as TfcTreeNode;
if (fchtOnButton in hitTest) {and (ssLeft in Shift) }then
begin
if tvoExpandButtons3D in Options then
begin
MouseNode:= GetNodeAt(sp.x, sp.y) as TfcTreeNode;
MouseLoop(sp.x, sp.y);
MouseNode:= nil;
exit;
end
end;
{ 7/3/99 - Only call Invalidate if not in expanding/collapsing}
if not (fchtOnButton in hitTest) then
InvalidateNoErase; { 4/21/99 - Workaround for Microsoft Tree bug which causes last
node to not paint correctly }
{$ifdef fcDelphi4Up}
FDragged := False;
FDragNode := nil;
try
inherited;
if (DragMode = dmAutomatic) and (DragKind = dkDrag) then
begin
SetFocus;
if not FDragged then
begin
GetCursorPos(MousePos);
with PointToSmallPoint(ScreenToClient(MousePos)) do
Perform(WM_LBUTTONUP, 0, MakeLong(X, Y));
end
else begin
Node := GetNodeAt(Message.XPos, Message.YPos);
if Node <> nil then
begin
Node.Focused := True;
Node.Selected := True;
BeginDrag(False);
end;
end;
end;
finally
FDragNode := nil;
end;
{$else}
inherited;
{$endif}
end;
procedure TfcCustomTreeView.WMNotify(var Message: TWMNotify);
var
Node: TfcTreeNode;
MaxTextLen: Integer;
Pt: TPoint;
begin
with Message do
if NMHdr^.code = TTN_NEEDTEXTW then
begin
// Work around NT COMCTL32 problem with tool tips >= 80 characters
GetCursorPos(Pt);
Pt := ScreenToClient(Pt);
Node := GetNodeAt(Pt.X, Pt.Y);
if (Node = nil) or (Node.Text = '') or
(PToolTipTextW(NMHdr)^.uFlags and TTF_IDISHWND = 0) then Exit;
if (fcGetComCtlVersion >= fcComCtlVersionIE4) and (Length(Node.Text) < 80) then
begin
inherited;
Exit;
end;
FWideText := Node.Text;
MaxTextLen := SizeOf(PToolTipTextW(NMHdr)^.szText) div SizeOf(WideChar);
if Length(FWideText) >= MaxTextLen then
SetLength(FWideText, MaxTextLen - 1);
PToolTipTextW(NMHdr)^.lpszText := PWideChar(FWideText);
FillChar(PToolTipTextW(NMHdr)^.szText, MaxTextLen, 0);
Move(Pointer(FWideText)^, PToolTipTextW(NMHdr)^.szText, Length(FWideText) * SizeOf(WideChar));
PToolTipTextW(NMHdr)^.hInst := 0;
SetWindowPos(NMHdr^.hwndFrom, HWND_TOP, 0, 0, 0, 0, SWP_NOACTIVATE or
SWP_NOSIZE or SWP_NOMOVE or SWP_NOOWNERZORDER);
Result := 1;
end
else inherited;
end;
{ CustomDraw support }
procedure TfcCustomTreeView.CanvasChanged;
begin
FCanvasChanged := True;
end;
{function TfcCustomTreeView.IsCustomDrawn(Target: TCustomDrawTarget;
Stage: TCustomDrawStage): Boolean;
begin
result:= True;
end;
}
//function TfcCustomTreeView.CustomDraw(const ARect: TRect; Stage: TCustomDrawStage): Boolean;
//begin
// Result := True;
// if Assigned(FOnCustomDraw) then FOnCustomDraw(Self, ARect, Result);
//end;
//function TfcCustomTreeView.CustomDrawItem(Node: TfcTreeNode; State: TCustomDrawState;
// Stage: TCustomDrawStage): Boolean;
//begin
// Result := True;
// if Assigned(FOnCustomDrawItem) then FOnCustomDrawItem(Self, Node, State, Result);
//end;
procedure TfcTreeNode.SetCheckboxType(val: TfcTreeViewCheckboxType);
begin
if (val<>FCheckboxType) {or (StateIndex>1) }then {4/26/99 - RSW Don't reset state index }
begin
FCheckboxType:= val;
if val<>tvctNone then
StateIndex:= 1
else
StateIndex:= -1
end
end;
function TfcTreeNode.GetMultiSelected: Boolean;
begin
result := FMultiSelected {or (TreeView.MultiSelectAttributes.AlwaysIncludeSelectedItem and Selected)};
end;
procedure TfcCustomTreeView.DoToggleCheckbox(Node: TfcTreeNode);
begin
if Assigned(OnToggleCheckbox) then FOnToggleCheckbox(self, Node);
end;
procedure TfcTreeNode.SetChecked(val : boolean);
var curNode: TfcTreeNode;
begin
if FChecked<>val then
begin
FChecked:= val;
if self.IsRadioGroup then
begin
if val=False then exit;
{ Unselect all siblings }
CurNode:= Treeview.GetFirstSibling(Self);
while curNode<>Nil do begin
if CurNode<>self then begin
curNode.checked:= False;
Treeview.InvalidateNode(CurNode);
end;
curNode:= TfcTreeNode(curNode.GetNextSibling);
end;
end
else if TreeView.MultiSelectCheckboxNeeded(self) then MultiSelected:= val;
Treeview.InvalidateNode(self);
TreeView.DoToggleCheckbox(self);
end;
end;
procedure TfcTreeNode.SetGrayed(val : boolean);
var curNode: TfcTreeNode;
begin
if FGrayed<>val then
begin
FGrayed:= val;
if self.IsRadioGroup then
begin
{ Toggle gray for all siblings }
CurNode:= Treeview.GetFirstSibling(Self);
while curNode<>Nil do begin
if CurNode<>self then begin
curNode.Grayed:= val;
Treeview.InvalidateNode(CurNode);
end;
curNode:= TfcTreeNode(curNode.GetNextSibling);
end;
end;
Treeview.InvalidateNode(self);
end;
end;
procedure TfcTreeNode.SetMultiSelected(Value: Boolean);
begin
if MultiSelected <> Value then
begin
TreeView.MultiSelectNode(self, Value, true); // This method will set the FMultiSelect var
end;
end;
function TfcTreeNode.GetStateIndex: integer;
var
Item: TTVItem;
begin
with Item do
begin
mask := TVIF_STATE or TVIF_HANDLE;
stateMask := TVIS_STATEIMAGEMASK;
hItem := ItemId;
// state := IndexToStateImageMask(Value + 1);
end;
TreeView_GetItem(Handle, Item);
result:= Item.state;
end;
Function TfcTreeNode.IsRadioGroup: boolean;
begin
result:= CheckboxType=tvctRadioGroup;
end;
Function TfcTreeNode.GetSortText: string;
begin
with TreeView do begin
result:= Text;
end
end;
constructor TfcTVMultiSelectAttributes.Create(Owner: TComponent);
begin
TreeView:= Owner as TfcCustomTreeView;
FMultiSelectCheckbox:= True;
// FAlwaysIncludeSelectedItem := False;
FAutoUnselect:= True;
end;
procedure TfcTVMultiSelectAttributes.Assign(Source: TPersistent);
var tsa: TfcTVMultiSelectAttributes;
begin
If Source is TfcTVMultiSelectAttributes then
begin
tsa:= TfcTVMultiSelectAttributes(Source);
Enabled:= tsa.Enabled;
MultiSelectCheckbox:= tsa.MultiSelectCheckbox;
MultiSelectLevel:= tsa.MultiSelectLevel;
end
else inherited Assign(Source);
end;
procedure TfcTVMultiSelectAttributes.SetEnabled(val: boolean);
var Node: TfcTreeNode;
begin
if val<>FEnabled then
begin
if FEnabled=True then
begin
{ Set all Stateimages of 1 to -1 unless checkboxType is checkbox}
Node := TreeView.Items.GetFirstNode;
while Node <> nil do
begin
// if (Node.StateIndex=1) and (Node.ShowCheckbox<>0) and
if (Node.StateIndex=1) and (Node.CheckboxType=tvctNone) and
(TreeView.ValidMultiSelectLevel(Node.Level)) then
Node.StateIndex:= -1;
Node := TfcTreeNode(Node.GetNext);
end;
end;
FEnabled:= val;
TreeView.invalidate;
end
end;
procedure TfcTVMultiSelectAttributes.SetMultiSelectCheckBox(val: boolean);
begin
if val<>FMultiSelectCheckbox then
begin
FMultiSelectCheckbox:= val;
if not val then Treeview.ClearStateImageIndexes;
TreeView.invalidate;
end
end;
procedure TfcTVMultiSelectAttributes.SetMultiSelectLevel(val: integer);
begin
if val<>FMultiSelectLevel then
begin
FMultiSelectLevel:= val;
(TreeView as TfcCustomTreeView).UnselectAllNodes(Nil);
if val>=0 then Treeview.ClearStateImageIndexes;
TreeView.Invalidate;
end
end;
function TfcCustomTreeView.ValidMultiSelectLevel(ALevel: Integer): Boolean;
begin
result := (FMultiSelectAttributes.MultiSelectLevel = ALevel) or
(FMultiSelectAttributes.MultiSelectLevel = -1);
end;
Procedure TfcCustomTreeView.UnselectAll;
begin
UnselectAllNodes(nil);
end;
Procedure TfcCustomTreeView.UnselectAllNodes(IgnoreNode: TfcTreeNode);
var curNode: TfcTreeNode;
i: integer;
begin
for i:= 0 to FMultiSelectList.count-1 do begin
curNode:= TfcTreeNode(FMultiSelectList[i]);
if (curNode<>IgnoreNode) then begin
curNode.FMultiSelected:= False;
if FMultiSelectAttributes.MultiSelectCheckbox then
curNode.checked:= False;
if IsVisible(curNode, True) then begin
InvalidateNode(curNode);
end
end
end;
FMultiSelectList.Clear;
if IgnoreNode<>nil then FMultiSelectList.Add(IgnoreNode);
end;
procedure TfcCustomTreeView.MultiSelectNode(Node: TfcTreeNode; Select: boolean; redraw: boolean);
begin
if (not ValidMultiSelectLevel(Node.Level)) {and
(FMultiSelectAttributes.MultiSelectLevel>=0)} then exit;
if FMultiSelectAttributes.MultiSelectCheckbox then
(Node as TfcTreeNode).checked:= Select;
if (Select <> (Node as TfcTreeNode).FMultiSelected) then
begin
if Select then FMultiSelectList.Add(Node)
else FMultiSelectList.Remove(Node);
(Node as TfcTreeNode).FMultiSelected:= Select;
if redraw and IsVisible(Node, True) then begin
InvalidateNode(Node);
end
end
end;
function TfcCustomTreeView.IsVisible(Node: TfcTreeNode; PartialOK: Boolean): Boolean;
var r: TRect;
i: integer;
begin
r := ItemRect(Node, True);
if PartialOK then i := r.Top else i := r.Bottom;
result := (i < Height - FBorderWidth * 2) and
(r.Bottom>0)
end;
Procedure TfcCustomTreeView.InvalidateNode(Node: TfcTreeNode);
var r: TRect;
begin
if Node=nil then exit;
r := ItemRect(Node, False);
if (r.Left=r.right) then exit;
InvalidateRect(Handle, @r, False);
end;
function TfcCustomTreeView.LevelRect(ANode: TfcTreeNode): TRect;
const wwIMAGEMARGIN = 4;
begin
result := ItemRect(ANode, True);
result.Right := result.Left+0;
result.Left := result.Left+0 - FIndent;
if UseImages(ANode) then
OffSetRect(result, -(TImageList(Images).Width + 2{ + wwIMAGEMARGIN}), 0);
{ 3/8/99 - Don't allow state images that are a multple of 16, as Microsoft does not currently support this }
if UseStateImages(ANode) or
((ANode.StateIndex>0) and ((ANode.StateIndex mod 16)<>0)) then
begin
if StateImages<>Nil then
OffsetRect(result, -TImageList(StateImages).Width, 0)
else
OffsetRect(result, -TImageList(FFixBugImageList).Width, 0);
end;
if UseImages(ANode) {and
not (UseStateImages(ANode) or (ANode.StateIndex>0)) }then begin
result.Left:= result.Left + 1;
result.Right:= result.Right + 1;
end
end;
function TfcCustomTreeView.ItemRect(Node: TfcTreeNode; LabelOnly: Boolean): TRect;
begin
result := Rect(0,0,0,0);
if Node = nil then Exit;
result := Node.DisplayRect(LabelOnly);
end;
Function TfcCustomTreeView.GetFirstSibling(Node: TfcTreeNode): TfcTreeNode;
var parentNode: TfcTreeNode;
begin
if Node=Nil then
parentNode:= Node
else
parentNode:= Node.parent;
if parentNode=nil then
result := Items.GetFirstNode as TfcTreeNode
else
result := TfcTreeNode(parentNode.GetFirstChild);
end;
procedure TfcCustomTreeView.DoDrawText(TreeView: TfcCustomTreeView;
Node: TfcTreeNode; ARect: TRect; AItemState: TfcItemStates;
var DefaultDrawing: boolean);
begin
DefaultDrawing:= True;
if Assigned(FOnDrawText) then FOnDrawText(Self, Node, ARect, AItemState, defaultDrawing); // -ksw (Added Canvas parameter)
end;
procedure TfcCustomTreeView.Compare(Node1, Node2: TfcTreeNode;
lParam: integer; var Result: integer);
begin
if Assigned(OnCompare) then
OnCompare(self, Node1, Node2, lParam, Result)
else
Result := lstrcmp(PChar(Node1.Text), PChar(Node2.Text));
end;
function TfcCustomTreeView.GetDisplayText(Node: TfcTreeNode): string;
begin
result:= node.text;
end;
procedure TfcCustomTreeView.LoadCanvasDefaults(Node: TfcTreeNode; AItemState: TfcItemStates);
begin
Canvas.Font.Assign(Font);
Canvas.Brush.Color := Color;
if (fcisSelected in AItemState) and not (tvoHideSelection in Options) then
Canvas.Brush.Color := clBtnFace;
if (((fcisSelected in AItemState) and ((DropTarget = nil) or (DropTarget = Node))) or Node.DropTarget)
and not FMultiSelectAttributes.enabled then
begin
if Focused then begin
Canvas.Brush.Color := clHighlight;
Canvas.Font.Color := clHighlightText;
end
else if not (tvoHideSelection in Options) then begin
if InactiveFocusColor<>Color then
Canvas.Brush.Color:= InactiveFocusColor
else
Canvas.Brush.Color:= clGray;
Canvas.Font.Color:= Font.Color;
end
end
else if FMultiSelectAttributes.enabled then
begin
if (Node as TfcTreeNode).FMultiSelected then
begin
Canvas.Brush.Color := clHighlight;
Canvas.Font.Color := clHighlightText;
end
else begin
Canvas.Brush.Color := Color;
Canvas.Font.Color := Font.Color;
end
end
else begin
Canvas.Brush.Color := Color;
Canvas.Font.Color := Font.Color;
end;
end;
procedure fcTreeViewError(const Msg: string);
begin
raise EfcTreeViewError.Create(Msg);
end;
function TfcCustomTreeView.ProcessKeyPress(Key: char; shift: TShiftState): boolean;
begin
result:= false;
end;
function TfcCustomTreeView.IsRowSelect: boolean;
begin
result:= tvoRowSelect in Options;
// result:= tvoRowSelect in Options;
end;
procedure TfcCustomTreeView.BeginItemPainting(Node: TfcTreeNode; ARect: TRect; AItemState: TfcItemStates);
begin
end;
procedure TfcCustomTreeView.EndPainting;
var r: TRect;
state: TfcItemStates;
begin
if FCanvas = Canvas then exit;
{ workaround for TreeView bug in Microsoft control when there is exactly one
item displayed }
if (Items.Count>0) and (DisplayedItems=0) and True then
begin
r := Items[0].DisplayRect(True);
state:= [fcisSelected];
if focused then
state:= state + [fcisFocused];
EndItemPainting(Items[0], r, state);
end;
if Items.Count>0 then begin { 1/24/99 -
If no records, then clearing done by erasebckground message
Don't rely upn paintcanvas as BeginPainting may not be called
if Items.Count is 0. }
r := ClientRect;
OffsetRect(r, 1, 0);
FCanvas.CopyMode:= cmSrcCopy;
FCanvas.CopyRect(
Rect(0,0,Canvas.ClipRect.Right,Canvas.ClipRect.Bottom),
Canvas, Canvas.ClipRect);
end;
end;
procedure TfcCustomTreeView.BeginPainting;
begin
{ Ensure that stateimages does not have exactly 1 image when painting a checkbox}
{ A bug in the Microsoft Tree control causs a gpf when there is exactly 1 state image when
clicking on a checkbox }
if (StateImages<>Nil) and (StateImages.Count=1) and
not (csDesigning in ComponentState) then
begin
StateImages.Clear;
TreeView_SetImageList(Handle, FFixBugImageList.Handle, TVSIL_STATE);
end;
if FCanvas = Canvas then exit;
{ Fill with background color }
FPaintBitmap.Width := Width;
FPaintBitmap.Height := Height;
FPaintBitmap.Canvas.Brush.Color := color;
FPaintBitmap.Canvas.FillRect(Rect(0, 0, FPaintBitmap.Width, FPaintBitmap.Height));
end;
procedure TfcCustomTreeView.CalcNodeAttributes(Node: TfcTreeNode; AItemState: TfcItemStates);
begin
if Assigned(FOnCalcNodeAttributes) then
FOnCalcNodeAttributes(Self, Node as TfcTreeNode, AItemState);
end;
procedure TfcCustomTreeView.EndItemPainting(Node: TfcTreeNode; ARect: TRect; AItemState: TfcItemStates);
const HDM_ORDERTOINDEX = HDM_FIRST + 15;
HDM_GETORDERARRAY = HDM_FIRST + 17;
DrawTextUnderscoreStyles: array[Boolean] of Integer = (DT_NOPREFIX, 0);
wwTEXTPADDING = 4;
var r, FocusRect, CalcRect: TRect;
DefaultDrawing: boolean;
flags:Longint;
begin
{ Imagelist changing after nodes loaded causes stateindex to no longer be -1 }
if (Node.StateIndex <>(Node.GetStateIndex shr 12) -1) then
begin
Node.StateIndex:= Node.StateIndex;
// exit; { RSW - Don't paint now, let Microsoft control paint this later}
end;
PaintLines(Node);
if MultiSelectCheckBoxNeeded(Node) then Node.StateIndex:= 1;
LoadCanvasDefaults(Node, AItemState);
if (fcisHot in AItemState) or
((tvoAutoURL in Options) and (Node.StringData<>'')) then
begin
if not (fcisSelected in AItemState) or not Focused then { 4/8/99 - No focus still paint clBlue }
Canvas.Font.Color:= clBlue;
Canvas.Font.Style:= [fsUnderline];
end;
CalcNodeAttributes(Node, AItemState);
Canvas.Refresh;
TreeView_GetItemRect(Handle, Node.ItemID, r, False);
r.Left := ARect.Left;
if Canvas.Font.Style * [fsBold, fsItalic] <> [] then begin
flags := 0;
CalcRect := ARect;
//5/10/2002 - Use DrawText to calculate font based on current canvas settings from OnCalcNodeAttributes event.
DrawText(Canvas.Handle, PChar(GetDisplayText(Node)), -1, calcrect, flags or DT_CALCRECT);
// ARect := Rect(ARect.Left, ARect.Top, ARect.Left +
// Canvas.TextWidth(GetDisplayText(Node)) + wwTEXTPADDING, ARect.Bottom);
ARect := Rect(ARect.Left, ARect.Top, ARect.Left + (CalcRect.Right-CalcRect.Left) + wwTEXTPADDING, ARect.Bottom);
end;
Canvas.Pen.Color := Color;
FocusRect:= ARect;
if IsRowSelect then
begin
FocusRect.Right:= Width-4;
if UseImages(node) then dec(FocusRect.Left, TImageList(Images).Width);
if UseStateImages(node) then begin
if StateImages<>nil then
dec(FocusRect.Left, TImageList(StateImages).Width)
else
dec(FocusRect.Left, FixBugImageListSize)
end;
if UseImages(node) or UseStateImages(node) then dec(FocusRect.Left, 4);
if not MultiSelectAttributes.enabled then
FocusRect.Bottom := FocusRect.Bottom + 1;
end;
if (not IsEditing) or not (fcIsSelected in AItemState) then
begin
if (Canvas.Brush.Color <> clNone) and
((not MultiSelectAttributes.enabled) or Node.MultiSelected) then
begin
if (fcisFocused in AItemState) then
Canvas.Rectangle(FocusRect.Left, FocusRect.Top, FocusRect.Right, FocusRect.Bottom)
else begin
FocusRect.bottom:= FocusRect.Bottom - 1;
Canvas.FillRect(FocusRect);
FocusRect.bottom:= FocusRect.Bottom + 1;
end
end
end;
PaintImage(Node, AItemState);
InflateRect(ARect, -1, -1);
ARect.Left:= ARect.Left + 1;
SetBkMode(Canvas.Handle, TRANSPARENT);
try
if (not IsEditing) or not (fcIsSelected in AItemState) then
begin
DoDrawText(self, Node, ARect, AItemState, DefaultDrawing);
if DefaultDrawing then begin
Canvas.DrawText(GetDisplayText(Node), ARect, DT_END_ELLIPSIS or DrawTextUnderscoreStyles[False]);
if (fcisFocused in AItemState) and Focused and
((not IsRowSelect) or MultiSelectAttributes.enabled) then
begin
Canvas.DrawFocusRect(FocusRect);
end
end
end
finally
SetBkMode(Canvas.Handle, OPAQUE);
end
end;
(*
procedure TfcCustomTreeView.EndItemPainting(Node: TfcTreeNode; ARect: TRect; AItemState: TfcItemStates);
const HDM_ORDERTOINDEX = HDM_FIRST + 15;
HDM_GETORDERARRAY = HDM_FIRST + 17;
DrawTextUnderscoreStyles: array[Boolean] of Integer = (DT_NOPREFIX, 0);
fcTEXTPADDING = 4;
var r: TRect;
DefaultDrawing: boolean;
begin
{ Imagelist changing after nodes loaded causes stateindex to no longer be -1 }
if (Node.StateIndex <>(Node.GetStateIndex shr 12) -1) then
begin
Node.StateIndex:= Node.StateIndex;
end;
PaintLines(Node);
if MultiSelectCheckBoxNeeded(Node) then Node.StateIndex:= 1;
LoadCanvasDefaults(Node, AItemState);
CalcNodeAttributes(Node, AItemState);
Canvas.Refresh;
if Canvas.Font.Style * [fsBold, fsItalic] <> [] then
ARect := Rect(ARect.Left, ARect.Top, ARect.Left +
Canvas.TextWidth(GetDisplayText(Node)) + fcTEXTPADDING, ARect.Bottom);
Canvas.Pen.Color := Color;
r := ARect;
if RowSelect then
begin
ARect.Left := LevelRect(Node).Left;
ARect.Right := Width;
end;
if Canvas.Brush.Color <> clNone then
begin
if (isFocused in AItemState) then
Canvas.Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom)
else Canvas.FillRect(ARect);
end;
if RowSelect then ARect.Left := r.Left;
PaintImage(Node, AItemState);
TreeView_GetItemRect(Handle, Node.ItemID, r, False);
r.Left := ARect.Left;
InflateRect(ARect, -1, -1);
SetBkMode(Canvas.Handle, TRANSPARENT);
try
DoDrawText(self, Node, ARect, AItemState, DefaultDrawing);
if DefaultDrawing then begin
Canvas.DrawText(GetDisplayText(Node), ARect, DT_END_ELLIPSIS or DrawTextUnderscoreStyles[tvoUnderscoreAllowed in FOptions]);
if (isFocused in AItemState) and Focused then begin
InflateRect(ARect, 1, 1);
Canvas.Brush.Color := clBlack;
SetTextColor(Canvas.Handle, clWhite);
Canvas.DrawFocusRect(ARect);
end
end
finally
SetBkMode(Canvas.Handle, OPAQUE);
end
end;
*)
procedure TfcCustomTreeView.PaintButton(Node: TfcTreeNode;
pt: TPoint; Size: integer);
var offset: integer;
drawRect: TRect;
OrigColor: TColor;
StateFlags: Word;
{$ifdef fcUseThemeManager}
Details: TThemedElementDetails;
{$endif}
begin
OrigColor:= Canvas.Brush.Color;
if not (tvoShowButtons 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 tvoExpandButtons3D in Options then
begin
Canvas.Brush.Color := clBtnFace;
Canvas.FillRect(DrawRect);
Canvas.Brush.Color := clBtnShadow;
StateFlags:= DFCS_BUTTONPUSH;
if Down and (MouseNode=Node) then
StateFlags := StateFlags or DFCS_PUSHED;
with DrawRect do
DrawFrameControl(Canvas.Handle, Rect(Left, Top, Right+1, Bottom+1),
DFC_BUTTON, StateFlags);
if ColorToRGB(Color)=clWhite then
begin
with DrawRect, Canvas 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 (MouseNode = Node) 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;
Canvas.Brush.Color := Color;
Canvas.Pen.Color := clBlack;
if not Node.Expanded then
Canvas.Polyline([Point(pt.x, DrawRect.Top+Offset div 2), Point(pt.x, DrawRect.Bottom-Offset div 2)]);
Canvas.Polyline([Point(DrawRect.Left+Offset div 2, pt.y), Point(DrawRect.Right-Offset div 2, pt.y)]);
Canvas.Brush.Color:= OrigColor;
end
else begin
if fcUseThemes(self) then
// if ThemeServices.ThemesEnabled then
begin
{$ifdef fcUseThemeManager}
if Node.expanded then
Details := ThemeServices.GetElementDetails(ttGlyphOpened)
else
Details := ThemeServices.GetElementDetails(ttGlyphClosed);
ThemeServices.DrawElement(Canvas.Handle, Details, DrawRect);
{$endif}
end
else begin
Canvas.Brush.Color := clWhite;
Canvas.FillRect(DrawRect);
Canvas.Brush.Color := clBtnShadow;
Canvas.FrameRect(DrawRect);
Canvas.Brush.Color := Color;
Canvas.Pen.Color := clBlack;
if not Node.Expanded then
Canvas.Polyline([Point(pt.x, DrawRect.Top+Offset div 2), Point(pt.x, DrawRect.Bottom-Offset div 2)]);
Canvas.Polyline([Point(DrawRect.Left+Offset div 2, pt.y), Point(DrawRect.Right-Offset div 2, pt.y)]);
Canvas.Brush.Color:= OrigColor;
end
end;
end;
Function TfcCustomTreeView.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;
if odd(fcRectWidth(r) div 2) then
result.x:= r.Left + (fcRectWidth(r)) div 2
else
result.x:= r.Left + (fcRectWidth(r)) div 2;
end;
procedure TfcCustomTreeView.PaintLines(Node: TfcTreeNode);
var LevelNode: TfcTreeNode;
r: TRect;
LineTop, LineBottom: TPoint;
X,Y: integer;
LineStartX: integer;
size: integer;
Function GetStartX(Node: TfcTreeNode): integer;
var Offset : integer;
r: TRect;
begin
r := LevelRect(Node);
Offset:= (((r.Bottom - r.Top) div 2) div 2)+2;
Offset:= fcMin(Offset, MaxCheckboxSize);
result:= r.Left + offset + 1; //r.Right + Offset + 1;
{ if Node.Level>0 then begin
r:= LevelRect(Node.parent);
Offset:= ((fcRectHeight(r) div 2) div 2)+2;
Offset:= fcMin(Offset, MaxCheckboxSize);
result:= r.Right + Offset + 1;
end
else begin
r := LevelRect(Node);
result:= r.Left + fcRectWidth(r) div 2;
end}
end;
begin
r:= LevelRect(Node);
if tvoShowLines in Options then
begin
Canvas.Pen.Color := FLineColor; //clBtnShadow; { for line drawing }
LevelNode := Node;
while (LevelNode <> nil) and ((LevelNode.Level = 0) or (LevelNode.Parent <> nil)) do
begin
with ItemRect(Node, False) do
begin
r := LevelRect(LevelNode);
r.Top := Top;
r.Bottom := Bottom;
end;
LineStartX:= GetStartX(LevelNode);
LineTop:= Point(LineStartX, r.Top);
LineBottom:= Point(LineStartX, r.Bottom);
if LevelNode.Level = Node.Level then
begin
if (Node.GetPrevSibling = nil) and (Node.Parent = nil) then
inc(LineTop.y, GetCenterPoint(r).y);
if Node.GetNextSibling = nil then
dec(LineBottom.y, fcRectHeight(r) div 2 - 1);
end;
if (LevelNode.GetNextSibling <> nil) or (LevelNode.Level = Node.Level) then
Canvas.DottedLine(LineTop, LineBottom);
LevelNode := LevelNode.Parent;
end;
r := LevelRect(Node);
if (tvoShowRoot in Options) or (Node.Level <> 0) then
begin
y:= GetCenterPoint(r).y;
x:= GetStartX(Node);
if UseStateImages(Node) or MultiSelectAttributes.enabled then
begin
if (CheckboxNeeded(Node as TfcTreeNode)) then
begin
r.right:= r.right - 2;
end
end;
Canvas.DottedLine(Point(x, y), Point(r.Right, y));
end
end;
if Node.HasChildren then begin
size:= (fcRectHeight(r) div 2);
size:= fcMax(size, 8);
PaintButton(Node, Point(GetStartX(Node), GetCenterPoint(r).y), size)
end
end;
procedure TfcCustomTreeView.PaintImage(Node: TfcTreeNode; State: TfcItemStates);
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);
Grayed: array[Boolean] of Integer = (0, DFCS_INACTIVE);
var r: TRect;
x: Integer;
Index: Integer;
cp: TPoint;
offset: integer;
Style: UINT;
BlendColor: TColorRef;
ARect: TRect;
{$ifdef fcUseThemeManager}
Details: TThemedElementDetails;
CheckboxStyle: TThemedButton;
PaintRect: TRect;
{$endif}
{$ifdef fcUseThemeManager}
function IsHotRadioOrCheckbox: boolean;
var SP, MousePos: TPoint;
hitTest: TfcHitTests;
begin
GetCursorPos(MousePos);
SP:= ScreenToClient(MousePos);
hitTest:= GetHitTestInfoAt(sp.x, sp.y);
ClickedNode:= GetNodeAt(sp.x, sp.y) as TfcTreeNode;
result:= (ClickedNode=Node) and (fchtOnStateIcon in hittest);
end;
function GetRadioButtonThemeStyle(Pressed: boolean): TThemedButton;
begin
if not Enabled then
begin
Result:= tbRadioButtonCheckedDisabled
end
else begin
if Node.checked then
begin
if Pressed then
Result:= tbRadioButtonCheckedPressed
else begin
if IsHotRadioOrCheckbox then
Result:= tbRadioButtonCheckedHot
else
Result:= tbRadioButtonCheckedNormal
end
end
else begin
if Pressed then
Result:= tbRadioButtonUncheckedPressed
else begin
if IsHotRadioOrCheckBox then
Result:= tbRadioButtonUncheckedHot
else
Result:= tbRadioButtonUncheckedNormal
end
end;
end;
end;
{$endif}
begin
r := LevelRect(Node);
if not((Images = nil) or
((Node.ImageIndex < 0)) or
(Node.ImageIndex >= Images.Count)) then
begin
x := r.Right;
if UseStateImages(Node) then
begin
if StateImages<>nil then
inc(x, TImageList(StateImages).Width)
else
inc(x, FixBugImageListSize);
end;
if (not (fcisSelected in State)) or (Node.SelectedIndex < 0) or (Node.SelectedIndex >= Images.Count) then
Index := Node.ImageIndex
else Index := Node.SelectedIndex;
Style:=
DrawSelected[((Node.Selected and (DropTarget = nil)) or Node.DropTarget) and (TImageList(Images).BlendColor <> clNone)
and not IsRowSelect];
if Node.Cut then
begin
Style:= Style or ILD_BLEND50;
BlendColor:= clWhite;
end
else begin
BlendColor:= ColorToRGB(TImageList(Images).BlendColor);
end;
if Node.OverlayIndex>=0 then
Style:= Style or UINT(IndexToOverlayMask(Node.OverlayIndex+1));
ImageList_DrawEx(Images.Handle, Index, Canvas.Handle,
x, r.Top + (r.Bottom - r.Top - TImageList(Images).Height) div 2, 0, 0,
CLR_NONE, BlendColor, Style);
end;
if UseStateImages(Node) then
begin
if (not CheckboxNeeded(Node as TfcTreeNode)) then
StateImages.Draw(Canvas, r.right, r.Top + (r.Bottom-r.Top-TImageList(StateImages).Height) div 2, Node.StateIndex)
// StateImages.Draw(Canvas, r.Right, r.Top, Node.StateIndex)
else begin
cp:= GetCenterPoint(r);
Offset:= ((fcRectHeight(r) div 2) div 2)+2;
Offset:= fcMin(Offset, MaxCheckboxSize);
if Node.CheckboxType=tvctRadioGroup then
begin
ARect:= Rect(r.right+1, cp.y-offset, r.Right + 2*offset+2, cp.y+offset+1);
if fcUseThemes(self) then
begin
{$ifdef fcUseThemeManager}
CheckboxStyle:= GetRadioButtonThemeStyle(False);
Details := ThemeServices.GetElementDetails(CheckboxStyle);
PaintRect := ARect;
ThemeServices.DrawElement(Canvas.Handle, Details, PaintRect);
PaintRect := ThemeServices.ContentRect(Canvas.Handle, Details, PaintRect);
{$endif}
end
else begin
DrawFrameControl(Canvas.Handle, Rect(r.right+1, cp.y-offset, r.Right + 2*offset+2, cp.y+offset+1),
DFC_BUTTON,
Grayed[Node.Grayed] or
DFCS_BUTTONRADIO or CheckBoxFlat[tvoFlatCheckBoxes in Options] or ItemChecked[Node.checked])
end
end
else begin
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.Grayed then
begin
if Node.checked then CheckboxStyle:= tbCheckboxCheckedDisabled
else CheckboxStyle:= tbCheckboxUnCheckedDisabled
end
else begin
if IsHotRadioOrCheckBox then
begin
if Node.checked then CheckboxStyle:= tbCheckboxCheckedHot
else CheckboxStyle:= tbCheckboxUnCheckedHot
end
else begin
if Node.checked then CheckboxStyle:= tbCheckboxCheckedNormal
else CheckboxStyle:= tbCheckboxUnCheckedNormal
end;
end;
Details := ThemeServices.GetElementDetails(CheckboxStyle);
PaintRect := ARect;
ThemeServices.DrawElement(Canvas.Handle, Details, PaintRect);
PaintRect := ThemeServices.ContentRect(Canvas.Handle, Details, PaintRect);
{$endif}
end
else begin
DrawFrameControl(Canvas.Handle, ARect,
DFC_BUTTON, Grayed[Node.Grayed] or
DFCS_BUTTONCHECK or CheckBoxFlat[tvoFlatCheckBoxes in Options]
or ItemChecked[Node.checked])
end
end
end;
end;
end;
procedure TfcCustomTreeView.SetOptions(Value: TfcTreeViewOptions);
const TVS_FULLROWSELECT = $1000;
TVS_TRACKSELECT = $0200;
var ChangedOptions: TfcTreeViewOptions;
begin
if not HandleAllocated then begin
FOptions := Value;
exit;
end;
if Value <> FOptions then
begin
ChangedOptions := (FOptions + Value) - (FOptions * Value);
if tvoRowSelect in ChangedOptions then
SetComCtlStyle(Self, TVS_FULLROWSELECT, tvoRowSelect in Value);
if tvoShowRoot in ChangedOptions then
SetComCtlStyle(Self, TVS_LINESATROOT, tvoShowRoot in Value);
if tvoShowLines in ChangedOptions then
SetComCtlStyle(Self, TVS_HASLINES, tvoShowLines in Value);
if tvoShowButtons in ChangedOptions then
SetComCtlStyle(Self, TVS_HASBUTTONS, tvoShowButtons in Value);
if tvoHideSelection in ChangedOptions then
SetComCtlStyle(Self, TVS_SHOWSELALWAYS, not (tvoHideSelection in Value));
if tvoHotTrack in ChangedOptions then
SetComCtlStyle(Self, TVS_TRACKSELECT, tvoHotTrack in Value);
if tvoEditText in ChangedOptions then
SetComCtlStyle(Self, TVS_EDITLABELS, tvoEditText in Value);
FOptions := Value;
Invalidate;
end;
end;
Function TfcCustomTreeView.MultiSelectCheckboxNeeded(Node: TfcTreeNode): boolean;
begin
if Node=nil then result:= False
else with FMultiSelectAttributes do
result:= Enabled and MultiSelectCheckbox and (ValidMultiSelectLevel(Node.Level))
end;
Function TfcCustomTreeView.CheckboxNeeded(Node: TfcTreeNode): boolean;
begin
result:= MultiSelectCheckBoxNeeded(Node) or
(TfcTreeNode(Node).CheckboxType<>tvctNone);
end;
function TfcCustomTreeView.UseImages(Node: TfcTreeNode): Boolean;
begin
result:= (Images<>nil) and (Node.ImageIndex<>-2);
end;
function TfcCustomTreeView.UseStateImages(Node: TfcTreeNode): Boolean;
begin
{ 3/8/99 - Don't allow StateIndex to be multiple of 16,
as the Microsoft TreeView control ignores these state images }
result := ((StateImages <> nil) and
(Node.StateIndex>=1) and ((Node.StateIndex mod 16)<>0)) and
// result := ((StateImages <> nil) and (Node.StateIndex >= 1) and
(Node.StateIndex < StateImages.Count);
if MultiSelectCheckBoxNeeded(Node) then result:= True
else if ((Node as TfcTreeNode).CheckboxType<>tvctNone) and (Node.StateIndex>=1) then
result:= True;
end;
function TfcCustomTreeView.GetItemHeight: ShortInt;
begin
result := TreeView_GetItemHeight(Handle);
end;
procedure TfcCustomTreeView.SetItemHeight(Value: ShortInt);
begin
TreeView_SetItemHeight(Handle, Value);
end;
procedure TfcCustomTreeView.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var Node: TfcTreeNode;
begin
inherited MouseUp(Button, Shift, X, Y);
Node:= nil; { Make compiler happy}
if Assigned(FOnMouseUp) or (tvoAutoURL in Options) then
Node:= GetNodeAt(X, Y) as TfcTreeNode;
if Assigned(FOnMouseUp) then
FOnMouseUp(self, Node, Button, Shift, X, Y);
if tvoAutoURL in Options then
begin
if (Button = mbLeft) and (Node<>nil) and (Node.StringData<>'') and
(fchtOnItem in GetHitTestInfoAt(x,y)) then
begin
Screen.Cursor:= crHourGlass;
ShellExecute(Handle, 'OPEN', PChar(Node.StringData), nil, nil, sw_shownormal);
Screen.Cursor:= crDefault; { 10/30/98 - Restore to default cursor }
end
end
end;
procedure TfcCustomTreeView.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var Node, CurNode, LastNode: TfcTreeNode;
hitTest: TfcHitTests;
Function SameLevelShiftSelect: boolean;
begin
{ if FMultiSelectAttributes.MultiSelectLevel=-1 then begin
result:= True;
exit;
end;}
result:=
(ssShift in Shift) and
(LastSelectedNode<>Nil) and (LastSelectedNode.parent=Node.parent);
end;
begin
inherited MouseDown(Button, Shift, X, Y);
Node:= GetNodeAt(X, Y) as TfcTreeNode;
if Assigned(FOnMouseDown) then FOnMouseDown(self, Node, Button, Shift, X, Y);
if (ssDouble in Shift) and Assigned(FOnDblClick) then FOnDblClick(self, Node, Button, Shift, X, Y);
if Node=Nil then exit;
hitTest:= GetHitTestInfoAt(X, Y);
if (ssDouble in Shift) and (Button = mbLeft) then
begin
Exit;
end;
{ 11/12/99 - If right mouse button, then exit so multi-selected records are not unselected }
if (not RightClickSelects) and (ssRight in Shift) then exit;
if Node=BeforeMouseDownNode then { Bring up edit control }
begin
if (fchtOnLabel in hittest) and (tvoEditText in Options) then
begin
FreeHintWindow;
LastHintNode:= nil;
If (Node<>Nil) and (Images<>Nil) and
(Node.imageindex=-2) then
SendMessage(Handle, TVM_EDITLABEL, 0, integer(node.ItemID));
end;
end;
if (Node=ClickedNode) and // 1/21/01 - Selection changes so skip toggle checkbox
(fchtOnStateIcon in hitTest) and CheckboxNeeded(Node) and (not ReadOnly) then
begin
if Node.IsRadioGroup then begin
Node.Grayed:= False;
Node.checked:= True;
end
else begin
if (tvo3StateCheckbox in Options) and
Node.checked and (not Node.Grayed) then Node.Grayed:= True
else begin
Node.checked:= not Node.checked;
if (tvo3StateCheckbox in Options) or
not (csDesigning in ComponentState) then
Node.Grayed:= False;
end;
end;
exit;
end;
if FMultiSelectAttributes.Enabled and
((IsRowSelect and (X >= LevelRect(Node).Left + FIndent)) or // -ksw (Added to make behavior more
(not IsRowSelect and (hitTest * [fchtOnItem, fchtOnLabel] <> []))) then // consistent in non-databound cases)
begin
if (not (ssCtrl in Shift)) and MultiSelectAttributes.AutoUnselect then
begin
if SameLevelShiftSelect then UnselectAllNodes(LastSelectedNode)
else if ValidMultiSelectLevel(Node.Level) then UnselectAllNodes(nil);
end;
if (ssShift in Shift) then begin
if SamelevelShiftSelect then begin
if Node.index>LastSelectedNode.index then begin
curNode:= LastSelectedNode;
LastNode:= Node;
if not MultiSelectAttributes.AutoUnselect and
(LastSelectedNode<>nil) then
MultiSelectNode(LastSelectedNode, True, True);
while curNode<>LastNode do begin
curNode:= curNode.GetNextSibling as TfcTreeNode;
if curNode=Nil then break;
MultiSelectNode(curNode, True, True);
end;
end
else begin
curNode:= Node;
LastNode:= LastSelectedNode;
while curNode<>LastNode do begin
MultiSelectNode(curNode, True, True);
curNode:= curNode.GetNextSibling as TfcTreeNode;
if curNode=Nil then break;
end;
if not MultiSelectAttributes.AutoUnselect and
(curNode=LastNode) and (curNode<>nil) then
MultiSelectNode(curNode, True, True);
end;
if not node.selected then node.selected:= True;
end
end
else begin
if Node<>nil then
with Node as TfcTreeNode do begin
if MultiSelectAttributes.AutoUnselect or (ssCtrl in Shift) then
MultiSelectNode(Node, not FMultiSelected, True);
if not node.selected then node.selected:= True;
end;
end;
end;
if MultiSelectAttributes.enabled and not (ssShift in Shift) then
LastSelectedNode:= Node;
end;
procedure TfcCustomTreeView.WMDestroy(var Message: TWMDestroy);
begin
if Items<>Nil then Items.Clear; { Faster to call special clear code than to just destroy }
inherited;
end;
procedure TfcCustomTreeView.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
if not (tvoExpandOnDblClk in FOptions) then
begin
with Message do begin { 6/23/99 - Fires OnDblClick event }
MouseDown(mbLeft, KeysToShiftState(Keys) + [ssDouble], XPos, YPos);
end
end
else inherited;
end;
function TfcCustomTreeView.GetScrollTime: Integer;
begin
result := TreeView_GetScrollTime(Handle);
end;
procedure TfcCustomTreeView.SetScrollTime(Value: Integer);
begin
TreeView_SetScrollTime(Handle, Value);
end;
{ Prevents flicker when changing selected node }
procedure TfcCustomTreeView.WMPaint(var Message: TWMPaint);
var
DC, MemDC: HDC;
MemBitmap, OldBitmap: HBITMAP;
PS: TPaintStruct;
PaintCliprect: TRect;
UpdateRect: TRect;
OldSkipErase: boolean;
begin
// 1/31/2002-Call inherited if nodes are in beginupdate/endupdate.
if items.fupdatecount>0 then
begin
inherited;
exit;
end;
windows.GetUpdateRect(Handle, UpdateRect, false);
{ if not UseAlternateBuffering then
begin
inherited;
exit;
end;
}
PaintClipRect:= FCanvas.ClipRect;
if PaintClipRect.Right>ClientRect.Right then
PaintClipRect.Right:= ClientRect.Right;
if UpdateRect.Bottom>ClientRect.Bottom then
UpdateRect.Bottom:= (inherited GetClientRect).Bottom;
if (UpdateRect.Top=0) and (UpdateRect.Bottom=0) and
(UpdateRect.Left=0) and (UpdateRect.Right=0) then
UpdateRect:= PaintClipRect;
OldSkipErase:= SkipErase;
if Items.Count>0 then SkipErase:= True;
if (Message.DC <> 0) then
begin
if not (csCustomPaint in ControlState) and (ControlCount = 0) then
inherited
else
PaintHandler(Message);
end
else begin
DC := GetDC(0);
MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, inherited GetClientRect.Bottom);
ReleaseDC(0, DC);
MemDC := CreateCompatibleDC(0);
OldBitmap := SelectObject(MemDC, MemBitmap);
try
DC := BeginPaint(Handle, PS);
Message.DC := MemDC;
if not (csCustomPaint in ControlState) and (ControlCount = 0) then
inherited
else
PaintHandler(Message);
Message.DC := 0;
// BitBlt(DC, 0, 0, ClientRect.Right, ClientRect.Bottom, MemDC, 0, 0, SRCCOPY);
BitBlt(DC, UpdateRect.Left, UpdateRect.Top, UpdateRect.Right, UpdateRect.Bottom, MemDC, UpdateRect.Left, UpdateRect.top, SRCCOPY);
EndPaint(Handle, PS);
finally
SelectObject(MemDC, OldBitmap);
DeleteDC(MemDC);
DeleteObject(MemBitmap);
end;
end;
SkipErase:= OldSkipErase;
end;
{
procedure TfcCustomTreeView.WMPaint(var Message: TWMPaint);
var OldSkipErase: boolean;
begin
OldSkipErase:= SkipErase;
if UsePaintBuffering and (Items.Count>0) then SkipErase:= True;
inherited;
SkipErase:= OldSkipErase;
end;
}
function TfcTreeNodes.FindNodeInfo(SearchText: string; VisibleOnly: Boolean;
StoreDataUsing: TwwStoreData = sdStoreText): TfcTreeNode;
var Node: TfcTreeNode;
tempText: string;
begin
result := nil;
Node := GetFirstNode;
while Node <> nil do
begin
case StoreDataUsing of
sdStoreText: tempText:= Node.Text;
sdStoreData1: tempText:= Node.StringData;
sdStoreData2: tempText:= Node.StringData2;
end;
if UpperCase(tempText) = UpperCase(SearchText) then
begin
result := Node;
Exit;
end;
if VisibleOnly then Node := Node.GetNextVisible
else Node := Node.GetNext;
end;
end;
function TfcTreeNodes.FindNode(SearchText: string; VisibleOnly: Boolean): TfcTreeNode;
var Node: TfcTreeNode;
begin
result := nil;
Node := GetFirstNode;
while Node <> nil do
begin
if UpperCase(Node.Text) = UpperCase(SearchText) then
begin
result := Node;
Exit;
end;
if VisibleOnly then Node := Node.GetNextVisible
else Node := Node.GetNext;
end;
end;
procedure TfcCustomTreeView.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
if SkipErase then begin
Message.result:= 1;
exit;
end
else inherited;
end;
function TfcCustomTreeView.GetMultiSelectItem(Index: integer): TfcTreeNode;
begin
result:= TfcTreeNode(FMultiSelectList[Index]);
end;
function TfcCustomTreeView.GetMultiSelectListCount: integer;
begin
result:= FMultiSelectList.Count;
end;
procedure TfcCustomTreeView.ClearStateImageIndexes;
var CurNode: TfcTreeNode;
begin
{ Clear image index for all siblings of MultiSelectLevel}
CurNode := FTreeNodes.GetFirstNode;
while curNode<>Nil do begin
if (MultiSelectAttributes.MultiSelectCheckbox=False) then begin
if ((curNode.Level = MultiSelectAttributes.MultiSelectLevel) or
(MultiSelectAttributes.MultiSelectLevel=-1)) then
begin
curNode.checked:= False;
curNode.StateIndex:= -1;
end
end
else begin
if ((curNode.Level <> MultiSelectAttributes.MultiSelectLevel) and
(MultiSelectAttributes.MultiSelectLevel<>-1)) then
begin
curNode.checked:= False;
curNode.StateIndex:= -1;
end
end;
curNode:= TfcTreeNode(curNode.GetNext);
end;
end;
procedure TfcCustomTreeView.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited;
if (Key=32) and (Selected<>nil) and (EditNode=nil) then begin
with MultiSelectAttributes do begin
if Enabled and (not MultiSelectCheckbox) and
(ValidMultiSelectLevel(Selected.Level)) then
begin
if (ssCtrl in Shift) then
Selected.MultiSelected:= not Selected.MultiSelected;
exit;
end
end;
if (not ReadOnly) then
begin
if Selected.IsRadioGroup then begin
if not (csDesigning in ComponentState) then Selected.Grayed:= False;
Selected.checked:= True;
end
else begin
if (tvo3StateCheckbox in Options) and
Selected.checked and (not Selected.Grayed) then Selected.Grayed:= True
else begin
Selected.checked:= not Selected.checked;
if (tvo3StateCheckbox in Options) or
not (csDesigning in ComponentState) then
Selected.Grayed:= False;
end
end;
end;
Key:= 0;
end;
end;
procedure TfcCustomTreeview.KeyPress(var Key: Char);
begin
inherited;
end;
procedure TfcTreeNode.Invalidate;
var r: TRect;
begin
r := DisplayRect(False);
InvalidateRect(TreeView.Handle, @r, False);
end;
procedure TfcCustomTreeView.MouseLoop(X, Y: Integer);
var ACursor: TPoint;
Msg: TMsg;
Function InButton(ACursorPos: TPoint): boolean;
var sp: TPoint;
MouseRect: TRect;
begin
sp:= ScreenToClient(ACursorPos);
MouseRect:= MouseNode.DisplayRect(False);
Result:= (fchtOnButton in GetHitTestInfoAt(sp.x, sp.y)) and { 2/2/99 }
(sp.y>=MouseRect.Top) and (sp.y<=MouseRect.Bottom);
end;
procedure MouseLoop_MouseMove(X, Y: Integer; ACursorPos: TPoint);
begin
Down:= InButton(ACursorPos);
if not Down then
begin
Down:= InButton(ACursorPos);
InvalidateNode(MouseNode)
end
else
InvalidateNode(MouseNode)
end;
procedure MouseLoop_MouseUp(X, Y: Integer; ACursorPos: TPoint);
var IsMouseInControl: Boolean;
begin
IsMouseInControl:= InButton(ACursorPos);
Down:= False;
InvalidateNode(MouseNode);
if IsMouseInControl then
begin
if MouseNode.expanded then begin
if AutoExpand then Selected:= MouseNode; { 4/13/99 - Otherwise it expands again after auto-collapsing }
MouseNode.Collapse(False);
end
else MouseNode.Expand(False);
end
end;
begin
Down:= True;
InvalidateNode(MouseNode); { 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;
end;
end;
procedure TfcCustomTreeView.SetLineColor(Value: TColor);
begin
if FLineColor <> Value then
begin
FLineColor:= Value;
Invalidate;
end;
end;
procedure TfcCustomTreeView.SetInactiveFocusColor(Value: TColor);
begin
if FInactiveFocusColor <> Value then
begin
FInactiveFocusColor:= Value;
Invalidate;
end;
end;
procedure TfcCustomTreeView.CMExit(var Message: TMessage);
var firstNode: TfcTreeNode;
begin
inherited;
{ If exactly one node then invalidate }
firstNode:= Items.GetFirstNode;
if (firstNode<>nil) and (firstNode.GetNextSibling=nil) then InvalidateNode(firstNode);
end;
procedure TfcCustomTreeView.MouseMove(Shift: TShiftState; X, Y: Integer);
var Node: TfcTreeNode;
HitTest: TfcHitTests;
Function GetEffectiveWidth: integer;
begin
Result:= ClientRect.Right - ClientRect.Left - 4;
end;
procedure ProcessToolTips;
var SP: TPoint;
R, DisplayRect: TRect;
begin
if ((EditNode<>Node) or (EditNode=Nil)) and
(LastHintNode<>Node) and (Node<>nil) then
begin
FreeHintWindow;
HintTimer.Free;
HintTimer:= nil;
sp:= self.ClientToScreen(Point(0, 0));
DisplayRect:= Node.DisplayRect(True);
R.Left:= DisplayRect.Left + sp.x - 1;
R.Top:= DisplayRect.Top + sp.y - 2;
R.Right:= R.Left + Canvas.TextWidth(Node.Text) + 6;
R.Bottom:= R.Top + Canvas.TextHeight(Node.Text) + 2;
if DisplayRect.Left+Canvas.TextWidth(Node.Text)>
GetEffectiveWidth then
begin
HintTimer:= TTimer.create(self);
HintTimer.OnTimer:=HintTimerEvent;
HintTimer.Interval:=250;
HintTimer.Enabled:= True;
LastHintNode:= Node;
HintWindow:= CreateHintWindow(Node);
with HintWindow do begin
if (Node.StringData<>'') and (tvoAutoURL in Options) then
begin
Canvas.Font.Color:= GetSysColor(clBlue);
Canvas.Font.Style:=
Canvas.Font.Style + [fsUnderline];
end;
ActivateHint(R, Node.Text);
end
end
else LastHintNode:= nil;
end
end;
begin
inherited MouseMove(Shift, X, Y);
if Assigned(FOnMouseUp) or (tvoAutoURL in Options) or (tvoToolTips in Options) or
fcUseThemes(self) then
Node:= GetNodeAt(X, Y) as TfcTreeNode;
if Assigned(FOnMouseMove) then
FOnMouseMove(self, Node, Shift, X, Y);
if fcUseThemes(self) then
begin
HitTest:= GetHitTestInfoAt(x,y);
if (Node<>LastMouseMoveNode) or (LastMouseHitTest<>HitTest) then
begin
if (Node<>nil) and (Node.checkboxtype<>tvctNone) then
Node.invalidate;
if (LastMouseMoveNode<>nil) then // 6/30/03
LastMouseMoveNode.invalidate;
end;
LastMouseMoveNode:= Node;
LastMouseHitTest:= HitTest;
end;
if tvoAutoURL in Options then
begin
if (Node<>Nil) and (Node.StringData<>'') and
(fchtOnItem in GetHitTestInfoAt(x,y)) then
Cursor:= crHandPoint
else
Cursor:= crDefault;
end;
if tvoToolTips in Options then ProcessToolTips;
end;
type
TfcTreeHintWindow=class(THintWindow)
protected
procedure Paint; override;
public
Node: TfcTreeNode;
end;
procedure TfcTreeHintWindow.Paint;
var
R: TRect;
begin
R := ClientRect;
Inc(R.Left, 2);
Inc(R.Top, 2);
if (Node.StringData<>'') and (tvoAutoURL in Node.TreeView.Options) then
begin
Canvas.Font.Color:= clBlue;
Canvas.Font.Style:=
Canvas.Font.Style + [fsUnderline];
end
else begin
Canvas.Font.Color := clInfoText;
end;
SetBkMode(Canvas.Handle, TRANSPARENT);
DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_LEFT or DT_NOPREFIX or
DT_WORDBREAK);
end;
Function TfcCustomTreeView.CreateHintWindow(Node: TfcTreeNode): THintWindow;
begin
HintWindow:= TfcTreeHintWindow.create(self);
TfcTreeHintWindow(HintWindow).Node:= Node;
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;
procedure TfcCustomTreeView.FreeHintWindow;
begin
HintTimerCount:= 0;
HintWindow.Free;
HintWindow:= nil;
if HintTimer<>nil then
HintTimer.enabled:= False;
end;
procedure TfcCustomTreeView.HintTimerEvent(Sender: TObject);
var
sp, cp: TPoint;
OutsideClient: boolean;
begin
if not (HintWindow<>nil) then exit;
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;
{ Process Hint Timer clean-up}
if OutsideClient then
begin
FreeHintWindow;
LastHintNode:= nil;
end
else begin
inc(HintTimerCount);
if HintTimerCount>16 then
begin
FreeHintWindow;
end
end
end;
procedure TfcCustomTreeView.CMDesignHitTest(var Message: TCMDesignHitTest);
//var HitTest: TfcHitTests;
begin
{ HitTest:= GetHitTestInfoAt(Message.xPos, Message.yPos);
if fchtToRight in HitTest then begin
Message.Result:= 1;
end
else }inherited;
end;
procedure TfcCustomTreeView.InvalidateNoErase;
begin
InvalidateRect(Handle, nil, False);
end;
procedure TfcCustomTreeView.WMNCHitTest(var Message: TWMNCHitTest);
begin
DefaultHandler(Message);
end;
function TfcCustomTreeView.GetPaintCanvas: TfcCanvas;
begin
// if UsePaintBuffering then
// result:= FPaintCanvas
// else
result:= FCanvas;
end;
end.