etreeview.pas

EasyGasDpr 瓶装液化气 钢瓶 SQL,用户名：SYSTEM 密码：空

end;

procedure TCheckTreeView.SetFlatness(const Value: TCheckFlatness);
var
  I                 : Integer;
begin
  if FFlatness <> Value then
  begin
    FFlatness := Value;
    for I := 0 to Items.Count - 1 do
      TCheckTreeNode(Items[I]).InternalSetState(
        TCheckTreeNode(Items[I]).GetState, False, False)
  end;
end;

procedure TCheckTreeView.SetKind(Node: TTreeNode; Value: TCheckKind);
begin
  TCheckTreeNode(Node).CheckKind := Value
end;

procedure TCheckTreeView.SetState(Node: TTreeNode; Value: TCheckBoxState);
begin
  TCheckTreeNode(Node).CheckState := Value
end;

procedure TCheckTreeView.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  if not (htOnStateIcon in GetHitTestInfoAt(Message.XPos, Message.YPos)) then
    inherited;
end;

procedure TCheckTreeView.Change(Node: TTreeNode);
begin
  if csDesigning in ComponentState then GetParentForm(Self).Designer.Modified;
  inherited Change(Node);
end;

procedure TCheckTreeView.WMKeyDown(var Message: TWMKeyDown);
begin
  if Message.CharCode = VK_SPACE then
  begin
    ToggleNode(TCheckTreeNode(Selected));
    Message.Result := 0;
  end
  else
    inherited;
end;

procedure TCheckTreeView.ToggleNode(Node: TCheckTreeNode);
var
  PrevCheck         : TCheckBoxState;
  Frm               : TCustomForm;
begin
  if (Node <> nil) and Node.Enabled then
  begin
    if Node.CheckKind = ckCheck then
    begin
      PrevCheck := Node.GetState;
      if PrevCheck <> cbChecked then
      begin
        Node.InternalSetState(cbChecked);
        if Node.GetState = PrevCheck then Node.InternalSetState(cbUnchecked);
      end
      else
        Node.InternalSetState(cbUnchecked);
    end
    else if Node.CheckKind = ckRadio then
      Node.Checked := True;
    if csDesigning in ComponentState then
    begin
      Frm := GetParentForm(Self);
      if Frm <> nil then
        Frm.Designer.Modified
    end;
  end;
end;

procedure TCheckTreeView.DefineProperties(Filer: TFiler);

  function WriteNodes: Boolean;
  var
    I               : Integer;
    Nodes           : TTreeNodes;
  begin
    Nodes := TTreeNodes(Filer.Ancestor);
    if Nodes = nil then
      Result := Items.Count > 0
    else if Nodes.Count <> Items.Count then
      Result := True
    else
    begin
      Result := False;
      for I := 0 to Items.Count - 1 do
      begin
        Result := not TCheckTreeNode(Items.Item[I]).IsEqual(Nodes[I]);
        if Result then Break;
      end
    end;
  end;

begin
  inherited DefineProperties(Filer);
  Filer.DefineBinaryProperty('CheckNodesData', ReadData, WriteData, WriteNodes);
end;

procedure TCheckTreeView.ReadData(Stream: TStream);
var
  I                 : Integer;
begin
  for I := 0 to Items.Count - 1 do
    TCheckTreeNode(Items[I]).ReadSelf(Stream);
end;

procedure TCheckTreeView.WriteData(Stream: TStream);
var
  I                 : Integer;
begin
  for I := 0 to Items.Count - 1 do
    TCheckTreeNode(Items[I]).WriteSelf(Stream);
end;

procedure TCheckTreeView.CreateParams(var Param: TCreateParams);
begin
  inherited;
  Param.Style :=Param.Style or TVS_CHECKBOXES;
end;

procedure TCheckTreeView.Click;
begin
  inherited;
end;

{ TCheckTreeNode }

const
  StateIndexes      : array[TCheckKind, TCheckBoxState] of Integer =
    ((-1, -1, -1), (1, 2, 3), (4, 5, 4), (-1, -1, -1));

