cxtreeview.pas

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

    property Items;
    property Indent;
{$IFDEF DELPHI6}
    property MultiSelect default False;
    property MultiSelectStyle;
{$ENDIF}
    property ReadOnly;
    property RightClickSelect default False;
    property RowSelect default False;
    property ShowButtons default True;
    property ShowLines default True;
    property ShowRoot default True;
    property SortType default stNone;
    property StateImages;
    property ToolTips default True;
{$IFDEF DELPHI6}
    property OnAddition;
    property OnCancelEdit;
{$ENDIF}
{$IFDEF DELPHI5}
    property OnAdvancedCustomDraw;
    property OnAdvancedCustomDrawItem;
{$ENDIF}    
    property OnChange;
    property OnChanging;
    property OnCollapsed;
    property OnCollapsing;
    property OnCompare;
    property OnCustomDraw;
    property OnCustomDrawItem;
    property OnDeletion;
    property OnEditing;
    property OnEdited;
    property OnExpanding;
    property OnExpanded;
    property OnGetImageIndex;
    property OnGetSelectedIndex;
{$IFDEF DELPHI6}
    property OnCreateNodeClass;
{$ENDIF}
  end;

implementation

uses
  Graphics;

{ TcxCustomInnerTreeView }

constructor TcxCustomInnerTreeView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanvas := TcxCanvas.Create(inherited Canvas);
  FItemHeight := -1;
  FLookAndFeel := TcxLookAndFeel.Create(Self);
  BorderStyle := bsNone;
  ControlStyle := ControlStyle + [csDoubleClicks];
  ParentColor := False;
  ParentFont := True;
end;

destructor TcxCustomInnerTreeView.Destroy;
begin
  FreeAndNil(FLookAndFeel);
  FreeAndNil(FCanvas);
  inherited Destroy;
end;

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

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

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

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

procedure TcxCustomInnerTreeView.DestroyWindowHandle;
begin
  FIsRedrawLocked := False;
  inherited DestroyWindowHandle;
end;

function TcxCustomInnerTreeView.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 TcxCustomInnerTreeView.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 TcxCustomInnerTreeView.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 TcxCustomInnerTreeView.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 TcxCustomInnerTreeView.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 TcxCustomInnerTreeView.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 TcxCustomInnerTreeView.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift, X, Y);
  if Container <> nil then
    _TcxContainerAccess.MouseMove(Container, Shift, X + Left, Y + Top);
end;

procedure TcxCustomInnerTreeView.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 TcxCustomInnerTreeView.CreateWindowHandle(const Params: TCreateParams);
begin
  inherited CreateWindowHandle(Params);
  UpdateItemHeight;
  Container.SetScrollBarsParameters;
end;

procedure TcxCustomInnerTreeView.WndProc(var Message: TMessage);
begin
  if (Container <> nil) and Container.InnerControlMenuHandler(Message) then
    Exit;

  if Message.Msg = WM_RBUTTONUP then
  begin
    Container.LockPopupMenu(True);
    try
      inherited WndProc(Message);
    finally
      Container.LockPopupMenu(False);
    end;
    Exit;
  end;

  if ((Message.Msg = WM_LBUTTONDOWN) or (Message.Msg = WM_LBUTTONDBLCLK)) and
    (Container.DragMode = dmAutomatic) and (Container.DragKind = dkDock) and
    not Container.IsDesigning then
  begin
    _TcxContainerAccess.BeginAutoDrag(Container);
    Exit;
  end;

  inherited WndProc(Message);
  case Message.Msg of
    WM_HSCROLL,
    WM_MOUSEWHEEL,
    WM_VSCROLL,
    CM_WININICHANGE,
    TVM_ENSUREVISIBLE,
    TVM_EXPAND,
    TVM_INSERTITEM,
    TVM_SELECTITEM:
      Container.SetScrollBarsParameters;
  end;
end;

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

procedure TcxCustomInnerTreeView.WMFontChange(var Message: TMessage);
begin
  inherited;
  if not Container.ScrollBarsCalculating then
    Container.SetScrollBarsParameters;
end;

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

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

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

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

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

procedure TcxCustomInnerTreeView.HScrollHandler(Sender: TObject; ScrollCode: TScrollCode;
  var ScrollPos: Integer);
begin
  CallWindowProc(DefWndProc, Handle, WM_HSCROLL, Word(ScrollCode) +
    Word(ScrollPos) shl 16, Container.HScrollBar.Handle);
  ScrollPos := GetScrollPos(Handle, SB_HORZ);
end;

procedure TcxCustomInnerTreeView.SetItemHeight(Value: Integer);
begin
  if Value <> FItemHeight then
  begin
    FItemHeight := Value;
    UpdateItemHeight;
  end;
end;

procedure TcxCustomInnerTreeView.SetLookAndFeel(Value: TcxLookAndFeel);
begin
  FLookAndFeel.Assign(Value);
end;

procedure TcxCustomInnerTreeView.VScrollHandler(Sender: TObject; ScrollCode: TScrollCode;
  var ScrollPos: Integer);
var
  AScrollInfo: TScrollInfo;
begin
  if (ScrollCode in [scPosition, scTrack]) and (Win32MajorVersion >= 6) then
  begin
    AScrollInfo.cbSize := SizeOf(AScrollInfo);
    AScrollInfo.fMask := SIF_POS;
    AScrollInfo.nPos := ScrollPos;
    SetScrollInfo(Handle, SB_VERT, AScrollInfo, True);
  end;
  CallWindowProc(DefWndProc, Handle, WM_VSCROLL, Word(ScrollCode) +
    Word(ScrollPos) shl 16, Container.VScrollBar.Handle);
  ScrollPos := GetScrollPos(Handle, SB_VERT);
end;

{$IFNDEF DELPHI6}
function TcxCustomInnerTreeView.GetScrollWidth: Integer;
begin
  Result := SendMessage(Handle, LB_GETHORIZONTALEXTENT, 0, 0);
end;

procedure TcxCustomInnerTreeView.SetScrollWidth(const Value: Integer);
begin
  if Value <> ScrollWidth then
    SendMessage(Handle, LB_SETHORIZONTALEXTENT, Value, 0);
end;
{$ENDIF}

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

procedure TcxCustomInnerTreeView.WMNCPaint(var Message: TWMNCPaint);
var
  DC: HDC;
  ABrush: HBRUSH;
begin
  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;
  if UsecxScrollBars then
  begin
    if Container.HScrollBar.Visible then
      Container.HScrollBar.Repaint;
    if Container.VScrollBar.Visible then
      Container.VScrollBar.Repaint;
  end;
end;

procedure TcxCustomInnerTreeView.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 TcxCustomInnerTreeView.WMSetRedraw(var Message: TWMSetRedraw);
begin
  inherited;
  FIsRedrawLocked := Message.Redraw = 0;
  if not (csDestroying in ComponentState) and not FIsRedrawLocked then
    Container.SetScrollBarsParameters;