dccomctrls.pas

获取硬盘相关详细信息

   end;

constructor TdcFixedSubItems.Create(AOwner: TListItem);
begin
   inherited Create;
   FOwner := AOwner;
   FImageIndices := TList.Create;
end;

destructor TdcFixedSubItems.Destroy;
begin
   FImageIndices.Free;
   inherited;
end;

function TdcFixedSubItems.Add(const S: string): Integer;
begin
   Result := inherited Add(S);
   FImageIndices.Add(Pointer(-1));
   RefreshItem(Result + 1);
end;

procedure TdcFixedSubItems.Delete(Index: Integer);
begin
   inherited;
   FImageIndices.Delete(Index);
   Owner.Update;
end;

function TdcFixedSubItems.GetHandle: HWND;
begin
   Result := Owner.Owner.Handle;
end;

procedure TdcFixedSubItems.SetColumnWidth(Index: Integer);
var
   ListView: TCustomListView;
begin
   ListView := Owner.ListView;
   if TumCustomListView(ListView).ColumnsShowing and
      (TumCustomListView(ListView).Columns.Count > Index) and
      (ListView.Column[Index].WidthType = ColumnTextWidth) then
     TumCustomListView(ListView).UpdateColumn(Index);
end;

procedure TdcFixedSubItems.Insert(Index: Integer; const St: String);
var
  I: Integer;
begin
  inherited Insert(Index, St);
  FImageIndices.Insert(Index, Pointer(-1));
  for I := Index + 1 to Count do
    RefreshItem(I);
end;

procedure TdcFixedSubItems.Put(Index: Integer; const St: String);
begin
  inherited Put(Index, St);
  RefreshItem(Index + 1);
end;

procedure TdcFixedSubItems.RefreshItem(Index: Integer);
begin
   ListView_SetItemText(Handle, Owner.Index, Index, LPSTR_TEXTCALLBACK);
   SetColumnWidth(Index);
end;

procedure TdcFixedSubItems.SetUpdateState(Updating: Boolean);
begin
   TdcHackListItems(Owner.Owner).SetUpdateState(Updating);
end;

procedure TdcFixedSubItems.Clear; // The fix
begin
   inherited Clear;
   FImageIndices.Clear;
end;

constructor TdcFixedListItem.Create(AOwner: TListItems);
begin
   inherited Create(AOwner);
   SubItems.Free;
   TdcHackListItem(Self).FSubItems := TdcFixedSubItems.Create(Self);
end;
{$ENDIF}


{ TdcListViewCursors }
constructor TdcListViewCursors.Create(aListView: TumCustomListView);
begin
  inherited Create;
  ListView := aListView;
{$IFDEF APPCONTROLS}
  FHotCursor := crLinkSelect;
{$ENDIF}  
end;

{$IFDEF APPCONTROLS}
procedure TdcListViewCursors.SetHotCursor(Value: TCursor);
begin
  if FHotCursor <> Value then
   begin
    FHotCursor := Value;

    if not (csLoading in ListView.ComponentState) then
      ListView_SetHotCursor(ListView.Handle, Screen.Cursors[Value]);
   end;
end;
{$ENDIF}


{ TdcListViewHeaderMenu }
constructor TdcListViewHeaderMenu.Create(aListView: TumCustomListView);
begin
  inherited Create;
  ListView := aListView;
end;

procedure TdcListViewHeaderMenu.SetAlignLeftItem(Value: TComponent);
begin
  FAlignLeftItem := Value;
  if Assigned(FAlignLeftItem) then
   begin
    FAlignLeftItem.FreeNotification(ListView);
    with ListView do
     if not (csDesigning in ComponentState) then
      begin
       FOldAlignLeftItemClick := GetPropNotifyEventValue(FAlignLeftItem, 'OnClick');
       SetPropNotifyEventValue(FAlignLeftItem, 'OnClick', AlignLeftItemClick);
      end;
   end;
end;

procedure TdcListViewHeaderMenu.SetAlignRightItem(Value: TComponent);
begin
  FAlignRightItem := Value;
  if Assigned(FAlignRightItem) then
   begin
    FAlignRightItem.FreeNotification(ListView);
    with ListView do
     if not (csDesigning in ComponentState) then
      begin
       FOldAlignRightItemClick := GetPropNotifyEventValue(FAlignRightItem, 'OnClick');      
       SetPropNotifyEventValue(FAlignRightItem, 'OnClick', AlignRightItemClick);
      end;
   end;
end;