procedure TCheckTreeNode.AfterConstruction;
begin
  FEnabled := True;
  FReflexParent := True;
  FReflexChildren := True;
  FCheckKind := ckCheck;
end;

procedure TCheckTreeNode.Assign(Source: TPersistent);
var
  Node              : TCheckTreeNode;
begin
  inherited Assign(Source);
  if Source is TCheckTreeNode then
  begin
    Node := TCheckTreeNode(Source);
    StateIndex := Node.StateIndex;
    ReflexChildren := Node.ReflexChildren;
    ReflexParent := Node.ReflexParent;
    FCheckKind := Node.CheckKind;
  end;
end;

procedure TCheckTreeNode.DoCheckChildren(Cur: TCheckBoxState);
var
  I                 : Integer;
  MustCheckParent   : Boolean;
  N, D              : TCheckTreeNode;
begin
  MustCheckParent := False;
  D := nil;
  if (FCheckKind in [ckCheck, ckGroup]) and FReflexChildren and (Cur <> cbGrayed)
    then
  begin
    for I := 0 to Count - 1 do
    begin
      N := TCheckTreeNode(Item[I]);
      if N.Enabled then
        N.InternalSetState(Cur, True, False)
      else
      begin
        MustCheckParent := True;
        D := N;
      end;
    end;
    if MustCheckParent then D.DoCheckParent(Cur);
  end;
end;

procedure TCheckTreeNode.DoCheckParent(Cur: TCheckBoxState);
var
  I                 : Integer;
  Ch, Un            : Boolean;
begin
  Ch := True;
  Un := True;
  if (FCheckKind in [ckCheck, ckGroup]) and FReflexParent and (Parent <> nil)
    then
    with TCheckTreeNode(Parent) do
    begin
      for I := 0 to Count - 1 do
      begin
        if TCheckTreeNode(Item[I]).FCheckKind in [ckCheck, ckGroup] then
          case TCheckTreeNode(Item[I]).GetState of
            cbUnchecked: Ch := False;
            cbChecked:
              Un := False
          else
            begin
              Ch := False;
              Un := False;
              Break;
            end
          end;
        if not Ch and not Un then Break;
      end;
      if Ch then
        InternalSetState(cbChecked, False, True)
      else if Un then
        InternalSetState(cbUnchecked, False, True)
      else
        InternalSetState(cbGrayed, False, True)
    end;
end;

function TCheckTreeNode.GetChecked: Boolean;
var
  S                 : TCheckBoxState;
begin
  S := GetState;
  Result := S = cbChecked;
  if (FCheckKind in [ckCheck, ckGroup]) and
    TCheckTreeView(TreeView).FGrayedIsChecked and (S = cbGrayed) then
    Result := True
end;

function TCheckTreeNode.GetItemIndex: Integer;
begin
  for Result := 0 to Count - 1 do
    with TCheckTreeNode(Item[Result]) do
      if (FCheckKind = ckRadio) and Checked then Exit;
  Result := -1;
end;

function TCheckTreeNode.GetState: TCheckBoxState;
begin
  case StateIndex of
    - 1..1, 4, 6, 9, 11, 14: Result := cbUnchecked;
    2, 5, 7, 10, 12, 15:
      Result := cbChecked
  else
    Result := cbGrayed
  end;
  if FCheckKind = ckGroup then Result := FCache;
end;

procedure TCheckTreeNode.InternalSetState(Value: TCheckBoxState;
  CheckChildren, CheckParent: Boolean);
var
  I                 : Integer;
  Node              : TCheckTreeNode;
  SI                : Integer;
