fctreecombo.pas

一套及时通讯的原码

  if TfcCustomTreeView(TreeView).StreamVersion=0 then inherited;
end;

procedure TfcTreeComboTreeNode.WriteData(Stream: TStream; Info: PfcNodeInfo);
var BoolProps: TStringList;
    i: Integer;
    CurBool: Boolean;
    Count: Integer;
begin
  inherited;
  BoolProps := TStringList.Create;
  fcGetBooleanProps(self, BoolProps);
  Count := BoolProps.Count;
  Stream.WriteBuffer(Count, SizeOf(Count));
  for i := 0 to Count - 1 do
  begin
    CurBool := Boolean(fcGetOrdProp(self, BoolProps[i]));
    Stream.WriteBuffer(CurBool, SizeOf(CurBool));
  end;
  BoolProps.Free;
end;

constructor TfcPopupTreeView.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle + [csReplicatable];

  FCheckChange := False;
  NodeClass := TfcTreeComboTreeNode;
  FCloseOnUp := True;

  Options:= [tvoShowButtons, tvoShowRoot,
             tvoShowLines, tvoHideSelection, tvoToolTips];

end;

// Added so that PageDown/PageUp works properly with the Selectable property
// of the TfcTreeComboTreeNode.

function TfcPopupTreeView.MovePage(Node: TfcTreeNode; Down: Boolean): TfcTreeNode;
var ItemsPerPage: Integer;
    i: Integer;
begin
  result := nil;
  ItemsPerPage := (Height div ItemHeight) + 1;
  for i := 0 to ItemsPerPage - 1 do
  begin
    if Node = nil then Break;
    result := Node;
    if Down then Node := Node.GetNextVisible
    else Node := Node.GetPrevVisible;
  end;
  if Node <> nil then result := Node;
end;

function TfcPopupTreeView.GetLastVisible: TfcTreeNode;
var Node: TfcTreeNode;
begin
  result := nil;
  Node := Items.GetFirstNode;
  while Node <> nil do
  begin
    result := Node;
    Node := Node.GetNextVisible;
  end;
end;

// 4/10/99 - PYW - Get last node regardless of whether or not it is visible.
function TfcPopupTreeView.GetLastNode: TfcTreeNode;
var Node: TfcTreeNode;
begin
  result := nil;
  Node := Items.GetFirstNode;
  while Node <> nil do
  begin
    result := Node;
    Node := Node.GetNext;
  end;
end;


// Support methods for the Selectable property of the TfcTreeComboTreeNode.
function TfcPopupTreeView.ValidNode(Node: TfcTreeNode): Boolean;
begin
  if (TreeCombo <> nil) and (icoEndNodesOnly in TreeCombo.Options) then result := Node.Count = 0
  else result := True;

  if not TfcTreeComboTreeNode(Node).Selectable then result := False;

end;

function TfcPopupTreeView.SelectValidNode(StartingNode, SelectedNode: TfcTreeNode; Key: Word): Boolean;
begin
  result := False;
  if StartingNode = nil then
  begin
    StartingNode := Items.GetFirstNode;
    if not (Key in [VK_NEXT, VK_END]) then Key := 0;
  end;

  if (SelectedNode <> nil) and (SelectedNode = Selected) then
  begin
    Selected := StartingNode;
    Exit;
  end;

  if SelectedNode = nil then SelectedNode := StartingNode;

{ if Key in [vk_up, vk_down, vk_prior, vk_next, vk_home, vk_end] then
  begin
     if EditCanModify then begin
        SetModified(True);
     end
     else exit;
  end;
}

  if (TreeCombo.isDroppedDown) then begin
    case Key of
      VK_UP: SelectedNode := SelectedNode.GetPrevVisible;
      VK_DOWN: SelectedNode := SelectedNode.GetNextVisible;
      VK_PRIOR: SelectedNode := MovePage(SelectedNode, False);
      VK_NEXT: SelectedNode := MovePage(SelectedNode, True);
      VK_HOME: SelectedNode := Items.GetFirstNode;
      VK_END: SelectedNode := GetLastVisible;
    end;
  end
  else begin // 4/10/99 - PYW - When closed up ignore visible when getting the new node.
    case Key of
      VK_UP: SelectedNode := SelectedNode.GetPrev;
      VK_DOWN: SelectedNode := SelectedNode.GetNext;
      VK_PRIOR: SelectedNode := MovePage(SelectedNode, False);
      VK_NEXT: SelectedNode := MovePage(SelectedNode, True);
      VK_HOME: SelectedNode := Items.GetFirstNode;
      VK_END: SelectedNode := GetLastNode;
    end;
  end;

  if SelectedNode = nil then Exit;
  if not TreeCombo.IsValidNode(SelectedNode) then
  begin
    if Key in [VK_UP, VK_PRIOR, VK_END] then Key := VK_UP else Key := VK_DOWN;
    SelectValidNode(StartingNode, SelectedNode, Key);
  end else Selected := SelectedNode;
  result := True;
