dccomctrls.pas

DiskControls.v3.8.Full.Source 控制磁盘的控件 包括源代码

                       SendMessage(FHeaderHandle, HDM_HITTEST, 0, Integer(@HTI));
                       HoverSection := HTI.Item;
                      end;
       WM_MOUSELEAVE: HoverSection := -1; // Does not exists in Win95, but who cares. This made for XP and higher :-)
       WM_SETCURSOR: with FCursors do
                      begin
                       Result := CallWindowProc(FOldHeaderWndProc, FHeaderHandle, Msg, WParam, LParam);

                       if GetCursor = Screen.Cursors[crDefault] then
                        if FHeader <> crDefault then
                          Windows.SetCursor(Screen.Cursors[FCursors.FHeader])
                        else
                       else // Divider
                        if FDivider <> crDefault then
                          Windows.SetCursor(Screen.Cursors[FCursors.FDivider]);
                      Exit;
                     end;
       WM_RBUTTONUP: begin
                      HTI.Point := Point(LoWord(lParam), HiWord(lParam));
                      SendMessage(FHeaderHandle, HDM_HITTEST, 0, Integer(@HTI));
                      if HTI.Item <> -1 then
                        Column := Columns[HTI.Item]
                      else
                        Column := nil;

                      if Column <> nil then
                       with FHeaderMenu do
                        begin
                         ClickedColumn := Column.Index;

                         FDefAscendingItem.Checked := (ClickedColumn = SortColumn) and (SortDirection = sdAscending);
                         FDefDescendingItem.Checked := (ClickedColumn = SortColumn) and (SortDirection = sdDescending);
                         SetItemChecked(FAscendingItem, FDefAscendingItem.Checked);
                         SetItemChecked(FDescendingItem, FDefDescendingItem.Checked);
                         SetItemChecked(FAlignLeftItem, Column.Alignment = taLeftJustify);
                         SetItemEnabled(FAlignLeftItem, Column.Index <> 0);
                         SetItemChecked(FAlignRightItem, Column.Alignment = taRightJustify);
                         SetItemEnabled(FAlignRightItem, Column.Index <> 0);
                         SetItemChecked(FAlignCenterItem, Column.Alignment = taCenter);
                         SetItemEnabled(FAlignCenterItem, Column.Index <> 0);

                         if FShowHeaderMenu then
                          begin
                           Pnt := ClientToScreen(Point(LoWord(lParam), HiWord(lParam)));
                           if Assigned(FPopupMenu) then
                             FPopupMenu.Popup(Pnt.X, Pnt.Y)
                           else
                             FDefaultMenu.Popup(Pnt.X, Pnt.Y);
                           Exit; // don't pass it to the listview                             
                          end;
                        end
                      else ClickedColumn := -1;
                     end;
       WM_CAPTURECHANGED: begin
                           ColumnDragging := False;
{$IFDEF D4}
                           if ColumnDragged then
                            begin
                             ColumnDragged := False;
                             { fire overriden and altered event,
                               see also HDN_ENDDRAG, AK: 11-NOV-2001 }

                             if Assigned(OnColumnDragged) then
                              begin
                               SetLength(ColumnOrder, Columns.Count);
                               ListView_GetColumnOrderArray(Handle, Columns.Count, PInteger(ColumnOrder));
                               OnColumnDragged(Self, ColumnOrder);
                              end;
                            end;
{$ENDIF}
                          end;
       WM_NCDESTROY: begin
                      FRegistrySaver.Save;
                      Result := CallWindowProc(FOldHeaderWndProc, FHeaderHandle, Msg, WParam, LParam);
                      FHeaderHandle := 0;
                      FOldHeaderWndProc := nil;
                      Exit;
                     end;
      end;
     Result := CallWindowProc(FOldHeaderWndProc, FHeaderHandle, Msg, WParam, LParam);
   except
     Application.HandleException(Self);
   end;
end;

procedure TumCustomListView.SetHeaderColor(Value: TColor);
begin
  if FHeaderColor <> Value then
   begin
    FHeaderColor := Value;
    RepaintHeader;
   end;
end;

procedure TumCustomListView.SetHeaderStyle(Value: THeaderStyle);
var
  PrevLong, Long: LongInt;
begin
  FHeaderStyle := Value;
  if FHeaderHandle = 0 then Exit;

  PrevLong := GetWindowLong(FHeaderHandle, GWL_STYLE);
  if FHeaderStyle = hsButtons then
    Long := PrevLong or HDS_BUTTONS
  else
    Long := PrevLong and (not HDS_BUTTONS);

  if PrevLong <> Long then
    SetWindowLong(FHeaderHandle, GWL_STYLE, Long);
