cxlistview.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,127 行 · 第 1/5 页

    AHeaderItem.Mask := HDI_WIDTH;
    for I := 0 to AItemIndex - 1 do
    begin
      SendGetStructMessage(FHeaderHandle, HDM_GETITEM, I, AHeaderItem);
      Inc(Result.Left, AHeaderItem.cxy);
    end;
    SendGetStructMessage(FHeaderHandle, HDM_GETITEM, AItemIndex, AHeaderItem);
    Result.Right := Result.Left + AHeaderItem.cxy;
  end;
end;

function TcxCustomInnerListView.GetHeaderPressedItemIndex: Integer;
var
  AHitTestInfo: THDHitTestInfo;
begin
  AHitTestInfo.Point := InternalGetCursorPos;
  Windows.ScreenToClient(FHeaderHandle, AHitTestInfo.Point);
  SendGetStructMessage(FHeaderHandle, HDM_HITTEST, 0, AHitTestInfo);
  if AHitTestInfo.Flags and (HHT_ONDIVIDER or HHT_ONDIVOPEN) <> 0 then
    Result := -1
  else
    Result := AHitTestInfo.Item;
end;

function TcxCustomInnerListView.HeaderItemIndex(AHeaderItem: Integer): Integer;
begin
  Result := AHeaderItem;
  if GetComCtlVersion >= ComCtlVersionIE3 then
    Result := SendMessage(FHeaderHandle, HDM_ORDERTOINDEX, AHeaderItem, 0);
end;

procedure TcxCustomInnerListView.HeaderWndProc(var Message: TMessage);

  procedure CallDefHeaderProc;
  begin
    Message.Result := CallWindowProc(FDefHeaderProc, FHeaderHandle,
      Message.Msg, Message.WParam, Message.LParam);
  end;

var
  ADC: HDC;
  APaintStruct: TPaintStruct;
  R: TRect;
begin
  case Message.Msg of
    WM_ERASEBKGND:
      Message.Result := 1;
    WM_PAINT, WM_PRINTCLIENT:
      begin
        ADC := Message.WParam;
        if ADC = 0 then
          ADC := BeginPaint(FHeaderHandle, APaintStruct);
        try
          Canvas.Canvas.Handle := ADC;
          Canvas.Canvas.Refresh;
          DrawHeader;
        finally
          if Message.WParam = 0 then
            EndPaint(FHeaderHandle, APaintStruct);
        end;
      end;
    WM_LBUTTONDOWN:
    begin
      CallDefHeaderProc;
      if ColumnClick and (GetCapture = FHeaderHandle) then
        FPressedHeaderItemIndex := GetHeaderPressedItemIndex;
    end;
    WM_CAPTURECHANGED:
    begin
      if FPressedHeaderItemIndex <> -1 then
      begin
        R := GetHeaderItemRect(FPressedHeaderItemIndex);
        InvalidateRect(FHeaderHandle, @R, False);
      end;
      FPressedHeaderItemIndex := -1;
      CallDefHeaderProc;
    end;
    CM_GETHEADERITEMINFO:
      Perform(CM_GETHEADERITEMINFO, Message.WParam, Message.LParam);
  else
    CallDefHeaderProc;
  end;
end;

procedure TcxCustomInnerListView.HScrollHandler(Sender: TObject; ScrollCode: TScrollCode;
  var ScrollPos: Integer);
begin
  if ScrollCode = scTrack then
    SendMessage(Handle, LVM_SCROLL, ScrollPos - GetScrollPos(Handle, SB_HORZ), 0)
  else
  begin
    CallWindowProc(DefWndProc, Handle, WM_HSCROLL,
      MakeWParam(Word(ScrollCode), Word(ScrollPos)), Container.HScrollBar.Handle);
    ScrollPos := GetScrollPos(Handle, SB_HORZ);
  end;
end;

procedure TcxCustomInnerListView.VScrollHandler(Sender: TObject; ScrollCode: TScrollCode;
  var ScrollPos: Integer);

  function GetLineHeight: Integer;
  var
    AItemRect: TRect;
  begin
    AItemRect := TopItem.DisplayRect(drBounds);
    Result := AItemRect.Bottom - AItemRect.Top;
  end;

var
  P: TPoint;
begin
  if ScrollCode = scTrack then
    case ViewStyle of
      vsReport:
        SendMessage(Handle, LVM_SCROLL, 0, (ScrollPos - ListView_GetTopIndex(Handle)) * GetLineHeight);
      vsIcon, vsSmallIcon:
        begin
          SendGetStructMessage(Handle, LVM_GETORIGIN, 0, P);
          SendMessage(Handle, LVM_SCROLL, 0, ScrollPos - P.Y);
        end;
    end
  else
  begin
    CallWindowProc(DefWndProc, Handle, WM_VSCROLL, Word(ScrollCode) +
      Word(ScrollPos) shl 16, Container.VScrollBar.Handle);
    ScrollPos := GetScrollPos(Handle, SB_VERT);
  end;