end;

procedure TfcPopupTreeView.WMLButtonDown(var Message: TWMLButtonDown);
var HitTest: TfcHitTests;
    Node: TfcTreeNode;
begin
  FClickedInControl := True;
  if TreeCombo <> nil then TreeCombo.CheckCancelMode;

  FCloseOnUp := False;
  if PtInRect(Rect(0, 0, ClientWidth, ClientHeight), Point(Message.XPos, Message.YPos)) then
    FCloseOnUp := True;

  HitTest := GetHitTestInfoAt(Message.XPos, Message.YPos);
  if fchtOnButton in HitTest then
  begin
    FCloseOnUp := False;
    Node := GetNodeAt(Message.XPos, Message.YPos);
    if Node <> nil then
    begin
      if Node.Expanded then Node.Collapse(False) else Node.Expand(False);
    end;
  end
  else if fchtOnStateIcon in HitTest then begin { 1/31/2000 - Supports checkbox/radiobutton }
     Node := GetNodeAt(Message.XPos, Message.YPos);
     if Node <> nil then begin
       if Node.CheckBoxType=tvctCheckBox then
          node.checked:= not node.checked
       else if Node.CheckBoxType=tvctRadioGroup then
          node.checked:= true;
     end
  end
end;

procedure TfcPopupTreeView.WMTimer(var Message: TWMTimer);
var p: TPoint;
begin
  inherited;
  if GetKeyState(VK_LBUTTON) >= 0 then
  begin
    if TreeCombo <> nil then TreeCombo.CloseUp(True);
    Exit;
  end;
  if Selected = nil then Exit;

  GetCursorPos(p);
  with ClientToScreen(Point(0, 0)) do
  begin
    if p.y < y then SelectValidNode(Selected, nil, VK_UP)
    else if p.y > y + Height then SelectValidNode(Selected, nil, VK_DOWN);
  end;
end;

procedure TfcPopupTreeView.Collapse(Node: TfcTreeNode);
begin
   inherited;
   if (TreeCombo<>nil) and (icoEndNodesOnly in TreeCombo.Options) then
      Selected:= nil;
end;

// Support hot-tracking of the iten in the drop-down treeview.

procedure TfcPopupTreeView.MouseMove(Shift: TShiftState; X, Y: Integer);
var Node: TfcTreeNode;
    p: TPoint;
    Msg: TWMTimer;
begin
  inherited;
  if TreeCombo.EffectiveReadOnly then Exit;  // Prevent hot-tracking when readonly
  if ((FLastPoint.x = x) and (FLastPoint.y = y)) or ((FLastPoint.x = -1) and (FLastPoint.y = -1)) then
  begin
    FLastPoint := Point(x, y);
    Exit;
  end;

  Node := GetNodeAt(X, Y);
  if (Node <> nil) and TreeCombo.IsValidNode(Node) then Selected := Node;

  // Allow mouse to move selection down or up past window
  if (TreeCombo <> nil) and (GetKeyState(VK_LBUTTON) < 0) then
  begin
    GetCursorPos(p);
    with ClientToScreen(Point(0, 0)) do
    begin
      FillChar(Msg, SizeOf(Msg), 0);
      if (p.y < y - TreeCombo.Height) or (p.y > y + Height) then
      begin
        WMTimer(Msg);
        SetTimer;
      end{ else
        KillTimer; 4/5/99 - Leave timer on until MouseUP or CloseUp}
    end;
  end;
  FLastPoint := Point(x, y);
end;

