cxshelllistview.pas

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

  if Message.lParam = 0 then
    MouseEnter(Self)
  else
    MouseEnter(TControl(Message.lParam));
end;

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

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

{ TcxCustomShellListView }

constructor TcxCustomShellListView.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;
  FInnerListView := TcxInnerShellListView.Create(Self);
  with FInnerListView do
  begin
    FContainer := Self;
    LookAndFeel.MasterLookAndFeel := Self.Style.LookAndFeel;
    Parent := Self;
    BeforeNavigation := Self.BeforeNavigationHandler;
    OnAddFolder := Self.AddFolderHandler;
    OnChange := Self.ChangeHandler;
    OnRootChanged := Self.CurrentFolderChangedHandler;
    OnSelectItem := Self.SelectItemHandler;
    OnShellChange := Self.ShellChangeHandler;
  end;
  InnerControl := FInnerListView;
  HScrollBar.SmallChange := 1;
  VScrollBar.SmallChange := 1;
  Width := 250;
  Height := 150;
end;

destructor TcxCustomShellListView.Destroy;
begin
  FreeAndNil(FInnerListView);
  FreeAndNil(FDataBinding);
  inherited Destroy;
end;

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

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

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

procedure TcxCustomShellListView.BrowseParent;
begin
  FInnerListView.BrowseParent;
end;

function TcxCustomShellListView.GetItemAbsolutePIDL(AIndex: Integer): PItemIDList;
begin
  CheckShellRoot(Root);
  Result := TcxShellItemInfo(InnerListView.ItemProducer.Items[AIndex]).pidl;
  Result := ConcatenatePidls(Root.Pidl, Result);
end;

procedure TcxCustomShellListView.ProcessTreeViewNavigate(apidl: PItemIDList);
begin
  FInnerListView.ProcessTreeViewNavigate(apidl);
end;

procedure TcxCustomShellListView.Sort;
begin
  InnerListView.Sort;
end;

procedure TcxCustomShellListView.UpdateContent;
begin
  FInnerListView.UpdateContent;
end;

procedure TcxCustomShellListView.DoExit;
begin
  if IsDestroying or FIsExitProcessing then
    Exit;
  FIsExitProcessing := True;
  try
    try
      DataBinding.UpdateDataSource;
    except
      SetFocus;
      raise;
    end;
    inherited DoExit;
  finally
    FIsExitProcessing := False;
  end;
end;

procedure TcxCustomShellListView.Loaded;
begin
  inherited Loaded;
  InnerListView.Loaded;
  SetScrollBarsParameters;
end;

procedure TcxCustomShellListView.LookAndFeelChanged(Sender: TcxLookAndFeel;
  AChangedValues: TcxLookAndFeelValues);
begin
  inherited LookAndFeelChanged(Sender, AChangedValues);
  if not FIsCreating then
    InnerListView.LookAndFeelChanged(Sender, AChangedValues);
end;

function TcxCustomShellListView.NeedsScrollBars: Boolean;
begin
  Result := True;
end;

