Delphi 10.2 Tokyo:Listview Custom Component is not displaying any records when ViewStyle = vsReport

0
votes

we are migrating Delphi 7 code to Delphi 10.2 tokyo. As part of this we have migrated all the components. List view component is not working as expected. It is not displaying column headings and data when ViewStyle = vsReport and for other styles(VsIcon,VsList) it is displaying data and Headers.

About the component:

we have added additional property DataSet, user can set DataSet property at design time and the component will take care of opening the Dataset, setting column headings and adding data when user calls BuildListView Method of this component.This component has popup menu to add, delete and edit the selected item. i have deleted this popup menu code. since it is not required.

Here is the code: This package has Runtime Package(64 bit) and Design time package (32 bit). Design time package has the code to register the component.

Run time pkg BPL Source:

package MylistView_rn;

{$R *.res}
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO OFF}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION OFF}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES ON}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DEFINE DEBUG}
{$ENDIF IMPLICITBUILDING}
{$RUNONLY}
{$IMPLICITBUILD ON}

requires
  rtl,
  vcl,
  dbrtl,
  adortl,
  vcldb;

contains
  uMyListView1 in 'uMyListView1.pas';

end.

Run time package Unit Source(uMyListView1.pas):

unit uMyListView1;


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, Menus, DB, ExtCtrls, Buttons, ADODB;

const ARROW_SIZE = 10;

type

  TMyListView = class(TListView)
  private
    FDataSet:                   TCustomADODataSet;

    FPressedColumn:             integer; //column index
    FLastPressedColumn:         integer; //last column to be pressed
    FSortDir:                   integer; //-1 = descending, 1 = ascending
    FSortOrder:                 integer;

    FMyHeaderHandle:            HWND;
    FMyHeaderInstance:          Pointer;
    FMyDefHeaderWndProc:        Pointer;
    FHeaderPopupMenu:           TPopupMenu;

    FDragging:                  boolean;

    procedure SetListViewColumns;
    function  GetArrowPos(ColumnIndex: integer): TPoint;
    function  DeleteLastArrow(DC: HDC): boolean;
    function  DrawArrow(DC: HDC; Direction: integer; Offset: TPoint): boolean;
    function  DrawColText(DC: HDC; ColumnIndex: integer): boolean;

    procedure WndProc(var msg : TMessage); override;
    procedure MyHeaderWndProc(var Message: TMessage);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    function    BuildListView: boolean;
  published
    property DataSet: TCustomADODataSet read FDataSet write FDataSet;
  end;

implementation

constructor TMYListView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPressedColumn     := -1;
  FLastPressedColumn := -1;
  FSortOrder         := 0;
  FDragging          := FALSE;

  FMyHeaderInstance := MakeObjectInstance(MyHeaderWndProc);
end;

destructor TMYListView.Destroy;
begin
  inherited Destroy;
end;

procedure TMYListView.WndProc(var msg : TMessage);
begin
  inherited WndProc(Msg);
  if (Msg.Msg = WM_PARENTNOTIFY) and (Msg.WParam = WM_CREATE) then
  Begin
    inherited;
    FMyHeaderHandle := Msg.lParam;
    FMyDefHeaderWndProc := Pointer(GetWindowLong(FMyHeaderHandle, GWL_WNDPROC));
    SetWindowLong(FMyHeaderHandle, GWL_WNDPROC, LongInt(FMyHeaderInstance));
  end;
end;

procedure TMYListView.MyHeaderWndProc(var Message: TMessage);
var DC: HDC;
    Pos: TPoint;
begin
  with Message do
  Begin
    Result := CallWindowProc(FMyDefHeaderWndProc, FMyHeaderHandle, Msg, WParam, LParam);

    if Msg = WM_RBUTTONDOWN then
    Begin
      Pos.x := lParamLo;
      Pos.y := lParamHi;
      Pos := ClientToScreen(Pos);
      FHeaderPopupMenu.Popup(Pos.x, Pos.y);
    end

    //Draw SortArrows
    else if Msg = WM_PAINT then
    Begin
      DC := GetDC(FMyHeaderHandle);
      DeleteLastArrow(DC);
      if (FPressedColumn > -1) then
      Begin
        DrawColText(DC, FPressedColumn);
        DrawArrow(DC, FSortDir, GetArrowPos(FPressedColumn));
      end;
    end;

  end;
