cxlistview.pas

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

  TcxListView = class(TcxCustomListView)
  public
    property ListViewCanvas;
  published
    property Align;
    property AllocBy default 0;
    property Anchors;
    property BiDiMode;
    property Checkboxes;
    property ColumnClick default True;
    property Columns;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property HideSelection default True;
    property HotTrack default False;
    property HoverTime default -1;
    property IconOptions;
  {$IFDEF DELPHI6}
    property ItemIndex;
  {$ENDIF}
    property Items;
    property LargeImages;
    property MultiSelect default False;
    property OwnerData default False;
    property OwnerDraw default False;
    property ParentBiDiMode;
    property ParentColor default False;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly default False;
    property RowSelect default False;
    property ShowColumnHeaders default True;
    property ShowHint;
    property ShowWorkAreas default False;
    property SmallImages;
    property SortType default stNone;
    property StateImages;
    property Style;
    property StyleDisabled;
    property StyleFocused;
    property StyleHot;
    property TabOrder;
    property TabStop;
    property ViewStyle default vsIcon;
    property Visible;
    property OnAdvancedCustomDraw;
    property OnAdvancedCustomDrawItem;
    property OnAdvancedCustomDrawSubItem;
    property OnCancelEdit;
    property OnChange;
    property OnChanging;
    property OnClick;
    property OnColumnClick;
    property OnColumnDragged;
    property OnColumnRightClick;
    property OnCompare;
    property OnContextPopup;
  {$IFDEF DELPHI6}
    property OnCreateItemClass;
  {$ENDIF}
    property OnCustomDraw;
    property OnCustomDrawItem;
    property OnCustomDrawSubItem;
    property OnData;
    property OnDataFind;
    property OnDataHint;
    property OnDataStateChange;
    property OnDblClick;
    property OnDeletion;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnEdited;
    property OnEditing;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetImageIndex;
    property OnGetSubItemImage;
    property OnInfoTip;
    property OnInsert;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnSelectItem;
    property OnStartDock;
    property OnStartDrag;
  end;

implementation

uses
{$IFDEF DELPHI6}
  Variants,
{$ENDIF}
  Graphics, Math, cxLookAndFeelPainters;

{ TcxIconOptions }

constructor TcxIconOptions.Create(AOwner: TPersistent);
begin
  inherited Create;
  Arrangement := iaTop;
  AutoArrange := False;
  WrapText := True;
end;

procedure TcxIconOptions.SetArrangement(Value: TIconArrangement);
begin
  if Value <> Arrangement then
  begin;
    FArrangement := Value;
    if Assigned(FArrangementChange) then FArrangementChange(Self);
  end;
end;

procedure TcxIconOptions.SetAutoArrange(Value: Boolean);
begin
  if Value <> AutoArrange then
  begin
    FAutoArrange := Value;
    if Assigned(FAutoArrangeChange) then FAutoArrangeChange(Self);
  end;
end;

procedure TcxIconOptions.SetWrapText(Value: Boolean);
begin
  if Value <> WrapText then
  begin
    FWrapText := Value;
    if Assigned(FWrapTextChange) then FWrapTextChange(Self);
  end;
end;

{ TcxCustomInnerListView }

constructor TcxCustomInnerListView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanvas := TcxCanvas.Create(inherited Canvas);
  BorderStyle := bsNone;
  ControlStyle := ControlStyle + [csDoubleClicks];
  IconOptions.Arrangement := iaTop;
  IconOptions.AutoArrange := False;
  IconOptions.WrapText := True;
  ParentColor := False;
  ParentFont := True;
  ShowColumnHeaders := True;
  FPressedHeaderItemIndex := -1;
end;

destructor TcxCustomInnerListView.Destroy;
begin
  FreeAndNil(FCanvas);
  if FHeaderHandle <> 0 then
  begin
    SetWindowLong(FHeaderHandle, GWL_WNDPROC, Integer(FDefHeaderProc));
    FHeaderHandle := 0;
  end;
  FreeObjectInstance(FHeaderInstance);
  inherited Destroy;
end;

procedure TcxCustomInnerListView.DefaultHandler(var Message);
begin
  if (Container = nil) or
    not Container.InnerControlDefaultHandler(TMessage(Message)) then
      inherited DefaultHandler(Message);
