⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dccomctrls.pas

📁 获取硬盘相关详细信息
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  FCursors.Free;
  FHeaderMenu.Free;

  inherited;
end;

procedure TumCustomListView.Notification(aComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if Operation = opRemove then
   if aComponent = FHeaderMenu.FPopupMenu then
     FHeaderMenu.FPopupMenu := nil
   else
    if aComponent = FHeaderMenu.FAscendingItem then
      FHeaderMenu.FAscendingItem := nil
    else
     if aComponent = FHeaderMenu.FDescendingItem then
       FHeaderMenu.FDescendingItem := nil
     else
      if aComponent = FHeaderMenu.FAlignLeftItem then
        FHeaderMenu.FAlignLeftItem := nil
      else
       if aComponent = FHeaderMenu.FAlignRightItem then
         FHeaderMenu.FAlignRightItem := nil
       else
        if aComponent = FHeaderMenu.FAlignCenterItem then
          FHeaderMenu.FAlignCenterItem := nil
        else
         if aComponent = FHeaderMenu.FBestFitItem then
           FHeaderMenu.FBestFitItem := nil;    
end;

procedure TumCustomListView.Loaded;
begin
  inherited;

  // fix the hot cursor
{$IFDEF APPCONTROLS}
  if FCursors.FHotCursor <> crLinkSelect then
    ListView_SetHotCursor(Handle, Screen.Cursors[FCursors.FHotCursor]);
{$ENDIF}

  // load sorting rules from the registry
  FRegistrySaver.Load;
end;

procedure TumCustomListView.CreateWnd;
begin
  inherited;
  ShowToolTips := FShowToolTips;
end;

procedure TumCustomListView.AlignControls(aControl: TControl; var Rect: TRect);
begin
  { This f**king kluge required to avoid D4/D5+ bug of ListView
    which occurs when something trying to
    change the WindowState of owner form on stage of
    loading properties (i.e: when acFormPlacementSaver want
    to restore settings from registry and maximize form on startup)
    AND ListView with ViewStyle=vsReport contains couple of
    columns which does not fit the width of control.
    This variable will not let to realign controls on loading...
    Aleksey, 2 April, 2002 }
end;

{$IFDEF SUBITEMSBUGFIX}
function TumCustomListView.CreateListItem: TListItem;
begin
   Result := TdcFixedListItem.Create(Items);
end;
{$ENDIF}

procedure TumCustomListView.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if Assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);
end;

procedure TumCustomListView.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if Assigned(FOnMouseLeave) then
    FOnMouseLeave(Self);
end;

procedure TumCustomListView.CMSysColorChange(var Message: TMessage);
begin
  if HandleAllocated then
   begin
    { bugfix for regular ListView. This fixes the appearance
      when the system colors is changed }
    ListView_SetTextBkColor(Handle, ColorToRGB(Color));
    ListView_SetBkColor(Handle, ColorToRGB(Color));
   end
end;

procedure TumCustomListView.CMWinIniChange(var Message: TMessage);
begin
  inherited;
  if Message.wParam <> 20 then { wallpaper changed }
    UpdateListItems;
end;

procedure TumCustomListView.CNKeyDown(var Message: TWMKey);
begin
  { avoiding clicking the default buttons in dialogs
    when the list item currently editing (5-Sep-2001, AK) }
  if not IsEditing then
   begin
    Message.Result := 1;
    inherited;
   end;
end;