end;

procedure TcxCustomInnerListView.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  inherited;
  if Container <> nil then
    with Message do
    begin
      Result := Result or DLGC_WANTCHARS;
      if GetKeyState(VK_CONTROL) >= 0 then
        Result := Result or DLGC_WANTTAB;
    end;
end;

procedure TcxCustomInnerListView.WMKillFocus(var Message: TWMKillFocus);
begin
  inherited;
  if (Container <> nil) and not Container.IsDestroying then
    Container.FocusChanged;
end;

procedure TcxCustomInnerListView.WMLButtonDown(var Message: TWMLButtonDown);
begin
  inherited;
  if Dragging then
  begin
    CancelDrag;
    Container.BeginDrag(False);
  end;
end;

procedure TcxCustomInnerListView.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
  inherited;
  if not Container.ScrollBarsCalculating then
    Container.SetScrollBarsParameters;
end;

procedure TcxCustomInnerListView.WMNCPaint(var Message: TWMNCPaint);
var
  DC: HDC;
  ABrush: HBRUSH;
begin
  if UsecxScrollBars and Container.HScrollBarVisible and
    Container.VScrollBarVisible then
  begin
    DC := GetWindowDC(Handle);
    ABrush := 0;
    try
      with Container.LookAndFeel do
        ABrush := CreateSolidBrush(ColorToRGB(Painter.DefaultSizeGripAreaColor));
      FillRect(DC, GetSizeGripRect(Self), ABrush);
    finally
      if ABrush <> 0 then
        DeleteObject(ABrush);
      ReleaseDC(Handle, DC);
    end;
  end;
end;

procedure TcxCustomInnerListView.WMNotify(var Message: TWMNotify);
begin
  inherited;
  if Message.NMHdr.code = HDN_ITEMCHANGED then
    Container.SetScrollBarsParameters(True);
end;

procedure TcxCustomInnerListView.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  if (Container <> nil) and not Container.IsDestroying and
    not(csDestroying in ComponentState) and
    (Message.FocusedWnd <> Container.Handle) then
      Container.FocusChanged;
end;

procedure TcxCustomInnerListView.WMWindowPosChanged(var Message: TWMWindowPosChanged);
var
  ARgn: HRGN;
begin
  if not (csDestroying in ComponentState) then
    Container.SetScrollBarsParameters;
  inherited;
  if csDestroying in ComponentState then
    Exit;
  if Container.HScrollBarVisible and Container.VScrollBarVisible then
  begin
    ARgn := CreateRectRgnIndirect(GetSizeGripRect(Self));
    SendMessage(Handle, WM_NCPAINT, ARgn, 0);
    DeleteObject(ARgn);
  end;
end;

procedure TcxCustomInnerListView.CMHintShow(var Message: TCMHintShow);
var
  AInfoTip: string;
  AItem: TListItem;
  AItemRect: TRect;
  AHintInfo: PHintInfo;
begin
  AItem := GetItemAt(Message.HintInfo.CursorPos.X,
    Message.HintInfo.CursorPos.Y);
  if FOldItem = AItem then
    Exit;

  if not Assigned(OnInfoTip) then
  begin
    FOldHint := Hint;
    inherited;
  end
  else
    if AItem <> nil then
    begin
      AInfoTip := AItem.Caption;
      DoInfoTip(AItem, AInfoTip);

      AItemRect := AItem.DisplayRect(drBounds);
      AItemRect.TopLeft := ClientToScreen(AItemRect.TopLeft);
      AItemRect.BottomRight := ClientToScreen(AItemRect.BottomRight);

      AHintInfo := Message.HintInfo;
      AHintInfo.HintStr := AInfoTip;
      AHintInfo.CursorRect := AItemRect;
      AHintInfo.HintPos := Point(
        AHintInfo.CursorRect.Left + GetSystemMetrics(SM_CXCURSOR),
        AHintInfo.CursorRect.Top + GetSystemMetrics(SM_CYCURSOR));
      AHintInfo.HintMaxWidth := ClientWidth;
      Hint := AInfoTip;
    end;
  FOldItem := AItem;
end;

procedure TcxCustomInnerListView.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if Message.lParam = 0 then
    MouseEnter(Self)
  else
    MouseEnter(TControl(Message.lParam));
end;

procedure TcxCustomInnerListView.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if Message.lParam = 0 then
    MouseLeave(Self)
  else
    MouseLeave(TControl(Message.lParam));