end;

function TMYListView.DrawColText(DC: HDC; ColumnIndex: integer): boolean;
var ColTitle: string;
    Rect: TRect;
    TextAlign, i: integer;
    Brush: TBrush;
begin
  Result := FALSE;
  if FPressedColumn < 0 then Exit;

  ColTitle := Columns[ColumnIndex].Caption;
  while copy(ColTitle, length(ColTitle), 1) = '.' do ColTitle := copy(ColTitle, 1, Length(ColTitle) - 1);
  GetWindowRect(WindowFromDC(DC), Rect);
  with Rect do
  Begin
    Bottom := Bottom - Top - 2;
    Top := 2;
    Left := 6;

    for i := 0 to Columns.Count - 1 do
    Begin
      if Columns[i].Index = ColumnIndex then break;
      Left := Left + Columns[i].Width;
    end;

    Right := Left + Columns[ColumnIndex].Width - 8;
  end;

  Brush := TBrush.Create;
  with Brush do
  Begin
    Style := bsSolid;
    Color := clBtnFace;
    SelectObject(DC, Handle);
  end;
  FillRect(DC, Rect, Brush.Handle);

  TextAlign := DT_VCENTER;

  if Columns[i].Alignment = taRightJustify then
  Begin
    if (ColumnIndex = FPressedColumn) then Rect.Left := Rect.Left + ARROW_SIZE;
    Rect.Right := Rect.Right - 4;
    TextAlign := TextAlign + DT_RIGHT;
  end
  else
  Begin
    if (ColumnIndex = FPressedColumn) then Rect.Right := Rect.Right - ARROW_SIZE - 10;
    TextAlign := TextAlign + DT_LEFT;
  end;

  SelectObject(DC, Font.Handle);
  SetBkColor(DC, GetSysColor(COLOR_3DFACE));
  DrawTextEx(DC, PWideChar(ColTitle), Length(ColTitle), Rect, TextAlign + DT_END_ELLIPSIS, nil);
  Result := TRUE;
end;

function TMYListView.DeleteLastArrow(DC: HDC): boolean;
var Rect: TRect;
    Brush: TBrush;
begin
  Result := FALSE;
  if FLastPressedColumn < 0 then Exit;
  with Rect do
  Begin
    TopLeft := GetArrowPos(FLastPressedColumn);
    Left := Left - 1;
    Top := Top - 1;
    Right := Left + 12;
    Bottom := Top + 13;
  end;

  Brush := TBrush.Create;
  with Brush do
  Begin
    Color := clBtnFace;
    Style := bsSolid;
    SelectObject(DC, Handle);
  end;

  FillRect(DC, Rect, Brush.Handle);
  Brush.Free;

  DrawColText(DC, FLastPressedColumn);
  Result := TRUE;
end;

function TMYListView.GetArrowPos(ColumnIndex: integer): TPoint;
var i: integer;
begin
  Result.x := 0;
  Result.Y := 0;

  if ColumnIndex < 0 then Exit;
  i := 0;
  while i < Columns.Count do
  Begin
    Result.x := Result.x + Columns[i].Width;
    if i = ColumnIndex then break;
    i := i + 1;
  end;
  with Columns[ColumnIndex] do if Alignment = taRightJustify then Result.x := Result.x - Width + 4
  else Result.x := Result.x - 20;
  Result.y := 2;
end;

function TMYListView.DrawArrow(DC: HDC; Direction: integer; Offset: TPoint): boolean;
var Pen: TPen;
begin
  Pen := TPen.Create;
  Pen.Style := PSSolid;

  case Direction of
    1: //Asc
    Begin
      Pen.Color := clWhite;
      SelectObject(DC, Pen.Handle);

      //The White
      MoveToEx(DC, Offset.x + 0, Offset.y + ARROW_SIZE, nil);
      LineTo(DC, Offset.x + ARROW_SIZE, Offset.y + ARROW_SIZE);
      LineTo(DC, Offset.x + 5, Offset.y + 0);

      Pen.Color := clBtnShadow;
      SelectObject(DC, Pen.Handle);

      //The Grey
      LineTo(DC, Offset.x + 0, OffSet.y + ARROW_SIZE);
    end;

    -1: //Desc
    Begin
      Pen.Color := clWhite;
      SelectObject(DC, Pen.Handle);

      //The White
      MoveToEx(DC, Offset.x + ARROW_SIZE, Offset.y + 0 + 1, nil);
      LineTo(DC, Offset.x + 5, Offset.y + ARROW_SIZE + 1);

      Pen.Color := clBtnShadow;
      SelectObject(DC, Pen.Handle);

      //The Grey
      LineTo(DC, Offset.x + 0, Offset.y + 0 + 1);
      LineTo(DC, Offset.x + ARROW_SIZE, Offset.y + 0 + 1);
    end;
  end;

  Pen.Free;
  Result := TRUE;