begin
  SI := StateIndexes[FCheckKind, Value];
  if SI > 0 then
    if not Enabled then
      StateIndex := SI + 10
    else if TCheckTreeView(TreeView).Flatness = cfAlways3d then
      StateIndex := SI + 5
    else
      StateIndex := SI;
  UpdateHotTrack(TCheckTreeView(TreeView).FHoverCache = Self);
  if FCheckKind = ckGroup then FCache := Value;
  if (FCheckKind = ckRadio) and (Value = cbChecked) then
    for I := 0 to Parent.Count - 1 do
    begin
      Node := TCheckTreeNode(Parent.Item[I]);
      if (Node <> Self) and (Node.FCheckKind = ckRadio) then
        Node.InternalSetState(cbUnchecked, False, False);
    end;
  if CheckChildren then DoCheckChildren(Value);
  if CheckParent then DoCheckParent(Value);
end;

const
  BoolChecks        : array[Boolean] of TCheckBoxState = (cbUnchecked, cbChecked);

function TCheckTreeNode.IsEqual(Node: TTreeNode): Boolean;
begin
  Result := (Text = Node.Text) and (Data = Node.Data);
end;

procedure TCheckTreeNode.MakeRadioGroup;
var
  I                 : Integer;
begin
  CheckKind := ckNone;
  for I := Count - 1 downto 0 do
    if not Item[I].HasChildren then
      with TCheckTreeNode(Item[I]) do
      begin
        CheckKind := ckRadio;
        //Checked := True
      end;
end;

procedure TCheckTreeNode.ReadSelf(Stream: TStream);
var
  Data              : TCheckNodeData;
begin
  Stream.ReadBuffer(Data, SizeOf(Data));
  FCheckKind := Data.Kind;
  FEnabled := Data.Enabled;
end;

procedure TCheckTreeNode.SetChecked(Value: Boolean);
begin
  if GetState <> BoolChecks[Value] then
    InternalSetState(BoolChecks[Value])
end;

procedure TCheckTreeNode.SetCheckKind(Value: TCheckKind);
begin
  if FCheckKind <> Value then
  begin
    FCheckKind := Value;
    if FCheckKind = ckNone then
      StateIndex := -1
    else if FCheckKind = ckGroup then
    begin
      FCache := GetState;
      StateIndex := -1;
    end
    else
      InternalSetState(GetState);
  end;
end;

procedure TCheckTreeNode.SetEnabled(Value: Boolean);
var
  I                 : Integer;
begin
  if FEnabled <> Value then
  begin
    FEnabled := Value;
    InternalSetState(GetState, False, False);
  end;
  for I := 0 to Count - 1 do
    TCheckTreeNode(Item[I]).Enabled := Value;
end;

procedure TCheckTreeNode.SetItemIndex(Value: Integer);
begin
  if Value > Count then raise EIndexError.CreateFmt(SIndexError, [Value]);
  if TCheckTreeNode(Item[Value]).FCheckKind <> ckRadio then
    EIndexError.CreateFmt(SInvalidKind, [Value]);
  TCheckTreeNode(Item[Value]).SetState(cbChecked);
end;

procedure TCheckTreeNode.SetReflexChildren(Value: Boolean);
begin
  if FReflexChildren <> Value then
  begin
    FReflexChildren := Value;
    DoCheckChildren(GetState)
  end;
end;

procedure TCheckTreeNode.SetReflexParent(Value: Boolean);
begin
  if FReflexParent <> Value then
  begin
    FReflexParent := Value;
    DoCheckParent(GetState);
  end;
end;

procedure TCheckTreeNode.SetState(Value: TCheckBoxState);
begin
  if Value <> GetState then
    InternalSetState(Value)
end;

procedure TCheckTreeNode.UpdateHotTrack(Hover: Boolean);
begin
  if (FCheckKind in [ckCheck, ckRadio]) and Enabled and
    (TCheckTreeView(TreeView).Flatness <> cfAlways3d) then
  begin
    if Hover then
      StateIndex := StateIndexes[FCheckKind, GetState] + 5
    else
      StateIndex := StateIndexes[FCheckKind, GetState];
  end;
end;

procedure TCheckTreeNode.WriteSelf(Stream: TStream);
var
  Data              : TCheckNodeData;
begin
  Data.Kind := CheckKind;
  Data.Enabled := Enabled;
  Stream.WriteBuffer(Data, SizeOf(Data));
end;

end.