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

📄 enhlistview.pas

📁 动态提示控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:

    // Already done column 0, start at 1.
    for Count := 1 to Columns.Count-1 do
    begin
      { Restore this through each iteration since they may screw with it in
        the OnDrawSubItem event. }
      if not FullRowSelect then
      begin
        FCanvas.Brush.Color := clWindow;
        FCanvas.Font.Color := clWindowText;
      end;

      if Count > Items[Index].SubItems.Count then
        continue; // Hidden item
      if ActualColumn[Count].Alignment = taLeftJustify then
      begin
        SubRect.Left := SubRect.Right;
        SubRect.Right := SubRect.Left + CurrentColumnWidth[Count];
//        Inc(SubRect.Left, DefDraw_TextOffset)
      end else begin
        SubRect.Left := SubRect.Right;// + DefDraw_TextOffset;
        SubRect.Right := SubRect.Left + CurrentColumnWidth[Count];
//        Dec(SubRect.Right, DefDraw_TextOffset);
      end;
      DefaultDrawSubItem(Index, Count-1, SubRect, State);
    end;
  end;
end;


procedure TCustomEnhListView.ProcessDrawItemMsg(Index: Integer; Rect: TRect;
   State: TOwnerDrawState; var DefaultDrawing, FullRowSelect: boolean);
var
  SubRect: TRect;
begin
  DefaultDrawing := csDesigning in ComponentState;
  if not (csDesigning in ComponentState) then
    DrawItem(FCanvas, Index, Rect, State, DefaultDrawing, FullRowSelect);

  if DefaultDrawing then
  begin
    FCanvas.FillRect(Rect);

    if (Index >= 0) then
    begin
      if (odSelected in State) then
      begin
        if (not HideSelection) or Focused then
        begin
          if Focused then
            FCanvas.Brush.Color := clHighlight
          else
            FCanvas.Brush.Color := clBtnFace;

          SubRect := Rect;
//          Inc(SubRect.Left, DefDraw_TextOffset - 2);
//          Dec(SubRect.Left, 2);
          if (not FullRowSelect) then
          begin
            if assigned(Items[Index]) then
              SubRect.Right := SubRect.Left +
                 FCanvas.TextWidth(Items[Index].Caption) + 8;
            if assigned(StateImages) then
              OffsetRect(SubRect, StateImages.Width, 0);
            if assigned(SmallImages) then
              OffsetRect(SubRect, SmallImages.Width, 0);
            // Don't let it go past first column width
            if (Columns.Count > 0) and
               (CurrentColumnWidth[0] < SubRect.Right) then
              SubRect.Right := CurrentColumnWidth[0];
          end else begin
            if assigned(StateImages) then
              Inc(SubRect.Left, StateImages.Width);
            if assigned(SmallImages) then
              Inc(SubRect.Left, SmallImages.Width);
          end;
          FCanvas.FillRect(SubRect);
        end;
      end;
      DefaultDrawItem(Index, Rect, State, FullRowSelect);
      if (odFocused in State) and Focused then
      begin
        SubRect := Rect;
//        Inc(SubRect.Left, DefDraw_TextOffset - 2);
//        Dec(SubRect.Left, 2);
        if (not FullRowSelect) then
        begin
          if assigned(Items[Index]) then
            SubRect.Right := SubRect.Left +
               FCanvas.TextWidth(Items[Index].Caption) + 8;
            if assigned(SmallImages) then
              OffsetRect(SubRect, SmallImages.Width, 0);
            if assigned(StateImages) then
              OffsetRect(SubRect, StateImages.Width, 0);
            // Don't let it go past first column width
            if (Columns.Count > 0) and
               (CurrentColumnWidth[0] < SubRect.Right) then
              SubRect.Right := CurrentColumnWidth[0];
        end else begin
          if assigned(StateImages) then
            Inc(SubRect.Left, StateImages.Width);
          if assigned(SmallImages) then
            Inc(SubRect.Left, SmallImages.Width);
        end;
        FCanvas.DrawFocusRect(SubRect);
      end;
    end else
      FCanvas.FillRect(Rect);

    if (not (csDesigning in ComponentState)) then
      AfterDrawItem(FCanvas, Index, Rect, State);
  end;
end;


procedure TCustomEnhListView.SetStyle(Value: TLVStyle);
begin
  if FStyle <> Value then
  begin
    FStyle := Value;
    if HandleAllocated then
      RecreateWnd;
  end;
end;

procedure TCustomEnhListView.SetReverseSortArrows(Value: boolean);
begin
  if Value <> FReverseSortArrows then
  begin
    FReverseSortArrows := Value;
    if ShowSortArrows then
    begin
      CreateSortBmps(FSortUpBmp, FSortDownBmp);
      InvalidateColumnHeader(FLastColumnClicked);
    end;
  end;
end;