end;

procedure TcxCustomInnerListView.CNNotify(
  var Message: TWMNotify);
var
  AItem: PLVItem;
  APrevBrushChangeHandler, APrevFontChangeHandler: TNotifyEvent;
begin
  if Message.NMHdr.code = LVN_ENDLABELEDIT then
  begin
    AItem := @PLVDispInfo(Message.NMHdr)^.item;
    if (AItem.iItem <> -1) then
      if (AItem.pszText <> nil) then
      begin
        if CanChange(Items[AItem.iItem], LVIF_TEXT) then
          Edit(AItem^);
      end
      else
        DoCancelEdit;
  end
  else
    if Message.NMHdr.code = NM_CUSTOMDRAW then
    begin
      APrevBrushChangeHandler := Canvas.Brush.OnChange;
      APrevFontChangeHandler := Canvas.Font.OnChange;
      inherited;
      Canvas.Brush.OnChange := APrevBrushChangeHandler;
      Canvas.Font.OnChange := APrevFontChangeHandler;
    end
    else
      inherited;
end;

procedure TcxCustomInnerListView.LVMGetHeaderItemInfo(var Message: TCMHeaderItemInfo);

  function GetItemState: TcxButtonState;

    function CanHotTrack: Boolean;
    var
      I: Integer;
    begin
      Result := ColumnClick;
      if Result then
        for I := 0 to Columns.Count - 1 do
          if Columns[I].ImageIndex <> -1 then
          begin
            Result := False;
            Break;
          end;
    end;

  var
    AHeaderItemIndex: Integer;
  begin
    if not Parent.Enabled then
      Result := cxbsDisabled
    else
    begin
      AHeaderItemIndex := HeaderItemIndex(Message.Index);
      if AHeaderItemIndex = FPressedHeaderItemIndex then
        Result := cxbsPressed
      else
        if CanHotTrack and (AHeaderItemIndex = GetHeaderHotItemIndex) then
          Result := cxbsHot
        else
          Result := cxbsNormal;
    end;
  end;

  function GetItemRect: TRect;
  var
    R: TRect;
  begin
    if Message.Index = Columns.Count then
    begin
      Windows.GetClientRect(FHeaderHandle, Result);
      if Columns.Count > 0 then
      begin
        R := GetHeaderItemRect(HeaderItemIndex(Columns.Count - 1));
        Result.Left := R.Right;
      end;
    end
    else
      Result := GetHeaderItemRect(HeaderItemIndex(Message.Index));
  end;

var
  AIndex: Integer;
  AHeaderItemInfo: PHeaderItemInfo;
begin
  AIndex := Message.Index;
  AHeaderItemInfo := Message.HeaderItemInfo;
  ZeroMemory(AHeaderItemInfo, SizeOf(THeaderItemInfo));
  if AIndex < Columns.Count then
  begin
    AHeaderItemInfo.ImageIndex := Columns[AIndex].ImageIndex;
    AHeaderItemInfo.SectionAlignment := Columns[AIndex].Alignment;
    AHeaderItemInfo.SortOrder := soNone;
    AHeaderItemInfo.Text := Columns[AIndex].Caption;
  end
  else
    AHeaderItemInfo.ImageIndex := -1;
  AHeaderItemInfo.Rect := GetItemRect;
  AHeaderItemInfo.State := GetItemState;
  Message.HeaderItemInfo := AHeaderItemInfo;
end;

function TcxCustomInnerListView.GetContainer: TcxCustomListView;
begin
  Result := TcxCustomListView(FContainer);
end;

function TcxCustomInnerListView.GetControl: TWinControl;
begin
  Result := Self;
end;

function TcxCustomInnerListView.GetControlContainer: TcxContainer;
begin
  Result := FContainer;
end;

{ TcxCustomListView }

constructor TcxCustomListView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FOwnerDraw := False;
  FIconOptions := TcxIconOptions.Create(Self);
  FIconOptions.FArrangementChange := ArrangementChangeHandler;
  FIconOptions.FAutoArrangeChange := AutoArrangeChangeHandler;
  FIconOptions.FWrapTextChange := WrapTextChangeHandler;
  FInnerListView := GetListViewClass.Create(Self);
  FInnerListView.AutoSize := False;
  FInnerListView.Align := alClient;
  FInnerListView.BorderStyle := bsNone;
  FInnerListView.Parent := Self;
  FInnerListView.FContainer := Self;
  FInnerListView.OwnerDraw := False;
  InnerControl := FInnerListView;
  Width := 121;
  Height := 97;
end;

destructor TcxCustomListView.Destroy;
begin
  FreeAndNil(FInnerListView);
  FreeAndNil(FIconOptions);
  inherited Destroy;
end;