end;

procedure TumCustomListView.SetShowSortMark(Value: Boolean);
begin
  if FShowSortMark <> Value then
   begin
    FShowSortMark := Value;
    RepaintHeader;
   end;
end;

procedure TumCustomListView.SetSortDirection(Value: TdcListViewSortDirection);
begin
  if FSortDirection <> Value then
   begin
    FSortDirection := Value;
    RepaintHeader;
    if SortType <> stNone then AlphaSort;
   end;
end;

procedure TumCustomListView.SetSortColumn(Value: Word);
begin
  FSortColumn := Value;
  RepaintHeader;
  if SortType <> stNone then AlphaSort;
end;

procedure TumCustomListView.SetSortMarkAlign(Value: TdcListViewSortMarkAlign);
begin
  if FSortMarkAlign <> Value then
   begin
    FSortMarkAlign := Value;
    RepaintHeader;
   end;
end;

procedure TumCustomListView.SetSortMarkKind(Value: TdcListViewSortMarkKind);
begin
  if FSortMarkKind <> Value then
   begin
    FSortMarkKind := Value;
    RepaintHeader;
   end;
end;

procedure TumCustomListView.SetSortMarkImageAsc(Value: TPicture);
begin
  FSortMarkImageAsc.Assign(Value);
  RepaintHeader;
end;

procedure TumCustomListView.SetSortMarkImageDesc(Value: TPicture);
begin
  FSortMarkImageDesc.Assign(Value);
  RepaintHeader;
end;

function  TumCustomListView.GetSortType: TSortType;
begin
  Result := inherited SortType;
end;

procedure TumCustomListView.SetSortType(Value: TSortType);
begin
  inherited SortType := Value;
  RepaintHeader;
end;

procedure TumCustomListView.SetHoverSection(Value: Integer);
begin
  if FHoverSection <> Value then
   begin
    FHoverSection := Value;
    if IsThemeEnabled then
      RepaintHeader;
   end;
end;

{$IFNDEF D4}
procedure TumCustomListView.ResetExStyles;
var
  Styles: DWORD;
  TempImages: TImageList;
begin
  if HandleAllocated then
   begin
    TempImages := nil;
    if StateImages <> nil then
    begin
      TempImages := StateImages;
      StateImages := nil;
    end;
    Styles := 0;
    {$IFNDEF D3}
    if FGridLines then Styles := Styles or LVS_EX_GRIDLINES;
    if FHotTrack then Styles := Styles or LVS_EX_TRACKSELECT;
    if FRowSelect then Styles := Styles or LVS_EX_FULLROWSELECT;
    {$ENDIF}
    if FFlatScrollBars then Styles := Styles or LVS_EX_FLATSB;
    if FFullDrag then Styles := Styles or LVS_EX_HEADERDRAGDROP;
    if htHandPoint in FHotTrackStyles then
      Styles := Styles or LVS_EX_ONECLICKACTIVATE
    else if FHotTrackStyles * [htUnderlineHot, htUnderlineCold] <> [] then
      Styles := Styles or LVS_EX_TWOCLICKACTIVATE;
    if htUnderlineHot in FHotTrackStyles then
      Styles := Styles or LVS_EX_UNDERLINEHOT;
    if htUnderlineCold in FHotTrackStyles then
      Styles := Styles or LVS_EX_UNDERLINECOLD;
    ListView_SetExtendedListViewStyle(Handle, Styles);
    if TempImages <> nil then
      StateImages := TempImages;
   end;
end;
{$ENDIF}

{$IFNDEF D3}
procedure TumCustomListView.SetGridLines(Value: Boolean);
begin
  if FGridLines <> Value then
   begin
    FGridLines := Value;
    ResetExStyles;
   end;
end;

procedure TumCustomListView.SetHotTrack(Value: Boolean);
begin
  if FHotTrack <> Value then
   begin
    FHotTrack := Value;
    ResetExStyles;
   end;
end;

procedure TumCustomListView.SetRowSelect(Value: Boolean);
begin
  if FRowSelect <> Value then
   begin
    FRowSelect := Value;
    ResetExStyles;
   end;
end;
{$ENDIF}

{$IFNDEF D4}
procedure TumCustomListView.SetFlatScrollBars(Value: Boolean);
begin
  if FFlatScrollBars <> Value then
   begin
    FFlatScrollBars := Value;
    ResetExStyles;
   end;
end;

procedure TumCustomListView.SetFullDrag(Value: Boolean);
begin
  if FFullDrag <> Value then
   begin
    FFullDrag := Value;
    ResetExStyles;
   end;