procedure TCustomEnhListView.SetShowSortArrows(Value: boolean);
begin
  if Value <> FShowSortArrows then
    FShowSortArrows := Value;
  FSortUpBmp.Free;
  FSortDownBmp.Free;
  if FShowSortArrows then
  begin
    FSortUpBmp := TBitmap.Create;
    FSortDownBmp := TBitmap.Create;
    CreateSortBmps(FSortUpBmp, FSortDownBmp);
    if not (csReading in ComponentState) then
      SetColumnsOwnerDrawFlag(TRUE);
  end else begin
    FSortUpBmp := NIL;
    FSortDownBmp := NIL;

    if not (csReading in ComponentState) then
      SetColumnsOwnerDrawFlag(assigned(FOnDrawHeader))
  end;
  if HandleAllocated then
    Invalidate;
end;

procedure TCustomEnhListView.CreateSortBmps(var UpBmp, DownBmp: TBitmap);
var
  HeaderHeight: integer;
  MidPoint: integer;
  Bmp: TBitmap;
begin
  if UpBmp = NIL then
    UpBmp := TBitmap.Create;
  if DownBmp = NIL then
    DownBmp := TBitmap.Create;

  UpBmp.Canvas.Font.Assign(Font);
  HeaderHeight := UpBmp.Canvas.TextHeight('Wy') - 6;
  if HeaderHeight > 0 then
  begin
    if Odd(HeaderHeight) then
      Inc(HeaderHeight);
    UpBmp.Width := HeaderHeight;
    UpBmp.Height := HeaderHeight;
    DownBmp.Width := HeaderHeight;
    DownBmp.Height := HeaderHeight;
    MidPoint := HeaderHeight div 2;

    { Don't ask about the drawing.  I just fooled around until I got
      something I liked. }
    if FReverseSortArrows then
      Bmp := UpBmp
    else
      Bmp := DownBmp;
    with Bmp.Canvas do
    begin
      Brush.Color := clBtnFace;
      FillRect(Rect(0, 0, HeaderHeight, HeaderHeight));
      Pen.Color := clBtnShadow;
      MoveTo(MidPoint, HeaderHeight-2);
      LineTo(HeaderHeight-1, 0);
      Pixels[HeaderHeight-1, 0] := Pen.Color;
      Pen.Color := clBtnHighlight;
      MoveTo(HeaderHeight-2, 0);
      LineTo(0, 0);
      LineTo(MidPoint-1, HeaderHeight-2);
      Pixels[MidPoint-1, HeaderHeight-2] := Pen.Color;
    end;

    if FReverseSortArrows then
      Bmp := DownBmp
    else
      Bmp := UpBmp;
    with Bmp.Canvas do
    begin
      Brush.Color := clBtnFace;
      FillRect(Rect(0, 0, HeaderHeight, HeaderHeight));
      Pen.Color := clBtnHighlight;
      MoveTo(0, HeaderHeight-1);
      LineTo(MidPoint-1, 0);
      Pen.Color := clBtnShadow;
      MoveTo(MidPoint, 0);
      LineTo(HeaderHeight-1, HeaderHeight-1);
      LineTo(-1, HeaderHeight-1);
      Pixels[MidPoint, 0] := clBtnFace;
    end;
  end;
end;

procedure TCustomEnhListView.DestroyWnd;
begin
  if not FCreatingWindowHandle then
  begin
    inherited DestroyWnd;

    FHeaderHandle := 0;
  end;
end;

procedure TCustomEnhListView.DrawHeader(var Canvas: TCanvas; Index: Integer;
   var Rect: TRect; Selected: boolean; var DefaultDrawing: boolean);
begin
  DefaultDrawing := not assigned(FOnDrawHeader);
  if assigned(FOnDrawHeader) then
    FOnDrawHeader(Self, Canvas, Index, Rect, Selected, DefaultDrawing);
end;

procedure TCustomEnhListView.WMNotify(var Message: TWMNotify);
const
  RECURSE_FLAG: boolean = FALSE;
