📄 dccomctrls.pas
字号:
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 + -