enhlistview.pas

动态提示控件

{$IFNDEF DFS_COMPILER_4_UP}
function TCustomEnhListView.GetItem(Value: TLVItem): TListItem;
begin
  with Value do
    if (mask and LVIF_PARAM) <> 0 then Result := TListItem(lParam)
    else Result := Items[IItem];
end;
{$ENDIF}


{$IFNDEF DFS_COMPILER_4_UP}
type
  THackdfsExtListView = class(TdfsExtListView);
{$ENDIF}
procedure TCustomEnhListView.CNNotify(var Message: TWMNotify);
{$IFNDEF DFS_COMPILER_4_UP}
var
  Item: TListItem;
{$ENDIF}
begin
  inherited;

  with Message.NMHdr^ do
    case code of
{$IFNDEF DFS_FIXED_LIST_VIEW}
      LVN_INSERTITEM:
        if FAutoResort then
          Resort;
{$ENDIF}
      LVN_ENDLABELEDIT:
        with PLVDispInfo(Pointer(Message.NMHdr))^ do
          if (item.pszText = NIL) and (item.IItem <> -1) then
            EditCanceled(item);
{$IFNDEF DFS_COMPILER_4_UP}
      LVN_GETDISPINFO:
        begin
          Item := GetItem(PLVDispInfo(Message.NMHdr)^.item);
          if Item <> NIL then
            with PLVDispInfo(Message.NMHdr)^.item do
            begin
              if (mask and LVIF_IMAGE) <> 0 then
              begin
                if iSubItem = 0 then
                begin
                  GetImageIndex(Item);
                  iImage := Item.ImageIndex;
                  if Assigned(StateImages) then
                  begin
                    state := IndexToStateImageMask(Item.StateIndex + 1);
                    stateMask := $F000;
                    mask := mask or LVIF_STATE;
                  end;
                end;
              end;
            end;
        end;
{$ENDIF}
    end;
end;

procedure TCustomEnhListView.SetAutoColumnSort(Value: TAutoColumnSort);
begin
  if FAutoColumnSort <> Value then
  begin
    FAutoColumnSort := Value;
    if FAutoColumnSort <> acsNoSort then
      Resort;
  end;
end;

procedure TCustomEnhListView.SetAutoSortStyle(Value: TAutoSortStyle);
begin
  if FAutoSortStyle <> Value then
  begin
    FAutoSortStyle := Value;
    Resort;
  end;
end;

procedure TCustomEnhListView.SetAutoResort(Value: boolean);
begin
  if FAutoResort <> Value then
    FAutoResort := Value;
end;

procedure TCustomEnhListView.SetCurrentSortAscending(Value: boolean);
begin
  if FTmpAutoSortAscending <> Value then
  begin
    FTmpAutoSortAscending := Value;
    InvalidateColumnHeader(FLastColumnClicked);
  end;
end;

procedure TCustomEnhListView.SetAutoSortAscending(Value: Boolean);
begin
  if FAutoSortAscending <> Value then
  begin
    FAutoSortAscending := Value;
    FTmpAutoSortAscending := Value;
  end;
end;

procedure TCustomEnhListView.Resort;
begin
  FSortDirty := TRUE;
  if ((FAutoColumnSort <> acsNoSort) and (LastColumnClicked >= 0) and
     (LastColumnClicked < Columns.Count)) or (assigned(FOnSortItems)) then
  begin
    if FUpdateCount < 1 then
      DoSort(LastColumnClicked, FTmpAutoSortAscending);
  end;
end;

procedure TCustomEnhListView.BeginUpdate;
begin
  Items.BeginUpdate;
  inc(FUpdateCount);
end;


procedure TCustomEnhListView.EndUpdate;
begin
  dec(FUpdateCount);
  if FUpdateCount < 0 then
    FUpdateCount := 0; // In case someone gets overly happy with EndUpdate calls
  if FUpdateCount = 0 then
  begin
    // Need to resort?
    if FSortDirty then
      Resort;
  end;

  // Call this last so resort happens before screen redraw is re-enabled.
  Items.EndUpdate;
end;


procedure TCustomEnhListView.DrawItem(var Canvas: TCanvas; Index: Integer;
   Rect: TRect; State: TOwnerDrawState; var DefaultDrawing,
   FullRowSelect: boolean);
begin
  DefaultDrawing := not assigned(FOnDrawItem);
  if assigned(FOnDrawItem) then
    FOnDrawItem(Self, Canvas, Index, Rect, State, DefaultDrawing,FullRowSelect);
end;

procedure TCustomEnhListView.AfterDrawItem(var Canvas: TCanvas; Index: Integer;
   Rect: TRect; State: TOwnerDrawState);
