cxshelllistview.pas

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

end;

procedure TcxInnerShellListView.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if Container <> nil then
    Container.KeyDown(Key, Shift);
  if Key <> 0 then
    inherited KeyDown(Key, Shift);
end;

procedure TcxInnerShellListView.KeyPress(var Key: Char);
begin
  if Key = Char(VK_TAB) then
    Key := #0;
  if Container <> nil then
    Container.KeyPress(Key);
  if Word(Key) = VK_RETURN then
    Key := #0;
  if Key <> #0 then
    inherited KeyPress(Key);
end;

procedure TcxInnerShellListView.KeyUp(var Key: Word; Shift: TShiftState);
begin
  if Key = VK_TAB then
    Key := 0;
  if Container <> nil then
    Container.KeyUp(Key, Shift);
  if Key <> 0 then
    inherited KeyUp(Key, Shift);
end;

procedure TcxInnerShellListView.LookAndFeelChanged(Sender: TcxLookAndFeel;
  AChangedValues: TcxLookAndFeelValues);
begin
  if FHeaderHandle <> 0 then
    InvalidateRect(FHeaderHandle, nil, False);
end;

procedure TcxInnerShellListView.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if Container <> nil then
    with Container do
    begin
      InnerControlMouseDown := True;
      try
        MouseDown(Button, Shift, X + Self.Left, Y + Self.Top);
      finally
        InnerControlMouseDown := False;
      end;
    end;
end;

procedure TcxInnerShellListView.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift, X, Y);
  if Container <> nil then
    Container.MouseMove(Shift, X + Left, Y + Top);
end;

procedure TcxInnerShellListView.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if Container <> nil then
    Container.MouseUp(Button, Shift, X + Left, Y + Top);
end;

procedure TcxInnerShellListView.Navigate(APIDL: PItemIDList);
begin
  inherited Navigate(APIDL);
  if HandleAllocated then
  begin
    SendMessage(Handle, WM_HSCROLL, MakeWParam(SB_LEFT, 0), 0);
    SendMessage(Handle, WM_VSCROLL, MakeWParam(SB_TOP, 0), 0);
  end;
end;

procedure TcxInnerShellListView.WndProc(var Message: TMessage);
var
  AHeaderStyle: Integer;
  S: string;
begin
  if (Container <> nil) and Container.InnerControlMenuHandler(Message) then
    Exit;

{$IFNDEF DELPHI5}
  if Message.Msg = WM_RBUTTONDOWN then
  begin
    Container.LockPopupMenu(True);
    try
      inherited WndProc(Message);
    finally
      Container.LockPopupMenu(False);
    end;
    Exit;
  end;
{$ENDIF}

  if Container <> nil then
    if ((Message.Msg = WM_LBUTTONDOWN) or (Message.Msg = WM_LBUTTONDBLCLK)) and
      (Container.DragMode = dmAutomatic) and not Container.IsDesigning then
    begin
      Container.BeginAutoDrag;
      Exit;
    end;

  inherited WndProc(Message);
  case Message.Msg of
    DSM_NOTIFYUPDATECONTENTS,
    DSM_NOTIFYUPDATE,
    WM_HSCROLL,
    WM_MOUSEWHEEL,
    WM_VSCROLL,
    WM_WINDOWPOSCHANGED,
    CM_WININICHANGE,
    LVM_SETITEMCOUNT:
      Container.SetScrollBarsParameters;
    WM_SETREDRAW:
      if Message.WParam <> 0 then
        Container.SetScrollBarsParameters;
    WM_PARENTNOTIFY:
      if Message.WParamLo = WM_CREATE then
      begin
        SetLength(S, 80);
        SetLength(S, GetClassName(Message.LParam, PChar(S), Length(S)));
        if S = 'SysHeader32' then
        begin
          FHeaderHandle := Message.LParam;
          FHeaderInstance := MakeObjectInstance(HeaderWndProc);
          FDefHeaderProc := Pointer(SetWindowLong(FHeaderHandle, GWL_WNDPROC, Integer(FHeaderInstance)));
          AHeaderStyle := GetWindowLong(FHeaderHandle, GWL_STYLE);
          SetWindowLong(FHeaderHandle, GWL_STYLE, AHeaderStyle or HDS_HOTTRACK);
        end;
      end;
  end;
