cxshelltreeview.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,164 行 · 第 1/3 页

begin
  inherited DblClick;
  if Container <> nil then
    Container.DblClick;
end;

function TcxInnerShellTreeView.DoMouseWheel(Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint): Boolean;
begin
  Result := (Container <> nil) and Container.DoMouseWheel(Shift,
    WheelDelta, MousePos);
  if not Result then
    inherited DoMouseWheel(Shift, WheelDelta, MousePos);
end;

procedure TcxInnerShellTreeView.DragOver(Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  if Container <> nil then
    Container.DragOver(Source, Left + X, Top + Y, State, Accept);
end;

function TcxInnerShellTreeView.GetPopupMenu: TPopupMenu;
begin
  if Container = nil then
    Result := inherited GetPopupMenu
  else
    Result := Container.GetPopupMenu;
end;

function TcxInnerShellTreeView.IsLoading: Boolean;
begin
  Result := csLoading in Container.ComponentState;
end;

procedure TcxInnerShellTreeView.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if Container <> nil then
    Container.KeyDown(Key, Shift);
  if Key <> 0 then
    inherited KeyDown(Key, Shift);
end;

procedure TcxInnerShellTreeView.KeyPress(var Key: Char);
begin
  if Key = Char(VK_TAB) then
    Key := #0;
  if Container <> nil then
    Container.KeyPress(Key);
  if Word(Key) = VK_RETURN then
    Key := #0;
  if Key <> #0 then
    inherited KeyPress(Key);
end;

procedure TcxInnerShellTreeView.KeyUp(var Key: Word; Shift: TShiftState);
begin
  if Key = VK_TAB then
    Key := 0;
  if Container <> nil then
    Container.KeyUp(Key, Shift);
  if Key <> 0 then
    inherited KeyUp(Key, Shift);
end;

procedure TcxInnerShellTreeView.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if Container <> nil then
    with Container do
    begin
      InnerControlMouseDown := True;
      try
        MouseDown(Button, Shift, X + Self.Left, Y + Self.Top);
      finally
        InnerControlMouseDown := False;
      end;
    end;
end;

procedure TcxInnerShellTreeView.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift, X, Y);
  if Container <> nil then
    Container.MouseMove(Shift, X + Left, Y + Top);
end;

procedure TcxInnerShellTreeView.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if Container <> nil then
    Container.MouseUp(Button, Shift, X + Left, Y + Top);
end;

procedure TcxInnerShellTreeView.CreateWindowHandle(const Params: TCreateParams);
begin
  inherited CreateWindowHandle(Params);
  Container.SetScrollBarsParameters;
end;

procedure TcxInnerShellTreeView.WndProc(var Message: TMessage);
begin
  if (Container <> nil) and Container.InnerControlMenuHandler(Message) then
    Exit;

{$IFNDEF DELPHI5}
  if Message.Msg = WM_RBUTTONDOWN then
  begin
    Container.LockPopupMenu(True);
    try
      inherited WndProc(Message);
    finally
      Container.LockPopupMenu(False);
    end;
    Exit;
  end;
{$ENDIF}

  if Container <> nil then
    if ((Message.Msg = WM_LBUTTONDOWN) or (Message.Msg = WM_LBUTTONDBLCLK)) and
      (Container.DragMode = dmAutomatic) and not Container.IsDesigning then
    begin
      Container.BeginAutoDrag;
      Exit;
    end;

  inherited WndProc(Message);
  case Message.Msg of
    WM_HSCROLL,
//    WM_MOUSEWHEEL,
    WM_VSCROLL,
    WM_WINDOWPOSCHANGED,
    CM_WININICHANGE:
      Container.SetScrollBarsParameters;
  end;
end;

procedure TcxInnerShellTreeView.MouseEnter(AControl: TControl);
begin
end;

procedure TcxInnerShellTreeView.MouseLeave(AControl: TControl);
begin
  if Container <> nil then
    Container.ShortRefreshContainer(True);
end;

function TcxInnerShellTreeView.GetControl: TWinControl;
begin
  Result := Self;
end;

function TcxInnerShellTreeView.GetControlContainer: TcxContainer;
begin
  Result := FContainer;
end;

procedure TcxInnerShellTreeView.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  inherited;
  if Container <> nil then
    with Message do
    begin
      Result := Result or DLGC_WANTCHARS;
      if GetKeyState(VK_CONTROL) >= 0 then
        Result := Result or DLGC_WANTTAB;
    end;
end;

procedure TcxInnerShellTreeView.WMKillFocus(var Message: TWMKillFocus);
begin
  inherited;
  if (Container <> nil) and not Container.IsDestroying then
    Container.FocusChanged;
end;

procedure TcxInnerShellTreeView.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
  inherited;
  if UsecxScrollBars and not Container.FScrollBarsCalculating then
    Container.SetScrollBarsParameters;
end;

procedure TcxInnerShellTreeView.WMNCPaint(var Message: TMessage);
var
  DC: HDC;
  ABrush: HBRUSH;
begin
  if not UsecxScrollBars then
  begin
    inherited;
    Exit;
  end;

  Message.Result := 1;
  if UsecxScrollBars and Container.HScrollBar.Visible and Container.VScrollBar.Visible then
  begin
    DC := GetWindowDC(Handle);
    ABrush := 0;
    try
      with Container.LookAndFeel do
        ABrush := CreateSolidBrush(ColorToRGB(Painter.DefaultSizeGripAreaColor));
      FillRect(DC, GetSizeGripRect(Self), ABrush);
    finally
      if ABrush <> 0 then
        DeleteObject(ABrush);
      ReleaseDC(Handle, DC);
    end;
  end;