end;

procedure TMYListView.SetListViewColumns;
var
  NewColumn:        TListColumn;
  i:                integer;
begin
  if FDataSet <> nil then with FDataSet, Self.Columns do
  begin
    Clear;  //clears any columns
    for i := 0 to FieldCount - 1 do
      if Fields[i].Visible then
      begin
        NewColumn          := Add;
        NewColumn.Caption  := Fields[i].DisplayLabel;
        NewColumn.Width    := Fields[i].DisplayWidth * 10;
        NewColumn.Alignment := Fields[i].Alignment;
      end;
  end;
end;

function TMYListView.BuildListView: boolean;
var NewListItem:     TListItem;
    i:               integer;
begin
  Result := FALSE;

  FPressedColumn     := -1;
  FLastPressedColumn := -1;

  Items.Clear;

  if FDataSet = NIL then
  begin
    MessageDlg('The Dataset is NIL', mtError, [mbOK], 0);
    Exit;
  end;


  try
    FDataset.Open;
    SetListViewColumns;

    with FDataSet do
    Begin
      Items.BeginUpdate;
      if not EOF then while not EOF do
      begin
        NewListItem := Items.Add;
        for i := 0 to FieldCount - 1 do
        begin
          if Fields[i].Visible then
          begin
            if i = 0 then NewListItem.Caption := Fields[0].DisplayText
            else if Fields[i].Visible then NewListItem.SubItems.Add(Fields[i].DisplayText);

          end;
        end;
        Next;
        Application.ProcessMessages;
      end;
    end;

    Result := TRUE;
  finally
    FDataSet.Close;
    Items.EndUpdate;
  end;

end;

end.

Design time pkg BPL Source:

package MyListView_dcl;

{$R *.res}
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO OFF}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION OFF}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES ON}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DEFINE DEBUG}
{$ENDIF IMPLICITBUILDING}
{$DESIGNONLY}
{$IMPLICITBUILD ON}

requires
  rtl,
  Vcl,
  dbrtl,
  adortl,
  MylistView_rn;

contains
  RegMyListView in 'RegMyListView.pas';

end.

Design time package Unit Source(RegMyListView.pas):

unit RegMyListView;

interface

Uses Classes,uMyListView1;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('MyComponents', [TMyListView]);
end;
end.

After installing the component , Drop the TMyListView , TADOCOnnection,TADOQuery and button on form.

  1. TADOCOnnection : Set the Connection string .
  2. TADOQuery : Set the Connection and add SQL Property(Select Column1, Column2 from table)
  3. TMyListView : Set the DataSet to TADOQuery and ViewStyle = vsReport
  4. Double click on button and Call TMyListView.BuildListView.
  5. Run the Application and Click on button no Column headings or Data.(check below screen shot)

enter image description here

if i comment the below line in TMYListView.WndProc Procedure or if i totally remove MyHeaderWndProc Procedure and its associated code, it is working as expected. 

SetWindowLong(FMyHeaderHandle, GWL_WNDPROC, LongInt(FMyHeaderInstance));

enter image description here

I have no idea what's wrong with the code.

1
delphidelphi-10.2-tokyo
Put some breakpoints in that code and step by step see where the error resides. – RBA
I tried that. not about to figure out what is wrong . – DelphiLearner
I think the code to get the Header-Handle in your WndProc is wrong. I'm pretty sure the problem is there. – Fritzw
So why don't you comment that line since it solves your problem? – Sertac Akyuz
Nope , we are adding sorting arrows in MyHeaderWndProc . so dont want to comment. – DelphiLearner

1 Answers

0
votes

Maybe this helps, depending on your compiling target (SetWindowLong is marked as superseded): https://msdn.microsoft.com/en-us/library/windows/desktop/ms644898(v=vs.85).aspx