end;

procedure TcxInnerShellListView.ChangeHandler(Sender: TObject; AItem: TListItem;
  AChange: TItemChange);
begin
  if AItem <> nil then
    try
      if Assigned(FOnChange) then
        FOnChange(Sender, AItem, AChange);
    finally
      Container.SetScrollBarsParameters;
    end;
end;

procedure TcxInnerShellListView.MouseEnter(AControl: TControl);
begin
end;

procedure TcxInnerShellListView.MouseLeave(AControl: TControl);
begin
  if Container <> nil then
    Container.ShortRefreshContainer(True);
end;

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

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

function TcxInnerShellListView.GetHeaderHotItemIndex: Integer;
var
  AHitTestInfo: THDHitTestInfo;
begin
  if WindowFromPoint(InternalGetCursorPos) <> FHeaderHandle then
  begin
    Result := -1;
    Exit;
  end;

  AHitTestInfo.Point := InternalGetCursorPos;
  Windows.ScreenToClient(FHeaderHandle, AHitTestInfo.Point);
  SendGetStructMessage(FHeaderHandle, HDM_HITTEST, 0, AHitTestInfo);
  Result := AHitTestInfo.Item;
end;

function TcxInnerShellListView.GetHeaderItemRect(AItemIndex: Integer): TRect;
var
  AHeaderItem: THDItem;
  I: Integer;
  R: TRect;
begin
  if GetComCtlVersion >= ComCtlVersionIE3 then
    SendGetStructMessage(FHeaderHandle, HDM_GETITEMRECT, AItemIndex, Result)
  else
  begin
    Result.Top := 0;
    GetWindowRect(FHeaderHandle, R);
    Result.Bottom := R.Bottom - R.Top;
    Result.Left := 0;
    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 TcxInnerShellListView.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 TcxInnerShellListView.HeaderItemIndex(AHeaderItem: Integer): Integer;
begin
  Result := AHeaderItem;
  if GetComCtlVersion >= ComCtlVersionIE3 then
    Result := SendMessage(FHeaderHandle, HDM_ORDERTOINDEX, AHeaderItem, 0);
end;

procedure TcxInnerShellListView.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 TcxInnerShellListView.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;

procedure TcxInnerShellListView.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 TcxInnerShellListView.WMKillFocus(var Message: TWMKillFocus);
begin
  inherited;
  if (Container <> nil) and not Container.IsDestroying then
    Container.FocusChanged;
end;

procedure TcxInnerShellListView.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
  inherited;
  if UsecxScrollBars and not Container.FScrollBarsCalculating then
    Container.SetScrollBarsParameters;
end;

procedure TcxInnerShellListView.WMNCPaint(var Message: TMessage);
var
  DC: HDC;
  ABrush: HBRUSH;
begin
  if not UsecxScrollBars then
  begin
    inherited;    
    Exit;
  end;

  Message.Result := 1;
  if UsecxScrollBars and Container.HScrollBar.Visible and Container.VScrollBar.Visible 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 TcxInnerShellListView.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 TcxInnerShellListView.WMWindowPosChanged(var Message: TWMWindowPosChanged);
var
  ARgn: HRGN;
begin
  inherited;
  if csDestroying in ComponentState then
    Exit;
  if Container.HScrollBar.Visible and Container.VScrollBar.Visible then
  begin
    ARgn := CreateRectRgnIndirect(GetSizeGripRect(Self));
    SendMessage(Handle, WM_NCPAINT, ARgn, 0);
    DeleteObject(ARgn);
  end;
end;

procedure TcxInnerShellListView.CMMouseEnter(var Message: TMessage);
begin
  inherited;