procedure TcxCustomShellListView.Scroll(AScrollBarKind: TScrollBarKind;
  AScrollCode: TScrollCode; var AScrollPos: Integer);

  procedure HorizontalScroll;
  var
    ACurrentScrollPos, I: Integer;
  begin
    with FInnerListView do
      if AScrollCode = scTrack then
        if ViewStyle = vsList then
        begin
          ACurrentScrollPos := GetScrollPos(Handle, SB_HORZ);
          if AScrollPos <> ACurrentScrollPos then
          begin
            if AScrollPos > ACurrentScrollPos then
              for I := ACurrentScrollPos + 1 to AScrollPos do
                CallWindowProc(DefWndProc, Handle, WM_HSCROLL, Word(scLineDown) +
                  Word(I) shl 16, HScrollBar.Handle)
            else
              for I := ACurrentScrollPos - 1 downto AScrollPos do
                CallWindowProc(DefWndProc, Handle, WM_HSCROLL, Word(scLineUp) +
                  Word(I) shl 16, HScrollBar.Handle);
          end
        end
        else
          CallWindowProc(DefWndProc, Handle, LVM_SCROLL, AScrollPos -
            GetScrollPos(Handle, SB_HORZ), 0)
      else
      begin
        CallWindowProc(DefWndProc, Handle, WM_HSCROLL, Word(AScrollCode) +
          Word(AScrollPos) shl 16, HScrollBar.Handle);
        AScrollPos := GetScrollPos(Handle, SB_HORZ);
      end;
  end;

  procedure VerticalScroll;
  begin
    with FInnerListView do
      if AScrollCode = scTrack then
        case ViewStyle of
          vsReport:
            SendMessage(Handle, LVM_SCROLL, 0, (AScrollPos - ListView_GetTopIndex(Handle)) *
              (Self.Canvas.FontHeight(Font) + 1));
          vsIcon, vsSmallIcon:
            CallWindowProc(DefWndProc, Handle, LVM_SCROLL, 0, AScrollPos -
              GetScrollPos(Handle, SB_VERT))
        end
      else
      begin
        CallWindowProc(DefWndProc, Handle, WM_VSCROLL, Word(AScrollCode) +
          Word(AScrollPos) shl 16, VScrollBar.Handle);
        AScrollPos := GetScrollPos(Handle, SB_VERT);
      end;
  end;

begin
  inherited Scroll(AScrollBarKind, AScrollCode, AScrollPos);
  if not Enabled then
    Exit;
  if AScrollBarKind = sbHorizontal then
    HorizontalScroll
  else
    VerticalScroll;
  SetScrollBarsParameters;
end;

procedure TcxCustomShellListView.CurrentFolderChangedHandler(Sender: TObject; Root: TcxCustomShellRoot);
begin
  try
    if Assigned(FOnCurrentFolderChanged) then
      FOnCurrentFolderChanged(Self);
  finally
    SetScrollBarsParameters;
  end;
end;

function TcxCustomShellListView.GetDataBindingClass: TcxCustomDataBindingClass;
begin
  Result := TcxDataBinding;
end;

function TcxCustomShellListView.GetViewOptions(AForNavigation: Boolean = False): TcxShellViewOptions;
begin
  if AForNavigation then
    Result := [svoShowFolders, svoShowHidden]
  else
    with InnerListView do
      begin
        Result := [];
        if Options.ShowNonFolders then
          Include(Result, svoShowFiles);
        if Options.ShowFolders then
          Include(Result, svoShowFolders);
        if Options.ShowHidden then
          Include(Result, svoShowHidden);
      end;
end;

procedure TcxCustomShellListView.SetTreeView(ATreeView: TWinControl);
begin
  FInnerListView.SetTreeView(ATreeView);
end;

procedure TcxCustomShellListView.AddFolderHandler(Sender: TObject;
  AFolder: TcxShellFolder; var ACanAdd: Boolean);
begin
  if Assigned(FOnAddFolder) then
    FOnAddFolder(Self, AFolder, ACanAdd);
end;

procedure TcxCustomShellListView.BeforeNavigationHandler(Sender: TcxCustomInnerShellListView;
  APItemIDList: PItemIDList; AFolderPath: WideString);
begin
  if Assigned(FOnBeforeNavigation) then
    FOnBeforeNavigation(Self, APItemIDList);
end;

procedure TcxCustomShellListView.ChangeHandler(Sender: TObject; Item: TListItem;
  Change: TItemChange);
begin
  if Assigned(FOnChange) then
    FOnChange(Self, Item, Change);
end;