{$IFDEF D4}
procedure TumCustomListView.CNNotify(var Message: TWMNotify);
begin
  with Message do
    case NMHdr^.code of
     { Kludge for correct custom drawing of subitems.
       Used to determinate correct drawing rectangle.
       Unfortunately standard routine does not provide us with
       drawing rectangle + we could not determinate the column
       width using Width property since it does not change
       dynamically on resize :-(. }
      NM_CUSTOMDRAW: if not (csDesigning in ComponentState) and
                        Assigned(FOnCustomDrawSubItemEx) then
                      CustomDrawRect := PNMCustomDraw(NMHdr)^.rc;
     end;
  inherited;
end;
{$ENDIF}

{$IFDEF D3}
procedure TumCustomListView.WMLButtonUp(var Message: TWMLButtonUp);
var
  Item: TListItem;
begin
  // before inherited, while it has csClicked in ControlState
  if FCheckOnClick and (csClicked in ControlState) and Checkboxes and (ViewStyle = vsReport) and
     PtInRect(ClientRect, SmallPointToPoint(Message.Pos)) then
   begin
    with Message.Pos do
     Item := GetItemAt(X, Y);
    if Item <> nil then
      Item.Checked := not Item.Checked;
   end;
  inherited;
end;
{$ENDIF}

procedure TumCustomListView.WMParentNotify(var Message: TWMParentNotify);
begin
  with Message do
   if (Event = WM_CREATE) and (FHeaderHandle = 0) then
    begin
     FHeaderHandle := ChildWnd;
     HeaderStyle := FHeaderStyle; // reset it
     FOldHeaderWndProc := Pointer(GetWindowLong(FHeaderHandle, GWL_WNDPROC));
     SetWindowLong(FHeaderHandle, GWL_WNDPROC, LongInt(FHeaderInstance));
    end;
  inherited;
end;

procedure TumCustomListView.WMDrawHeader(var Message: TWMDrawItem);
var
  State: TOwnerDrawState;
  SavedDC: Integer;
  Canvas: TCanvas;
begin
  with Message.DrawItemStruct^ do
   begin
    if not IsThemeEnabled and ColumnDragging then Exit;

    Message.Result := 1;
    {$IFDEF D5}
    State := TOwnerDrawState(LongRec(ItemState).Lo);
    {$ELSE}
    State := TOwnerDrawState(WordRec(LongRec(ItemState).Lo).Lo);
    {$ENDIF}

    Canvas := TCanvas.Create;
    with Canvas do
     try
       SavedDC := SaveDC(hDC);
       try
         Handle := hDC;
         Font := inherited Font;

         if Assigned(FOnDrawHeaderSection) then
           FOnDrawHeaderSection(Self, Canvas, rcItem, ItemID, odSelected in State)
         else
           DrawHeader(Canvas, rcItem, ItemID, odSelected in State);
       finally
         HeaderVisible := True;
         Handle := 0;
         RestoreDC(hDC, SavedDC);
       end;
     finally
       Free;
     end;
   end;
end;

procedure TumCustomListView.WMNotify(var Message: TWMNotify);
const
  NotifyBusy: Boolean = False;
var
  I: Integer;
  Item: THDItem;
begin
  case Message.NMHdr.Code of
    HDN_BEGINDRAG: if FullDrag then ColumnDragging := True;
    HDN_ENDDRAG: begin  // Foolishing the column: AK, 11-NOV-2001
                  ColumnDragging := False;
{$IFDEF D4}
                  Invalidate; // invalidate items

                  ColumnDragged := True;
                  Exit; // but don't pass it to default handler
{$ENDIF}
                 end;
   end;

  inherited;
  if NotifyBusy then Exit;

  case Message.NMHdr.Code of
    HDN_ITEMCHANGED,
    HDN_ITEMCHANGEDW: if HandleAllocated then
                       try
                         NotifyBusy := True;

                         // the ownerdraw flag
                         for I := Columns.Count - 1 downto 0 do
                          begin
                           Item.Mask := HDI_FORMAT;
                           if Header_GetItem(FHeaderHandle, I, Item) then
                            begin
                             Item.Fmt := Item.Fmt or HDF_OWNERDRAW;
                             Header_SetItem(FHeaderHandle, I, Item);
                            end;
                          end;
                       finally
                         NotifyBusy := False;
                       end;
   end;
end;

procedure TumCustomListView.WMVScroll(var Message: TWMVScroll);
var
  ScrollHint: THintWindow;
  s: ShortString;
  rc: TRect;
  pt: TPoint;
begin
  inherited;

  if FShowScrollTips then
   with Message do
    case ScrollCode of
      SB_THUMBTRACK: if ViewStyle = vsReport then
         begin
          ScrollHint := GetScrollHint;
          with ScrollHint do
           begin
            { getting the caption }
            if (SortColumn < 1) or (SortColumn > Items[Pos].SubItems.Count) then
              s := Items[Pos].Caption
            else
              s := Items[Pos].SubItems[SortColumn - 1];
            ScrollHint.Visible := s <> '';
            if not Visible then
             begin
              ActivateHint(Rect(0, 0, 0, 0), '');
              Exit;
             end
            else Color := Application.HintColor;
           end;

          { displaying the hint }
{$IFDEF D3}
          rc := ScrollHint.CalcHintRect(250, s, nil);
{$ELSE}
          rc := Rect(0, 0,
                     ScrollHint.Canvas.TextWidth(s) + 6,
                     ScrollHint.Canvas.TextHeight(s) + 4);
{$ENDIF}
          GetCursorPos(pt);
          pt := ScreenToClient(pt);
          pt := ClientToScreen(Point(ClientWidth - rc.Right - 2, pt.y));
          OffsetRect(rc, pt.x, pt.y);
          ScrollHint.ActivateHint(rc, s);
{$IFNDEF D3}
          ScrollHint.Invalidate;
{$ENDIF}
          ScrollHint.Update;
         end;
      SB_ENDSCROLL:
         with GetScrollHint do
          begin
           Visible := False;          
           ActivateHint(Rect(0, 0, 0, 0), '');
          end;
     end;
end;

procedure TumCustomListView.ColClick(Column: TListColumn);
begin
  if Column.Index = FSortColumn then
    SortDirection := TdcListViewSortDirection(not Boolean(FSortDirection))
  else
    SortColumn := Column.Index;
  inherited;
end;

procedure TumCustomListView.AlignLeftItemClick(Sender: TObject);
begin
  if Assigned(FOldAlignLeftItemClick) then
    FOldAlignLeftItemClick(Sender);

  if (ClickedColumn < 0) or (ClickedColumn >= Columns.Count) or (FHeaderHandle = 0) then Exit;
  Columns[ClickedColumn].Alignment := taLeftJustify;
  AlignmentChanged(Column[ClickedColumn]);
end;

procedure TumCustomListView.AlignRightItemClick(Sender: TObject);
begin
  if Assigned(FOldAlignRightItemClick) then
    FOldAlignRightItemClick(Sender);

  if (ClickedColumn < 0) or (ClickedColumn >= Columns.Count) or (FHeaderHandle = 0) then Exit;
  Columns[ClickedColumn].Alignment := taRightJustify;
  AlignmentChanged(Column[ClickedColumn]);
end;

procedure TumCustomListView.AlignCenterItemClick(Sender: TObject);
begin
  if Assigned(FOldAlignCenterItemClick) then
    FOldAlignCenterItemClick(Sender);

  if (ClickedColumn < 0) or (ClickedColumn >= Columns.Count) or (FHeaderHandle = 0) then Exit;
  Columns[ClickedColumn].Alignment := taCenter;
  AlignmentChanged(Column[ClickedColumn]);
end;

procedure TumCustomListView.AscendingItemClick(Sender: TObject);
begin
  if Assigned(FOldAscendingItemClick) then
    FOldAscendingItemClick(Sender);

  if (ClickedColumn < 0) or (ClickedColumn >= Columns.Count) or (FHeaderHandle = 0) then Exit;

  FSortDirection := sdAscending;
  SortColumn := ClickedColumn;

  if Assigned(OnColumnClick) then
    OnColumnClick(Self, Columns[ClickedColumn]);
end;

procedure TumCustomListView.DescendingItemClick(Sender: TObject);
begin
  if Assigned(FOldDescendingItemClick) then
    FOldDescendingItemClick(Sender);

  if (ClickedColumn < 0) or (ClickedColumn >= Columns.Count) or (FHeaderHandle = 0) then Exit;

  FSortDirection := sdDescending;
  SortColumn := ClickedColumn;

  if Assigned(OnColumnClick) then
    OnColumnClick(Self, Columns[ClickedColumn]);
end;

procedure TumCustomListView.BestFitItemClick(Sender: TObject);
begin
  if Assigned(FOldBestFitItemClick) then
    FOldBestFitItemClick(Sender);

  BestFit;
end;

{$IFDEF D3}
procedure TumCustomListView.SortMarkImageChanged(Sender: TObject);
begin
  if IsPictureNotEmpty(FSortMarkImageAsc) then
    FSortMarkImageAsc.Graphic.Transparent := True;
  if IsPictureNotEmpty(FSortMarkImageDesc) then
    FSortMarkImageDesc.Graphic.Transparent := True;
end;
{$ENDIF}

procedure TumCustomListView.HeaderWndProc(var Message: TMessage);
var
  Pnt: TPoint;
  Column: TListColumn;
{$IFDEF D4}
  ColumnOrder: array of Integer;
{$ENDIF}
  HTI: THDHitTestInfo;
begin
  with Message do
   try
     case Msg of
       WM_MOUSEMOVE: if IsThemeEnabled then
                      begin
                       HTI.Point := Point(LoWord(lParam), HiWord(lParam));

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -