cxmclistbox.pas

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

  FInnerHeader.ResizeUpdate := False;

  FInnerListBox := TcxMCInnerListBox.Create(FInnerPanel);
  FInnerListBox.ParentColor := True;
  FInnerListBox.Parent := FInnerPanel;
  FInnerListBox.Cursor := Cursor;
  FInnerListBox.BorderStyle := bsNone;
  FInnerListBox.Container := Self;
  FInnerListBox.LookAndFeel.MasterLookAndFeel := Style.LookAndFeel;
  FInnerListBox.Style := lbOwnerDrawVariable;
  FInnerListBox.OnMeasureItem := MeasureItem;
  FInnerListBox.OnDrawItem := DrawItem;
  FSavedHScroll := FInnerListBox.HScrollBar.OnScroll;
  FInnerListBox.HScrollBar.OnScroll := HScrollHandler;

  DataBinding.VisualControl := FInnerListBox;
end;

destructor TcxMCListBox.Destroy;
begin
  FreeAndNil(FInnerListBox);
  FreeAndNil(FInnerHeader);
  FreeAndNil(FInnerPanel);
  FreeAndNil(FDataBinding);
  FreeAndNil(FOverLoadList);
  inherited Destroy;
end;

function TcxMCListBox.Focused: Boolean;
begin
  Result := inherited Focused or InnerListBox.Focused or FInnerHeader.Focused;
end;

procedure TcxMCListBox.AddItem(AItem: string; AObject: TObject);
begin
  Items.AddObject(AItem, AObject);
end;

procedure TcxMCListBox.Clear;
begin
  Items.Clear;
end;

procedure TcxMCListBox.ClearSelection;
begin
  FInnerListBox.ClearSelection;
end;

procedure TcxMCListBox.DeleteSelected;
begin
  FInnerListBox.DeleteSelected;
end;

function TcxMCListBox.ItemAtPos(const APos: TPoint; AExisting: Boolean): Integer;
begin
  Result := FInnerListBox.ItemAtPos(APos, AExisting);
end;

function TcxMCListBox.ItemRect(Index: Integer): TRect;
begin
  Result := FInnerListBox.ItemRect(Index);
end;

function TcxMCListBox.ItemVisible(Index: Integer): Boolean;
begin
  Result := FInnerListBox.ItemVisible(Index);
end;

procedure TcxMCListBox.SelectAll;
begin
  FInnerListBox.SelectAll;
end;

{$IFDEF DELPHI6}
procedure TcxMCListBox.CopySelection(ADestination: TCustomListControl);
begin
  FInnerListBox.CopySelection(ADestination);
end;

procedure TcxMCListBox.MoveSelection(ADestination: TCustomListControl);
begin
  FInnerListBox.MoveSelection(ADestination);
end;
{$ENDIF}

procedure TcxMCListBox.CreateWnd;
var
  FSection: TcxHeaderSection;
begin
  inherited;
  if not FInternalFlagCreatedHeader then
  begin
    FInternalFlagCreatedHeader := True;
    if (FInnerHeader.Sections.Count = 0) then
    begin
      FSection := FInnerHeader.Sections.Add;
      FSection.Text := 'Section #1';
      FSection.Width := FInnerHeader.Canvas.TextWidth(FSection.Text) + 4;
    end;
  end;
end;

procedure TcxMCListBox.CursorChanged;
begin
  inherited CursorChanged;
  if FInnerListBox <> nil then
    FInnerListBox.Cursor := Cursor;
end;

procedure TcxMCListBox.FontChanged;
begin
  inherited;
  FullRepaint;
  _TWinControlAccess._RecreateWnd(FInnerListBox);
end;

procedure TcxMCListBox.AdjustInnerControl;
var
  AFont: TFont;
begin
  FInnerHeader.Font := ActiveStyle.GetVisibleFont;

  FInnerListBox.Color := ViewInfo.BackgroundColor;
  AFont := TFont.Create;
  try
    AFont.Assign(Style.GetVisibleFont);
    AFont.Color := ActiveStyle.GetVisibleFont.Color;
    FInnerListBox.Font := AFont;
  finally
    AFont.Free;
  end;
end;

procedure TcxMCListBox.DataChange;
begin
  if DataBinding.IsDataSourceLive then
    ItemIndex := Items.IndexOf(VarToStr(DataBinding.GetStoredValue(evsText, Focused)))
  else
    ItemIndex := -1;
end;

procedure TcxMCListBox.DoExit;
begin
  if IsDestroying or FIsExitProcessing then
    Exit;
  FIsExitProcessing := True;
  try
    try
      DataBinding.UpdateDataSource;
    except
      SetFocus;
      raise;
    end;
    inherited DoExit;
  finally
    FIsExitProcessing := False;
  end;
end;

function TcxMCListBox.ExecuteAction(Action: TBasicAction): Boolean;
begin
  Result := inherited ExecuteAction(Action) or
    FDataBinding.ExecuteAction(Action);
end;

procedure TcxMCListBox.GetTabOrderList(List: TList);
var
  AActiveControl: TWinControl;