end;

procedure TcxInnerShellTreeView.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  if (Container <> nil) and not Container.IsDestroying and not(csDestroying in ComponentState)
      and (Message.FocusedWnd <> Container.Handle) then
    Container.FocusChanged;
end;

procedure TcxInnerShellTreeView.WMWindowPosChanged(var Message: TWMWindowPosChanged);
var
  ARgn: HRGN;
begin
  inherited;
  if csDestroying in ComponentState then
    Exit;
  if Container.HScrollBar.Visible and Container.VScrollBar.Visible then
  begin
    ARgn := CreateRectRgnIndirect(GetSizeGripRect(Self));
    SendMessage(Handle, WM_NCPAINT, ARgn, 0);
    DeleteObject(ARgn);
  end;
end;

procedure TcxInnerShellTreeView.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if Message.lParam = 0 then
    MouseEnter(Self)
  else
    MouseEnter(TControl(Message.lParam));
end;

procedure TcxInnerShellTreeView.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if Message.lParam = 0 then
    MouseLeave(Self)
  else
    MouseLeave(TControl(Message.lParam));
end;

procedure TcxInnerShellTreeView.DSMShellChangeNotify(var Message: TMessage);
begin
  inherited;
  Container.SetScrollBarsParameters;
end;

procedure TcxInnerShellTreeView.TVMEnsureVisible(var Message: TMessage);
begin
  inherited;
  Container.SetScrollBarsParameters;
end;

{ TcxCustomShellTreeView }

constructor TcxCustomShellTreeView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataBinding := GetDataBindingClass.Create(Self, Self);
  with TcxCustomDataBindingAccess(FDataBinding) do
  begin
    OnDataChange := Self.DataChange;
    OnDataSetChange := Self.DataSetChange;
    OnUpdateData := Self.UpdateData;
  end;
  FInnerTreeView := TcxInnerShellTreeView.Create(Self);
  with FInnerTreeView do
  begin
    FContainer := Self;
    LookAndFeel.MasterLookAndFeel := Self.Style.LookAndFeel;
    Parent := Self;

    OnAddFolder := Self.AddFolderHandler;
    OnChange := Self.ChangeHandler;
    OnChanging := Self.ChangingHandler;
    OnCollapsed := Self.CollapsedHandler;
    OnCollapsing := Self.CollapsingHandler;
    OnEdited := Self.EditedHandler;
    OnEditing := Self.EditingHandler;
    OnExpanded := Self.ExpandedHandler;
    OnExpanding := Self.ExpandingHandler;
    OnRootChanged := Self.CurrentFolderChangedHandler;
    OnShellChange := Self.ShellChangeHandler;
  end;
  InnerControl := FInnerTreeView;
  HScrollBar.SmallChange := 1;
  VScrollBar.SmallChange := 1;
  Width := 121;
  Height := 97;
end;

destructor TcxCustomShellTreeView.Destroy;
begin
  FreeAndNil(FInnerTreeView);
  FreeAndNil(FDataBinding);
  inherited Destroy;
end;

function TcxCustomShellTreeView.ExecuteAction(Action: TBasicAction): Boolean;
begin
  Result := inherited ExecuteAction(Action) or
    TcxCustomDataBindingAccess(FDataBinding).ExecuteAction(Action);
end;

procedure TcxCustomShellTreeView.SetFocus;
begin
  if not IsDesigning then
    inherited SetFocus;
end;

function TcxCustomShellTreeView.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action) or
    TcxCustomDataBindingAccess(FDataBinding).UpdateAction(Action);
end;

function TcxCustomShellTreeView.GetNodeAbsolutePIDL(ANode: TTreeNode): PItemIDList;
var
  AIFolder: IShellFolder;
  AList: TStringList;
  ATempPIDL1, ATempPIDL2: PItemIDList;
  AViewOptions: TcxShellViewOptions;
  I: Integer;
begin
  with TcxShellTreeItemProducerAccess(ANode.Data) do
    if FolderPidl <> nil then
    begin
      Result := GetPidlCopy(FolderPidl);
      Exit;
    end;

  CheckShellRoot(Root);
  Result := GetPidlCopy(Root.Pidl);
  if ANode.Parent = nil then
    Exit;

  AList := TStringList.Create;
  try
    repeat
      AList.Insert(0, ANode.Text);
      ANode := ANode.Parent;
    until ANode.Parent = nil;
    AIFolder := Root.ShellFolder;
    AViewOptions := GetViewOptions;
    for I := 0 to AList.Count - 1 do
    begin
      ATempPIDL1 := InternalParseDisplayName(AIFolder, AList[I], AViewOptions);
      ATempPIDL2 := Result;
      Result := ConcatenatePidls(Result, ATempPIDL1);
      if I < AList.Count - 1 then
        AIFolder.BindToObject(ATempPIDL1, nil, IID_IShellFolder, Pointer(AIFolder));
      DisposePidl(ATempPIDL1);
      DisposePidl(ATempPIDL2);
    end;
  finally
    AList.Free;
  end;
end;

procedure TcxCustomShellTreeView.UpdateContent;
begin
  FInnerTreeView.UpdateContent;
end;

procedure TcxCustomShellTreeView.DoExit;
begin
  if IsDestroying or FIsExitProcessing then
    Exit;
  FIsExitProcessing := True;
  try
    try
      DataBinding.UpdateDataSource;
    except
      SetFocus;
      raise;