begin
  if assigned(FOnAfterDefaultDrawItem) then
    FOnAfterDefaultDrawItem(Self, Canvas, Index, Rect, State);
end;

procedure TCustomEnhListView.CMSysColorChange(var Message: TWMSysColorChange);
begin
  // Need to recreate the sort arrow bmps to use the new system colors
  if ShowSortArrows then
    CreateSortBmps(FSortUpBmp, FSortDownBmp);
  inherited;
end;

procedure TCustomEnhListView.CMFontChanged(var Messsage: TMessage);
begin
  if HandleAllocated and (Style = lvOwnerDrawFixed) then
    RecreateWnd
  else
    inherited;
end;

procedure TCustomEnhListView.CNMeasureItem(var Message: TWMMeasureItem);
var
  DC: HDC;
  OldFont: HFONT;
  Size: TSize;
begin
  inherited;

  DC := CreateCompatibleDC(0);
  OldFont := SelectObject(DC, Font.Handle);
  try
    GetTextExtentPoint32(DC, 'Wy', 2, Size);
    // Owner drawing only happens in vsReport mode, so no need to check anything
    // besides that.
    // I'm checking SmallImages.Height here, but I don't think it'll do any
    // good.  From what I can tell, if you have SmallImages assigned, this
    // handler will get called but the value you give it is ignored and the
    // list uses it's normal item height.  Strange....
    if assigned(SmallImages) and (SmallImages.Height > Size.cy) then
      Message.MeasureItemStruct.itemHeight := SmallImages.Height
    else
      Message.MeasureItemStruct.itemHeight := Size.cy + 1;
  finally
    SelectObject(DC, OldFont);
    DeleteDC(DC);
  end;
  MeasureItem(Message.MeasureItemStruct.itemHeight);
  Message.Result := 1;
end;

procedure TCustomEnhListView.MeasureItem(var Height: UINT);
begin
  if assigned(FOnMeasureItem) then
    FOnMeasureItem(Self, Height);