procedure TdcListViewHeaderMenu.SetAlignCenterItem(Value: TComponent);
begin
  FAlignCenterItem := Value;
  if Assigned(FAlignCenterItem) then
   begin
    FAlignCenterItem.FreeNotification(ListView);
    with ListView do
     if not (csDesigning in ComponentState) then
      begin
       FOldAlignCenterItemClick := GetPropNotifyEventValue(FAlignCenterItem, 'OnClick');      
       SetPropNotifyEventValue(FAlignCenterItem, 'OnClick', AlignCenterItemClick);
      end;
   end;
end;

procedure TdcListViewHeaderMenu.SetAscendingItem(Value: TComponent);
begin
  FAscendingItem := Value;
  if Assigned(FAscendingItem) then
   begin
    FAscendingItem.FreeNotification(ListView);
    with ListView do
     if not (csDesigning in ComponentState) then
      begin
       FOldAscendingItemClick := GetPropNotifyEventValue(FAscendingItem, 'OnClick');      
       SetPropNotifyEventValue(FAscendingItem, 'OnClick', AscendingItemClick);
      end;
   end;
end;

procedure TdcListViewHeaderMenu.SetDescendingItem(Value: TComponent);
begin
  FDescendingItem := Value;
  if Assigned(FDescendingItem) then
   begin
    FDescendingItem.FreeNotification(ListView);
    with ListView do
     if not (csDesigning in ComponentState) then
      begin
       FOldDescendingItemClick := GetPropNotifyEventValue(FDescendingItem, 'OnClick');      
       SetPropNotifyEventValue(FDescendingItem, 'OnClick', DescendingItemClick);
      end;
   end;
end;

procedure TdcListViewHeaderMenu.SetBestFitItem(Value: TComponent);
begin
  FBestFitItem := Value;
  if Assigned(FBestFitItem) then
   begin
    FBestFitItem.FreeNotification(ListView);
    with ListView do
     if not (csDesigning in ComponentState) then
      begin
       FOldBestFitItemClick := GetPropNotifyEventValue(FBestFitItem, 'OnClick');
       SetPropNotifyEventValue(FBestFitItem, 'OnClick', BestFitItemClick);
      end;
   end;
end;

{ TdcListViewRegistrySaver }
procedure TdcListViewRegistrySaver.DoSaveToRegistry(Reg: TRegistry);
var
  I: Integer;
begin
  if Owner is TumCustomListView then
   with Owner as TumCustomListView, Reg do
    begin
     WriteInteger(RSSortColumn, FSortColumn);
     WriteInteger(RSSortDirection, Integer(FSortDirection));
     WriteInteger(RSViewStyle, Integer(ViewStyle));
     I := Columns.Count;
     if I <> 0 then
      for I := 0 to I - 1 do
       WriteInteger(IntToStr(I), Columns[I].Width);
    end;
end;

procedure TdcListViewRegistrySaver.DoLoadFromRegistry(Reg: TRegistry);
var
  I: Integer;
begin
  if Owner is TumCustomListView then
   with Owner as TumCustomListView, Reg do
    begin
     SortColumn := ReadInteger(RSSortColumn);
     SortDirection := TdcListViewSortDirection(ReadInteger(RSSortDirection));
     ViewStyle := TViewStyle(ReadInteger(RSViewStyle));
     I := Columns.Count;
     if I <> 0 then
      for I := 0 to I - 1 do
       Columns[I].Width := ReadInteger(IntToStr(I));
    end;
end;

{$IFDEF USEINIFILES}
procedure TdcListViewRegistrySaver.DoSaveToIniFile(Ini: TIniFile);
var
  I: Integer;
begin
  if Owner is TumCustomListView then
   with Owner as TumCustomListView, Ini do
    begin
     WriteInteger(IniSection, RSSortColumn, FSortColumn);
     WriteInteger(IniSection, RSSortDirection, Integer(FSortDirection));
     WriteInteger(IniSection, RSViewStyle, Integer(ViewStyle));
     I := Columns.Count;
     if I <> 0 then
      for I := 0 to I - 1 do
       WriteInteger(IniSection, IntToStr(I), Columns[I].Width);
    end;
end;

procedure TdcListViewRegistrySaver.DoLoadFromIniFile(Ini: TIniFile);
var
  I: Integer;
begin
  if Owner is TumCustomListView then
   with Owner as TumCustomListView, Ini do
    begin
     SortColumn := ReadInteger(IniSection, RSSortColumn, SortColumn);
     SortDirection := TdcListViewSortDirection(ReadInteger(IniSection, RSSortDirection, Integer(SortDirection)));
     ViewStyle := TViewStyle(ReadInteger(IniSection, RSViewStyle, Integer(ViewStyle)));
     I := Columns.Count;
     if I <> 0 then
      for I := 0 to I - 1 do
       Columns[I].Width := ReadInteger(IniSection, IntToStr(I), Column[I].Width);
    end;
end;
{$ENDIF}


{ TumCustomListView }
function UMDefaultListViewSort(Item1, Item2: TListItem;
  lParam: Integer): Integer;

  function CompareItems(const Str1, Str2: String): Integer;

    function IsValidNumber(const S: String; var V: Extended): Boolean;
    var
      ErrCode: Integer;
    begin
      Val(S, V, ErrCode);
      Result := (ErrCode = 0);
    end;

    function IsValidDate(const S: String; var DT: TDateTime): Boolean;
    begin
      DT := StrToDateTimeDef(S, 0);
      Result := DT <> 0;
    end;

  var
    Val1, Val2: Extended;
    DT1, DT2: TDateTime;
  begin
    if (Str1 <> '') and (Str2 = '') then Result := -1 else
    if (Str2 <> '') and (Str1 = '') then Result := 1 else
    if IsValidNumber(Str1, Val1) and IsValidNumber(Str2, Val2) then
      if Val1 < Val2 then Result := -1 else
      if Val1 > Val2 then Result := 1 else Result := 0
    else
    if IsValidDate(Str1, DT1) and IsValidDate(Str2, DT2) then
      if DT1 < DT2 then Result := -1 else
      if DT1 > DT2 then Result := 1 else Result := 0
    else
      Result := AnsiCompareStr(Str1, Str2);
  end;

var
  Str1, Str2: String;
  Column: Integer;
begin
  with Item1 do
   if Assigned(TumCustomListView(ListView).OnCompare) then
     TumCustomListView(ListView).OnCompare(ListView, Item1, Item2, lParam, Result)
   else
    begin
     Column := LoWord(lParam);
     if Column = 0 then
      begin
       Str1 := Item1.Caption;
       Str2 := Item2.Caption;
      end
     else
      begin
       if Item1.SubItems.Count > Column - 1 then
         Str1 := Item1.SubItems[Column - 1]
       else
         Str1 := '';
       if Item2.SubItems.Count > Column - 1 then
         Str2 := Item2.SubItems[Column - 1]
       else
         Str2 := '';
      end;
      
     Result := CompareItems(Str1, Str2) * ShortInt(HiWord(lParam));
    end;
end;

constructor TumCustomListView.Create(aOwner: Tcomponent);
begin
  inherited;
  inherited ViewStyle := vsReport;
  inherited SortType := stData;
  DefaultSortProc := @UMDefaultListViewSort;

  FHeaderColor := clNone;
  FHoverSection := -1;
  FHeaderMenu := TdcListViewHeaderMenu.Create(Self);
  FCursors := TdcListViewCursors.Create(Self);
  FRegistrySaver := TdcListViewRegistrySaver.Create(Self);
  FSortMarkImageAsc := TPicture.Create;
  FSortMarkImageDesc := TPicture.Create;
{$IFDEF D3}
  FSortMarkImageAsc.OnChange := SortMarkImageChanged;
  FSortMarkImageDesc.OnChange := SortMarkImageChanged;
{$ENDIF}    

  FDefaultMenu := TPopupMenu.Create(Self);
  FDefAscendingItem := TMenuItem.Create(Self);
  FDefDescendingItem := TMenuItem.Create(Self);
{ If you'd like to show radio items for default
  header menu - uncoment next two lines }
//  FDefAscendingItem.RadioItem := True;
//  FDefDescendingItem.RadioItem := True;
  FDefAscendingItem.Caption := DEF_SORT_ASCENDING;
  FDefDescendingItem.Caption := DEF_SORT_DESCENDING;
  FDefAscendingItem.OnClick := AscendingItemClick;
  FDefDescendingItem.OnClick := DescendingItemClick;
  FDefaultMenu.Items.Add(FDefAscendingItem);
  FDefaultMenu.Items.Add(FDefDescendingItem);
  
  FShowHeaderMenu := True;
  FShowScrollTips := True;
  FShowSortMark := True;
  FShowToolTips := True;

  ClickedColumn := -1;

  {$IFDEF D6}
  FHeaderInstance := Classes.MakeObjectInstance(HeaderWndProc);
  {$ELSE}
  FHeaderInstance := MakeObjectInstance(HeaderWndProc);
  {$ENDIF}
end;

destructor TumCustomListView.Destroy;
begin
  if FHeaderHandle <> 0 then
    SetWindowLong(FHeaderHandle, GWL_WNDPROC, LongInt(FOldHeaderWndProc));
  {$IFDEF D6}
  Classes.FreeObjectInstance(FHeaderInstance);
  {$ELSE}
  FreeObjectInstance(FHeaderInstance);
  {$ENDIF}
  FDefaultMenu.Free;
  FSortMarkImageDesc.Free;
  FSortMarkImageAsc.Free;
  FRegistrySaver.Free;