begin
  AActiveControl := GetParentForm(Self).ActiveControl;
  if (AActiveControl <> Self) and CanFocus and (InnerListBox = AActiveControl) then
  begin
    List.Add(InnerListBox);
    List.Remove(Self);
  end;
end;

function TcxMCListBox.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action) or
    FDataBinding.UpdateAction(Action);
end;

function TcxMCListBox.IsInternalControl(AControl: TControl): Boolean;
begin
  if FInnerListBox = nil then
    Result := True
  else
    Result := (AControl = FInnerListBox.HScrollBar) or (AControl = FInnerListBox.VScrollBar);
  Result := Result or inherited IsInternalControl(AControl);
end;

function TcxMCListBox.IsReadOnly: Boolean;
begin
  Result := DataBinding.IsControlReadOnly;
end;

procedure TcxMCListBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  case Key of
    VK_PRIOR, VK_NEXT, VK_END, VK_HOME, VK_LEFT, VK_UP, VK_RIGHT, VK_DOWN:
      if not DataBinding.SetEditMode then
        Key := 0;
  end;
end;

procedure TcxMCListBox.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  if IsTextChar(Key) and not DataBinding.SetEditMode then
    Key := #0
  else
    if Key = Char(VK_ESCAPE) then
      DataBinding.Reset;
end;

procedure TcxMCListBox.Loaded;
begin
  inherited;
  FontChanged;
end;

function TcxMCListBox.RefreshContainer(const P: TPoint; Button: TcxMouseButton;
  Shift: TShiftState; AIsMouseEvent: Boolean): Boolean;
begin
  Result := inherited RefreshContainer(P, Button, Shift, AIsMouseEvent);
end;

procedure TcxMCListBox.UpdateData;
begin
  if ItemIndex >= 0 then
    DataBinding.SetStoredValue(evsText, Items[ItemIndex])
  else
    DataBinding.SetStoredValue(evsText, '');
end;

function TcxMCListBox.CanResize(var NewWidth, NewHeight: Integer): Boolean;
begin
  Result := inherited CanResize(NewWidth, NewHeight);
  if not Result or not IntegralHeight or IsLoading then
    Exit;
  if Align in [alLeft, alRight, alClient] then
    Exit;
  GetOptimalHeight(NewHeight);
end;

procedure TcxMCListBox.SetSize;
var
  ANewHeight: Integer;
  APrevBoundsRect: TRect;
begin
  if IsLoading then
    Exit;
  APrevBoundsRect := FInnerListBox.BoundsRect;
  try
    if not IntegralHeight or (Align in [alLeft, alRight, alClient]) then
    begin
      inherited SetSize;
      Exit;
    end;
    ANewHeight := Height;
    GetOptimalHeight(ANewHeight);
    if Height >= (FInnerHeader.Height + 2) then
      Height := ANewHeight
    else
      Height := FInnerHeader.Height + 2;
    inherited SetSize;
  finally
    if not EqualRect(APrevBoundsRect, FInnerListBox.BoundsRect) and
      FInnerListBox.HandleAllocated then
        KillMessages(FInnerListBox.Handle, WM_MOUSEMOVE, WM_MOUSEMOVE);
  end;
end;

procedure TcxMCListBox.WndProc(var Message: TMessage);
begin
  if FInnerListBox <> nil then
    case Message.Msg of
      LB_ADDSTRING .. LB_MSGMAX:
        begin
          with Message do
            Result := SendMessage(FInnerListBox.Handle, Msg, WParam, LParam);
          Exit;
        end;
    end;
  inherited WndProc(Message);
end;

function TcxMCListBox.GetDataBindingClass: TcxCustomDataBindingClass;
begin
  Result := TcxCustomDataBinding;
end;

procedure TcxMCListBox.GetOptimalHeight(var ANewHeight: Integer);

  function GetItemHeight(AIndex: Integer): Integer;
  begin
    case FInnerListBox.Style of
      lbStandard{$IFDEF DELPHI6}, lbVirtual{$ENDIF}:
        Result := Canvas.FontHeight(Font);
      lbOwnerDrawFixed{$IFDEF DELPHI6}, lbVirtualOwnerDraw{$ENDIF}:
        Result := ItemHeight;
      lbOwnerDrawVariable:
        begin
          Result := ItemHeight;
          if (AIndex < Count) and Assigned(FInnerListBox.OnMeasureItem) then
            FInnerListBox.OnMeasureItem(Self, AIndex, Result);
        end;
    end;
  end;

var
  I: Integer;
  ABorderExtent: TRect;
  AItemHeight: Integer;
  AListClientSize, AListSize, AScrollBarSize: TSize;
  AScrollWidth: Integer;
  AVScrollBar: Boolean;