end;


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

  with Message.DrawItemStruct^ do
  begin
    {$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;
      FullRowSelect := FALSE;
      ProcessDrawItemMsg(itemID, rcItem, State, DoDefaultDrawing, FullRowSelect);
    finally
      FCanvas.Handle := 0;
      RestoreDC(hDC, SavedDC);
    end;
  end;

  Message.Result := 1;
end;

function TCustomEnhListView.GetActualColumn(Index: integer): TListColumn;
begin
  // Delphi 2 and C++B 1 have a bug in TListColumn.GetWidth.  It returns zero
  // for the width if the handle hasn't been allocated yet instead of returning
  // the value of the internal storage variable like Delphi 3 does.  I've also
  // had some problems similar under Delphi 3, so I'm just always requiring the
  // handle to be valid.
  HandleNeeded;

  if Index >= Columns.Count then
    Result := NIL
  else
    Result := Columns[Index];
end;

function TCustomEnhListView.GetSubItemText(Index, SubItem: integer): string;
begin
  if SubItem < 0 then
    Result := Items[Index].Caption
  else
    Result := Items[Index].SubItems[SubItem];
end;

// SubItem is -1 for Caption item
procedure TCustomEnhListView.DrawSubItem(Index, SubItem: Integer; Rect: TRect;
   State: TOwnerDrawState; var DefaultDrawing: boolean);
begin
  DefaultDrawing := not assigned(FOnDrawSubItem);
  if assigned(FOnDrawSubItem) then
    FOnDrawSubItem(Self, FCanvas, Index, SubItem, Rect, State, DefaultDrawing);
end;

procedure TCustomEnhListView.DefaultDrawSubItem(Index, SubItem: Integer;
   Rect: TRect; State: TOwnerDrawState);
var
  DoDefaultDrawing: boolean;
  SavedDC: integer;
begin
  DoDefaultDrawing := csDesigning in ComponentState;
  SavedDC := SaveDC(FCanvas.Handle);
  try
    if not (csDesigning in ComponentState) then
      DrawSubItem(Index, SubItem, Rect, State, DoDefaultDrawing);

    if DoDefaultDrawing then
    begin
      if SubItem >= 0 then
        InflateRect(Rect, -4, 0);
      if ActualColumn[SubItem+1].Alignment = taLeftJustify then
        Inc(Rect.Left, DefDraw_TextOffset);
      DrawTextEx(FCanvas.Handle, PChar(GetSubItemText(Index, SubItem)), -1, Rect,
         DRAWTEXTEX_FLAGS or
         DRAWTEXTEX_ALIGNMENT[ActualColumn[SubItem+1].Alignment], NIL);
    end;
  finally
    RestoreDC(FCanvas.Handle, SavedDC);
  end;
end;

{$IFDEF DFS_COMPILER_4_UP}
type
  THackImageList = class(TCustomImageList);
{$ENDIF}

procedure TCustomEnhListView.DefaultDrawItem(Index: Integer; Rect: TRect;
   State: TOwnerDrawState; FullRowSelect: boolean);
{$IFDEF DFS_COMPILER_4_UP}
const
  DrawingStyles: array[TDrawingStyle] of Longint = (ILD_FOCUS, ILD_SELECTED,
    ILD_NORMAL, ILD_TRANSPARENT);
  Images: array[TImageType] of Longint = (0, ILD_MASK);
{$ENDIF}
var
{$IFDEF DFS_COMPILER_4_UP}
  DS: TDrawingStyle;
  x: integer;
{$ELSE}
  OldStyle: TDrawingStyle;
{$ENDIF}
  OldBlend: TColor;
  Count: Integer;
  SubRect: TRect;
  ImgTop: integer;
begin
  if Items[Index] = NIL then
    // something bad happening, I'm outta here
    exit;

  if Columns.Count > 0 then
  begin
    if (odSelected in State) then
    begin
      if Focused then
      begin
        FCanvas.Brush.Color := clHighlight;
        FCanvas.Font.Color := clHighlightText;
      end else begin
        if not HideSelection then
        begin
          FCanvas.Brush.Color := clBtnFace;
          FCanvas.Font.Color := clBtnText;
        end;
      end;
    end;
    SubRect := Rect;
    SubRect.Right := Rect.Left + CurrentColumnWidth[0]{ - 2};

    if assigned(StateImages) then
    begin
      StateImages.Draw(FCanvas, SubRect.Left + DefDraw_ImageOffSet,
         SubRect.Top + (SubRect.Bottom - SubRect.Top - StateImages.Height) div 2,
         Items[Index].StateIndex);
      Inc(SubRect.Left, StateImages.Width);
    end;

    if assigned(SmallImages) then
    begin
      OldBlend := SmallImages.BlendColor;
      SmallImages.BlendColor := clHighlight;
      ImgTop := SubRect.Top + (SubRect.Bottom - SubRect.Top -
        SmallImages.Height) div 2;
      {$IFDEF DFS_COMPILER_4_UP}
      { Changing DrawStyle causes an invalidate, which is very nasty since we
        are in the process of repainting here.  Continuous flickering.... }
      if Focused and ((odSelected in State) or Items[Index].Focused) then
        DS := dsSelected
      else
        DS := dsTransparent;
      // Draw OverlayImage
      if (Items[Index].OverlayIndex >= 0) and
         (Items[Index].OverlayIndex <= 3) then // vadid overlay index?
      begin
        x := IndexToOverlayMask(Items[Index].OverlayIndex+1);
        THackImageList(SmallImages).DoDraw(Items[Index].ImageIndex, FCanvas,
           SubRect.Left + DefDraw_ImageOffSet, ImgTop, DrawingStyles[DS] or
           Images[SmallImages.ImageType] or ILD_OVERLAYMASK and x, Enabled);
      end else
        THackImageList(SmallImages).DoDraw(Items[Index].ImageIndex, FCanvas,
           SubRect.Left + DefDraw_ImageOffSet, ImgTop,
           DrawingStyles[DS] or Images[SmallImages.ImageType], Enabled);


      {$ELSE}
      OldStyle := SmallImages.DrawingStyle;
      if Focused and ((odSelected in State) or Items[Index].Focused) then
        SmallImages.DrawingStyle := dsSelected
      else
        SmallImages.DrawingStyle := dsTransparent;

      SmallImages.Draw(FCanvas, SubRect.Left + DefDraw_ImageOffSet, ImgTop,
         Items[Index].ImageIndex);

      // Draw OverlayImage
      if (Items[Index].OverlayIndex >= 0) and
         (Items[Index].OverlayIndex <= 3) then // vadid overlay index?
        SmallImages.DrawOverlay(FCanvas, SubRect.Left + DefDraw_ImageOffSet,
           ImgTop, Items[Index].ImageIndex, Items[Index].OverlayIndex);

      SmallImages.DrawingStyle := OldStyle;
      {$ENDIF}

      SmallImages.BlendColor := OldBlend;
      if ActualColumn[0].Alignment = taLeftJustify then
        Inc(SubRect.Left, {DefDraw_TextOffset + }SmallImages.Width);
{    end else begin
      if ActualColumn[0].Alignment = taLeftJustify then
        Inc(SubRect.Left, DefDraw_TextOffset);}
    end;

    DefaultDrawSubItem(Index, -1, SubRect, State);