begin
  if NoColumnResize then
    case Message.NMHdr.code of
      HDN_BEGINTRACK, HDN_TRACK, HDN_BEGINTRACKW, HDN_TRACKW:
      begin
        Message.Result := 1;
        exit;
      end;
    end;

  inherited;
  // Note the recursion flag.  This is needed since the SetColumnsOwnerDrawFlag
  // call below will cause some HDN_xxx notification messages.
  if RECURSE_FLAG then
    exit;

  // For some reason, the SECOND time you drag a header width, it toasts the
  // column index in the draw item message.  Also seems to reset owner draw
  // info at times, too.  Anyway, the best fix I could come up with was to
  // always reset the owner draw flag.
  case Message.NMHdr.code of
    HDN_BEGINTRACK, HDN_ITEMCHANGED, HDN_BEGINTRACKW, HDN_ITEMCHANGEDW:
      begin
        if Message.NMHdr.code <> HDN_TRACK then
        begin
          RECURSE_FLAG := TRUE;
          try
            SetColumnsOwnerDrawFlag(assigned(FOnDrawHeader) or FShowSortArrows);
          finally
            RECURSE_FLAG := FALSE;
          end;
        end;
      end;
    HDN_DIVIDERDBLCLICK, HDN_DIVIDERDBLCLICKW:
      { D4 (and others probably) don't update column width when this happens. }
      begin
        with PHDNotify(Pointer(Message.NMHdr))^ do
          if Item < Columns.Count then
            {$IFDEF DFS_COMPILER_4_UP}
            Column[Item].Width :=
            {$ELSE}
            ActualColumn[Item].Width :=
            {$ENDIF}
              ListView_GetColumnWidth(Handle, Item);
      end;
  end;

(*  old way.  had some performance problems when used in conjunction with
    TToolbar97 component.  No idea why that would cause it, though.
  // For some reason, the SECOND time you drag a header width, it toasts the
  // column index in the draw item message.  Also seems to reset owner draw
  // info at times, too.  Anyway, the best fix I could come up with was to
  // always watch for a change in the header handle, and always reset the owner
  // draw flag.  Note the recursion flag.  This is needed since the
  // SetColumnsOwnerDrawFlag will cause some HDN_xxx notification messages.

  // Best way that I can find to snag the real header handle.  Kludgy at best,
  // but what else are you gonna do?
  case Message.NMHdr.code of
    HDN_LAST..HDN_FIRST:
      begin
        if Message.NMHdr.hwndFrom <> FHeaderHandle then
          FHeaderHandle := Message.NMHdr^.hwndFrom;

        if RECURSE_FLAG or (FUpdateCount > 0) then exit;

        RECURSE_FLAG := TRUE;
        try
          SetColumnsOwnerDrawFlag(assigned(FOnDrawHeader) or FShowSortArrows);
        finally
          RECURSE_FLAG := FALSE;
        end;
      end;
  end;
*)
end;

procedure TCustomEnhListView.WMDrawHeader(var Message: TWMDrawItem);
var
  State: TOwnerDrawState;
  DoDefaultDrawing: boolean;
  SavedDC: integer;
begin { CNDrawItem }
  if FCanvas = NIL then exit;

  with Message.DrawItemStruct^ do
  begin
    Message.Result := 1;
    {$IFDEF DFS_COMPILER_5_UP}
    State := TOwnerDrawState(LongRec(itemState).Lo);
    {$ELSE}
    State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
    {$ENDIF}
    SavedDC := SaveDC(hDC);
    FCanvas.Handle := hDC;
    try
      FCanvas.Font := Font;
      FCanvas.Brush := Brush;
      DoDefaultDrawing := FALSE;
      ProcessDrawHeaderMsg(itemID, rcItem, State, DoDefaultDrawing);
    finally
      FCanvas.Handle := 0;
      RestoreDC(hDC, SavedDC);
    end;
  end;
end;

procedure TCustomEnhListView.ProcessDrawHeaderMsg(Index: Integer; Rect: TRect;
   State: TOwnerDrawState; var DefaultDrawing: boolean);
begin
  FCanvas.Font.Assign(Font);
  FCanvas.Brush.Assign(Brush);
  FCanvas.Brush.Style := bsClear;
  FCanvas.Brush.Color := clBtnFace;

  DefaultDrawing := csDesigning in ComponentState;
  if not (csDesigning in ComponentState) then
    DrawHeader(FCanvas, Index, Rect, odSelected in State, DefaultDrawing);

  if DefaultDrawing then
    DefaultDrawHeader(FCanvas, Index, Rect, odSelected in State);
end;

procedure TCustomEnhListView.DefaultDrawHeader(var Canvas: TCanvas;
   Index: Integer; var Rect: TRect; Selected: boolean);
var
  TheColumn: TListColumn;
  Offset: integer;
  R, CR: TRect;
  Bmp: TBitmap;
begin

(******************************************************************************)
(* NOTE:  This method is overriden and replaced in TExtListView.  That means  *)
(*   that if changes are made here, they will also need to be made in         *)
(*   ExtListView.pas' DefaultDrawHeader method.                               *)
(******************************************************************************)

  if not Selected then
    InflateRect(Rect, -2, -2);
  Canvas.FillRect(Rect);
  if Selected then
    InflateRect(Rect, -2, -2);

  if (Index >= 0) and (Index < Columns.Count) then
  begin
    // Don't use ActualColumn[] here!  That's for SubItem foolery, not header.
    TheColumn := Columns[Index];

    if Selected then
    begin
      inc(Rect.Top);
      inc(Rect.Left);
    end;

    R := Rect;

    case TheColumn.Alignment of
      taRightJustify:
        Dec(R.Right, 4);
      taLeftJustify:
        Inc(R.Left, 4);
      // taCenter needs no mo

⌨️ 快捷键说明

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