procedure TcxCustomShellListView.SelectItemHandler(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  if Assigned(FOnSelectItem) then
    FOnSelectItem(Self, Item, Selected);
end;

procedure TcxCustomShellListView.ShellChangeHandler(Sender: TObject;
  AEventID: DWORD; APIDL1, APIDL2: PItemIDList);
begin
  if Assigned(FOnShellChange) then
    FOnShellChange(Self, AEventID, APIDL1, APIDL2);
end;

function TcxCustomShellListView.DoCompare(AItem1, AItem2: TcxShellFolder;
  out ACompare: Integer): Boolean;
begin
  Result := Assigned(FOnCompare);
  if Result then
    FOnCompare(Self, AItem1, AItem2, ACompare);
end;

function TcxCustomShellListView.GetAbsolutePIDL: PItemIDList;
begin
  if FInnerListView <> nil then
  begin
    CheckShellRoot(Root);
    Result := GetPidlCopy(FInnerListView.Root.Pidl);
  end
  else
    Result := nil;
end;

function TcxCustomShellListView.GetDragDropSettings: TcxDragDropSettings;
begin
  Result := TcxDragDropSettings(FInnerListView.DragDropSettings);
end;

function TcxCustomShellListView.GetFolder(AIndex: Integer): TcxShellFolder;
begin
  Result := FInnerListView.Folders[AIndex];
end;

function TcxCustomShellListView.GetFolderCount: Integer;
begin
  Result := FInnerListView.FolderCount;
end;

function TcxCustomShellListView.GetIconOptions: TIconOptions;
begin
  Result := FInnerListView.IconOptions;
end;

function TcxCustomShellListView.GetListHotTrack: Boolean;
begin
  Result := FInnerListView.HotTrack;
end;

function TcxCustomShellListView.GetMultiSelect: Boolean;
begin
  Result := FInnerListView.MultiSelect;
end;

function TcxCustomShellListView.GetOptions: TcxShellListViewOptions;
begin
  Result := FInnerListView.Options;
end;

function TcxCustomShellListView.GetPath: string;
begin
  if FInnerListView <> nil then
  begin
    CheckShellRoot(Root);
    Result := GetPidlName(FInnerListView.Root.Pidl);
  end
  else
    Result := '';
end;

function TcxCustomShellListView.GetRoot: TcxShellListRoot;
begin
  Result := TcxShellListRoot(FInnerListView.Root)
end;

function TcxCustomShellListView.GetShowColumnHeaders: Boolean;
begin
  Result := FInnerListView.ShowColumnHeaders;
end;

function TcxCustomShellListView.GetViewStyle: TViewStyle;
begin
  Result := FInnerListView.ViewStyle;
end;

procedure TcxCustomShellListView.SetAbsolutePIDL(Value: PItemIDList);
begin
  if FInnerListView <> nil then
  begin
    if not CheckAbsolutePIDL(Value, Root, True, False) then
      Exit;
    FInnerListView.ProcessTreeViewNavigate(Value);
  end;
end;

procedure TcxCustomShellListView.SetDragDropSettings(Value: TcxDragDropSettings);
begin
  FInnerListView.DragDropSettings := Value;
end;

procedure TcxCustomShellListView.SetIconOptions(Value: TIconOptions);
begin
  FInnerListView.IconOptions := Value;
end;

procedure TcxCustomShellListView.SetListHotTrack(Value: Boolean);
begin
  FInnerListView.HotTrack := Value;
end;

procedure TcxCustomShellListView.SetMultiSelect(Value: Boolean);
begin
  FInnerListView.MultiSelect := Value;
end;

procedure TcxCustomShellListView.SetOptions(Value: TcxShellListViewOptions);
begin
  FInnerListView.Options.Assign(Value);
end;

procedure TcxCustomShellListView.SetPath(Value: string);
var
  APIDL: PItemIDList;
begin
  if (FInnerListView <> nil) and FInnerListView.HandleAllocated then
  begin
    APIDL := PathToAbsolutePIDL(Value, Root, GetViewOptions(True), False); // TODO
    if APIDL <> nil then
      try
        FInnerListView.ProcessTreeViewNavigate(APIDL);
        FInnerListView.DoNavigateTreeView;
      finally
        DisposePidl(APIDL);
      end;
  end;
end;

procedure TcxCustomShellListView.SetRoot(Value: TcxShellListRoot);
begin
  FInnerListView.Root := Value;
end;

procedure TcxCustomShellListView.SetShowColumnHeaders(Value: Boolean);
begin
  InnerListView.ShowColumnHeaders := Value;
end;

procedure TcxCustomShellListView.SetViewStyle(Value: TViewStyle);
begin
  FInnerListView.ListViewStyle := TcxListViewStyle(Value);
  SetScrollBarsParameters;
end;

initialization
  PrepareShellSpecialFolderInfoTable;

finalization
  DestroyShellSpecialFolderInfoTable;

end.