procedure TfcPopupTreeView.MouseUp(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var hittest: TfcHitTests;
    ClickedNode: TfcTreeNode;
begin
  if (TreeCombo <> nil) and (Button = mbLeft) and FCloseOnUp and
     (FClickedInControl or PtInRect(ClientRect, Point(X, Y))) then
  begin
    hitTest:= GetHitTestInfoAt(X, Y);
    if ([fchtOnButton,fchtOnStateIcon] * hittest=[]) then begin { 4/5/99 - RSW }
       ClickedNode:= GetNodeAt(X, Y);
       if (ClickedNode<>nil) and TreeCombo.IsValidNode(ClickedNode) then begin
         TreeCombo.FSelectedNode:= Selected; { RSW }
         TreeCombo.CloseUp(PtInRect(ClientRect, Point(X, Y)));
       end
    end
  end;
  KillTimer;
  FCloseOnUp := True;
end;

procedure TfcPopupTreeView.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_LBUTTONDBLCLK, WM_RBUTTONDOWN, WM_RBUTTONDBLCLK: ;
  else
    inherited;
  end;
end;

procedure TfcPopupTreeView.WMMouseActivate(var Message: TMessage);
begin
  Message.Result := MA_NOACTIVATE;
end;

procedure TfcPopupTreeView.CalcNodeAttributes(Node: TfcTreeNode; AItemState: TfcItemStates);
begin
  if Node.Selected then
  begin
    Canvas.Brush.Color := clHighlight;
    Canvas.Font.Color := clHighlightText;
  end;
  inherited;
end;

procedure TfcPopupTreeView.Change(Node: TfcTreeNode);
begin
  inherited;
  if (TreeCombo <> nil) and FCheckChange and (Selected <> nil) then
  begin
    TreeCombo.FSelectedNode:= Selected; { RSW }
    TreeCombo.Text := Selected.Text;
  end;
end;

procedure TfcPopupTreeView.SetTimer;
begin
  Windows.SetTimer(Handle, FCPOPUPTIMERID, FCPOPUPINTERVAL, nil);
  FTimerOn := True;
end;

procedure TfcPopupTreeView.KillTimer;
begin
  if HandleAllocated then Windows.KillTimer(Handle, FCPOPUPTIMERID);
  FTimerOn := False;
end;

constructor TfcCustomTreeCombo.Create(AOwner: TComponent);
begin
  inherited;
  ButtonStyle := cbsDownArrow;
  ShowMatchText := True;
  FOptions := [icoExpanded];

//  FAlignmentVertical := fcavTop; { RSW - Used to be fcavCenter }

  FPanel := TfcPopupPanel.Create(self);
  FPanel.Visible := False;

  FTreeView := CreatePopupTreeView;
  FTreeView.FTreeCombo := self;
  with FTreeView do
  begin
    BorderStyle := bsNone;
    Parent := FPanel;
    Visible := True;
    Align := alClient;
    OnItemChange := ItemsChange;
  end;

  FItemsList := TStringList.Create;
  LastItemIndex:= -1;
  LastItemText:='';
  FStoreDataUsing:= sdStoreText;
end;

destructor TfcCustomTreeCombo.Destroy;
begin
  FItemsList.Free;

  inherited;
end;

function TfcCustomTreeCombo.CreatePopupTreeView: TfcPopupTreeView;
begin
  result := TfcPopupTreeView.Create(self);
end;

function TfcCustomTreeCombo.GetStartingNode: TfcTreeNode;
begin
  result := TreeView.Items.GetFirstNode;
end;

procedure TfcCustomTreeCombo.InvalidateImage;
var r: TRect;
begin
  if not HandleAllocated then exit;

  { RSW - Clear image area }
  r:= GetEditRect;
  r:= Rect(1, 1, r.left-1, Height-1);
  InvalidateRect(Handle, @r, True);
end;

procedure TfcCustomTreeCombo.Change;
begin
  if SetModifiedInChangeEvent then modified:=true; // 7/31/00
  inherited;

  if (TreeView.Selected = nil) or (TreeView.Selected.Text <> Text) then
     InvalidateImage;
end;

procedure TfcCustomTreeCombo.ItemsChange(TreeView: TfcCustomTreeView; Node: TfcTreeNode;
  Action: TfcItemChangeAction; NewValue: Variant);
var Index: Integer;
begin
  if csDestroying in ComponentState then Exit;

  if Action<>icaAdd then
  begin
     if (LastItemIndex<>-1) and (LastItemText=Node.Text) then
     begin
        Index:= LastItemIndex;
     end
     else
        Index := FItemsList.IndexOf(Node.Text + '=' + InttoStr(Node.ImageIndex))
  end
  else begin
     FItemsList.Add(Node.Text + '=' + InttoStr(Node.ImageIndex));
     LastItemIndex:= FItemsList.count-1;