begin
  ABorderExtent := GetBorderExtent;
  AListClientSize.cy := ABorderExtent.Top + ABorderExtent.Bottom;
  AScrollBarSize := GetScrollBarSize;
  AScrollWidth := ScrollWidth;
  if AScrollWidth > 0 then
  Inc(AScrollWidth, 4);
  I := FInnerHeader.Height;
  repeat
    AItemHeight := GetItemHeight(I);
    AListClientSize.cy := AListClientSize.cy + AItemHeight;
    AListSize.cy := AListClientSize.cy;
    AListClientSize.cx := Width - (ABorderExtent.Left + ABorderExtent.Right);
    AVScrollBar := I + 1 < Count;
    if AVScrollBar then
      AListClientSize.cx := AListClientSize.cx - AScrollBarSize.cx;
    if AListClientSize.cx < AScrollWidth then
      AListSize.cy := AListSize.cy + AScrollBarSize.cy;
    if AListSize.cy = ANewHeight then
      Break;
    if AListSize.cy > ANewHeight then
    begin
      if I > 0 then
      begin
        AListClientSize.cy := AListClientSize.cy - AItemHeight;
        AListSize.cy := AListClientSize.cy;
        AListClientSize.cx := Width - (ABorderExtent.Left + ABorderExtent.Right);
        AVScrollBar := I < Count;
        if AVScrollBar then
          AListClientSize.cx := AListClientSize.cx - AScrollBarSize.cx;
        if AListClientSize.cx < AScrollWidth then
          AListSize.cy := AListSize.cy + AScrollBarSize.cy;
      end;
      Break;
    end;
    Inc(I);
  until False;
  ANewHeight := AListSize.cy;
end;

function TcxMCListBox.CalcCellTextRect(AApproximateRect: TRect; AItemIndex, AColumnIndex: Integer): TRect;
begin
  Result := AApproximateRect;
  DrawCellTextEx(Result, DT_CALCRECT or DT_NOPREFIX or DT_VCENTER, AItemIndex, AColumnIndex);
end;

procedure TcxMCListBox.DrawCellTextEx(var ARect: TRect; AFlags, AItemIndex, AColumnIndex: Integer);

  function GetDrawTextParams: TDrawTextParams;
  begin
    Result.cbSize := SizeOf(TDrawTextParams);
    Result.iTabLength := TabWidth;
    Result.iLeftMargin := 0;
    Result.iRightMargin := 0;
  end;

  function GetTextFlag(const AStartFlag: Longint): Longint;
  const
    ShowEndEllipsisArray: array[Boolean] of Integer = (0, DT_END_ELLIPSIS);
    WordWrapArray: array[Boolean] of Integer = (0, DT_WORDBREAK);
  begin
    Result := AStartFlag or
      SystemAlignmentsHorz[HeaderSections[AColumnIndex].Alignment] or
      WordWrapArray[MultiLines] or ShowEndEllipsisArray[ShowEndEllipsis];
    if not MultiLines then
      Result := Result or DT_SINGLELINE;
    if FInnerListBox.TabWidth > 0 then
      Result := Result or DT_EXPANDTABS or DT_TABSTOP;
  end;

var
  ADrawTextParams: TDrawTextParams;
  AText: string;
begin
  ADrawTextParams := GetDrawTextParams;
  AText := GetTextPart(AItemIndex, AColumnIndex);
  DrawTextEx(FInnerListBox.Canvas.Handle, PChar(AText),
    Length(AText), ARect, GetTextFlag(AFlags), @ADrawTextParams);
end;

procedure TcxMCListBox.DrawCellText(ARect: TRect; AItemIndex, AColumnIndex: Integer);
begin
  DrawCellTextEx(ARect, DT_NOPREFIX or DT_VCENTER, AItemIndex, AColumnIndex);
end;

function TcxMCListBox.GetCellRect(AItemIndex, AColumnIndex,
  ATop, ABottom: Integer; AVScrollBarVisible: Boolean): TRect;
var
  AHeaderSectionRect: TRect;
  I: Integer;
begin
  AHeaderSectionRect := GetHeaderSectionRect(AColumnIndex, AVScrollBarVisible);
  Result := Rect(AHeaderSectionRect.Left + 2, ATop, AHeaderSectionRect.Right - 2, ABottom);
  if OverflowEmptyColumn then
    for I := AColumnIndex + 1 to HeaderSections.Count - 1 do
      if GetTextPart(AItemIndex, I) = '' then
        Result.Right := Result.Right + RectWidth(GetHeaderSectionRect(I, AVScrollBarVisible))
      else
        Break;
end;

function TcxMCListBox.GetCellTextRect(AItemIndex, AColumnIndex,
  ATop, ABottom: Integer; AVScrollBarVisible: Boolean): TRect;
begin
  Result := CalcCellTextRect(GetCellRect(AItemIndex, AColumnIndex, ATop, ABottom, AVScrollBarVisible),
    AItemIndex, AColumnIndex);
end;

function TcxMCListBox.GetDelimiter: Char;
begin
  Result := FDelimiter;
end;

function TcxMCListBox.GetImages: TCustomImageList;
begin
  Result := FInnerHeader.Images;
end;

procedure TcxMCListBox.SetImages(Value: TCustomImageList);
begin
  FInnerHeader.Images := Value;
  FInnerHeader.UpdateHeight;
end;

function TcxMCListBox.GetHeaderSectionRect(AIndex: Integer;
  AVScrollBarVisible: Boolean): TRect;
begin
  if AVScrollBarVisible then