end;

procedure TumCustomListView.SetHotTrackStyles(Value: TListHotTrackStyles);
begin
  if FHotTrackStyles <> Value then
   begin
    FHotTrackStyles := Value;
    ResetExStyles;
   end;
end;
{$ENDIF}

{$IFNDEF D5}
function  TumCustomListView.GetHoverTime: Integer;
begin
  Result := ListView_GetHoverTime(Handle);
end;

procedure TumCustomListView.SetHoverTime(Value: Integer);
begin
  if Value <> GetHoverTime then
    ListView_SetHoverTime(Handle, Value);
end;
{$ENDIF}

{$IFDEF D4}
procedure TumCustomListView.SetOnCustomDrawSubItemEx(const Value: TdcListViewCustomDrawSubItemExEvent);
begin
  FOnCustomDrawSubItemEx := Value;
  
  if not (csDesigning in ComponentState) then
    if Assigned(Value) then
      OnCustomDrawSubItem := StdOnCustomDrawSubItemHook
    else
      OnCustomDrawSubItem := nil;
end;

procedure TumCustomListView.StdOnCustomDrawSubItemHook(Sender: TCustomListView; Item: TListItem; SubItem: Integer; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  // this is kludge. nothing should happend
end;
{$ENDIF}

procedure TumCustomListView.AlignmentChanged(Column: TListColumn);
begin
  if Assigned(FOnAlignmentChanged) then
    FOnAlignmentChanged(Self, Column);
end;

procedure TumCustomListView.ColumnResizeBegin(Column: TListColumn; var AllowResize: Boolean);
begin
  if Assigned(FOnColumnResizeBegin) then
    FOnColumnResizeBegin(Self, Column, AllowResize);
end;

procedure TumCustomListView.ColumnResizeEnd(Column: TListColumn);
begin
  if Assigned(FOnColumnResizeEnd) then
    FOnColumnResizeEnd(Self, Column);
end;

procedure TumCustomListView.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  MouseX := X;
  MouseY := Y;
  inherited;
end;

function TumCustomListView.GetToolTips: Boolean;
begin
  if csDesigning in ComponentState then
    Result := FShowToolTips
  else
    Result := (SendMessage(Handle, LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0) and LVS_EX_INFOTIP) > 0;
end;

procedure TumCustomListView.SetToolTips(Value: Boolean);
const
  ExtendedStyles: Array[Boolean] of Integer = (0, LVS_EX_INFOTIP);
begin
  FShowToolTips := Value;

  if not (csDesigning in ComponentState) then
    SendMessage(Handle, LVM_SETEXTENDEDLISTVIEWSTYLE,
                LVS_EX_INFOTIP, ExtendedStyles[Value]);
end;

procedure TumCustomListView.SetToolTipOptions(Value: TdcListViewToolTipOptions);
const
  Auto: Array[Boolean] of Integer = (500, 1);
  AutoPop: Array[Boolean] of Integer = (3000, 32000);
var
  ToolTip: HWND;
begin
  if (ttoOffset in Value) and not (ttoOffset in FToolTipOptions) then
    Value := Value - [ttoBelowItem];
  if (ttoBelowItem in Value) and not (ttoBelowItem in FToolTipOptions) then
    Value := Value - [ttoOffset];
  FToolTipOptions := Value;
  
  ToolTip := SendMessage(Handle, LVM_GETTOOLTIPS, 0, 0);
  SendMessage(ToolTip, TTM_SETDELAYTIME, TTDT_AUTOMATIC, Auto[ttoInstantShow in FToolTipOptions]);
  SendMessage(ToolTip, TTM_SETDELAYTIME, TTDT_AUTOPOP, AutoPop[ttoLongStay in FToolTipOptions]);
end;

function  TumCustomListView.GetViewStyle: TViewStyle;
begin
  Result := inherited ViewStyle;
end;

procedure TumCustomListView.SetViewStyle(Value: TViewStyle);
begin
  inherited ViewStyle := Value;
  { bugfix: the listview does not sorts items when ViewStyle changes }
  AlphaSort;
end;

procedure TumCustomListView.WndProc(var Message: TMessage);
var
  Wnd: HWND;
  WinPlace: TWindowPlacement;
  HitTest: TLVHitTestInfo;
  x, y: Integer;
  Item: TListItem;
  ItemBound: TRect;
  CursorPos: TPoint;
  AllowResize: Boolean;
begin
  with Message do
   begin
    case Msg of
      WM_NOTIFY: case PHDNotify(lParam)^.HDR.Code of
                   HDN_BEGINTR