end;

procedure TcxCustomInnerListView.Loaded;
begin
  inherited;
  Container.UpdateIconOptions;
  FoldHint := Hint;
end;

procedure TcxCustomInnerListView.DragDrop(Source: TObject; X, Y: Integer);
begin
  if Container <> nil then
    Container.DragDrop(Source, Left + X, Top + Y);
end;

procedure TcxCustomInnerListView.Click;
begin
  inherited Click;
  if Container <> nil then
    _TcxContainerAccess.Click(Container);
end;

procedure TcxCustomInnerListView.DblClick;
begin
  inherited DblClick;
  if Container <> nil then
    _TcxContainerAccess.DblClick(Container);
end;

function TcxCustomInnerListView.CanEdit(Item: TListItem): Boolean;
begin
  if Container <> nil then
  begin
    Result := (not Container.ReadOnly) {and (not OwnerData)}; {<- Prevent bug, when Caption not saved after CreateWnd in "OwnerData" mode}
    if Result then
      Result := inherited CanEdit(Item);
  end
  else
    Result := inherited CanEdit(Item);
end;

function TcxCustomInnerListView.DoMouseWheel(Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint): Boolean;
begin
  Result := (Container <> nil) and
    _TcxContainerAccess.DoMouseWheel(Container, Shift, WheelDelta, MousePos);
  if not Result then
    inherited DoMouseWheel(Shift, WheelDelta, MousePos);
end;

procedure TcxCustomInnerListView.DoStartDock(var DragObject: TDragObject);
begin
  _TcxContainerAccess.BeginAutoDrag(Container);
end;

procedure TcxCustomInnerListView.DragOver(Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  if Container <> nil then
    _TcxContainerAccess.DragOver(Container, Source, Left + X, Top + Y, State, Accept);
end;

procedure TcxCustomInnerListView.DoCancelEdit;
begin
  if IsEditing and Assigned(Container) and not Container.IsDestroying and
    Assigned(Container.OnCancelEdit) then
    Container.OnCancelEdit(Container);
end;

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

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

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

procedure TcxCustomInnerListView.DrawHeader;
var
  I: Integer;
begin
  Canvas.Brush.Color := clBtnFace;
  Canvas.Font := Font;
  Canvas.Font.Color := clBtnText;
  for I := 0 to Columns.Count do
    DrawHeaderSection(FHeaderHandle, I, Canvas, Container.LookAndFeel, SmallImages);
end;

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

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

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

procedure TcxCustomInnerListView.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 TcxCustomInnerListView.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift, X, Y);
  if (GetItemAt(X, Y) = nil) then
    Hint := FOldHint;
  if Container <> nil then
    _TcxContainerAccess.MouseMove(Container, Shift, X + Left, Y + Top);
end;

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

procedure TcxCustomInnerListView.CreateParams(var Params: TCreateParams);
begin
  inherited;
  if Container.IconOptions.AutoArrange then
    Params.Style := Params.Style or LVS_AUTOARRANGE
  else
    Params.Style := Params.Style and not LVS_AUTOARRANGE;
  if not Container.ShowColumnHeaders then
    Params.Style := Params.Style or LVS_NOCOLUMNHEADER;
end;

procedure TcxCustomInnerListView.CreateWnd;
begin
  inherited CreateWnd;
  Container.SetScrollBarsParameters;
  Container.AdjustInnerControl;
end;

procedure TcxCustomInnerListView.WndProc(var Message: TMessage);
var
  AHeaderStyle: Integer;
  S: string;
begin
  if (Container <> nil) and Container.InnerControlMenuHandler(Message) then
    Exit;
  inherited WndProc(Message);
  case Message.Msg of
    WM_PAINT:
      Container.UpdateScrollBarsParameters;
    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;

function TcxCustomInnerListView.CanFocus: Boolean;
begin
  Result := Container.CanFocus;
end;

{$IFDEF DELPHI6}
procedure TcxCustomInnerListView.DeleteSelected;
begin
  if Assigned(Container) and (not Container.ReadOnly) then
    inherited DeleteSelected;
end;
{$ENDIF}

function TcxCustomInnerListView.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 TcxCustomInnerListView.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;