Fastreport + Devexpress

FAVusFAVus
отредактировано 05:43 Раздел: FastReport VCL
Была старая версия FastReport 4, обновились до последней версии. И заодно обновили DevExpress до 16.1.2.
До этого в frxDesigner были интегрированы 2 компоненты из DevExpress (TcxComboBox и TcxDateEdit) и успешно годами работали.
После обновления при добавлении компонент или открытии формы с этими компонентами дизайнер отчетов начал "валиться".
Вот код интеграции: 
unit medFrxControls;

interface

uses
  Classes, Windows, frxClass, frxDsgnIntf, cxDropDownEdit, Graphics,
  cxButtonEdit, fs_iinterpreter, frxClassRTTI, cxCalendar;

type
  TfrxcxComboBoxControl = class(TfrxDialogControl)
  private
    FComboBox: TcxComboBox;
    FOnChange: TfrxNotifyEvent;
    function GetItemIndex: Integer;
    function GetItems: TStrings;
    function GetText: String;
    procedure DoOnChange(Sender: TObject);
    procedure SetItemIndex(const Value: Integer);
    procedure SetItems(const Value: TStrings);
    procedure SetText(const Value: String);
    procedure SetDropDownListStyle(aStyle : TcxEditDropDownListStyle);
    function GetDropDownListStyle() : TcxEditDropDownListStyle;
    function GetCurRecId() : integer;
  public
    constructor Create(AOwner: TComponent); override;
    class function GetDescription: String; override;
    property cxComboBox: TcxComboBox read FComboBox;
  published
    property Color;
    property Items: TStrings read GetItems write SetItems;
    property TabStop;
    property Text: String read GetText write SetText;
    property ItemIndex: Integer read GetItemIndex write SetItemIndex;
    property OnChange: TfrxNotifyEvent read FOnChange write FOnChange;
    property Style : TcxEditDropDownListStyle read GetDropDownListStyle write SetDropDownListStyle;
    property CurRecId : integer read GetCurRecId;
    property OnClick;
    property OnDblClick;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
  end;

  //TcxDateEdit

  TfrxcxDateEditControl = class(TfrxDialogControl)
  private
    FDateEdit: TcxDateEdit;
    FOnChange: TfrxNotifyEvent;
    procedure DoOnChange(Sender: TObject);
    function GetDate() : TDateTime;
    procedure SetDate(aValue : TDateTime);
    function GetShowTime() : boolean;
    procedure SetShowTime(aValue : boolean);
    function GetSaveTime() : boolean;
    procedure SetSaveTime(aValue : boolean);
    function GetKind() : TcxCalendarKind;
    procedure SetKind(aValue : TcxCalendarKind);
  public
    constructor Create(AOwner: TComponent); override;
    class function GetDescription: String; override;
    property cxDateEdit: TcxDateEdit read FdateEdit;
  published
    property Color;
    property TabStop;
    property Date : TDateTime read GetDate write SetDate;
    property Kind : TcxCalendarKind read GetKind write SetKind;
    property ShowTime : boolean read GetShowTime write SetShowTime;
    property SaveTime : boolean read GetSaveTime write SetSaveTime;
    property OnChange: TfrxNotifyEvent read FOnChange write FOnChange;
    property OnClick;
    property OnDblClick;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
  end;

  TFunctions = class(TfsRTTIModule)
  private
    function CallMethod_cxComboBoxControl(Instance: TObject; ClassType: TClass; const MethodName: String; var Params: Variant): Variant;
    function CallMethod_cxDateEditControl(Instance: TObject; ClassType: TClass; const MethodName: String; var Params: Variant): Variant;
  public
    constructor Create(AScript: TfsScript); override;
  end;

implementation

uses
  SysUtils, mdlGlobal, ibSupport, medOtherFunctions, medFrxControlsRes,
  medGraphicsSupport;

{ TfrxcxComboBoxControl }

constructor TfrxcxComboBoxControl.Create(AOwner: TComponent);
begin
  inherited;
  FComboBox := TcxComboBox.Create(nil);
  FComboBox.Properties.OnChange := DoOnChange;
  InitControl(FComboBox);

  Width := 145;
  Height := 21;
end;

class function TfrxcxComboBoxControl.GetDescription: String;
resourcestring
  rs_desc = 'Компонент TcxComboBox из DevExpress';
begin
  Result := rs_desc;
end;

function TfrxcxComboBoxControl.GetItems: TStrings;
begin
  Result := FComboBox.Properties.Items;
end;

function TfrxcxComboBoxControl.GetItemIndex: Integer;
begin
  Result := FComboBox.ItemIndex;
end;

function TfrxcxComboBoxControl.GetText: String;
begin
  Result := FComboBox.Text;
end;

procedure TfrxcxComboBoxControl.SetItems(const Value: TStrings);
begin
  FComboBox.Properties.Items := Value;
end;

procedure TfrxcxComboBoxControl.SetItemIndex(const Value: Integer);
begin
  FComboBox.ItemIndex := Value;
end;

procedure TfrxcxComboBoxControl.SetText(const Value: String);
begin
  FComboBox.Text := Value;
end;

procedure TfrxcxComboBoxControl.DoOnChange(Sender: TObject);
begin
  if Report <> nil
    then Report.DoNotifyEvent(Self, FOnChange);
end;

function TfrxcxComboBoxControl.GetDropDownListStyle: TcxEditDropDownListStyle;
begin
  Result := FComboBox.Properties.DropDownListStyle;
end;

procedure TfrxcxComboBoxControl.SetDropDownListStyle(aStyle: TcxEditDropDownListStyle);
begin
  FComboBox.Properties.DropDownListStyle := aStyle;
end;

function TfrxcxComboBoxControl.GetCurRecId: integer;
begin
  Result := integer(FComboBox.ItemObject);
end;

{ TFunctions }

function TFunctions.CallMethod_cxComboBoxControl(Instance: TObject;
  ClassType: TClass; const MethodName: String;
  var Params: Variant): Variant;
begin
  if (MethodName = UpperCase('FillStringListForSql'))
    then FillComboBoxForSql(Params[0],
                            dmGlobal.DataBase,
                            TfrxcxComboBoxControl(Instance).cxComboBox,
                            Params[1],
                            Params[2]);
  if (MethodName = UpperCase('SaveValueInIniFile'))
    then dmGlobal.IniWriteInt(Params[0],
                              TfrxcxComboBoxControl(Instance).Name,
                              integer(TfrxcxComboBoxControl(Instance).cxComboBox.ItemObject));
  if (MethodName = UpperCase('LoadValueFromIniFile'))
    then TfrxcxComboBoxControl(Instance).cxComboBox.ItemIndex := GetItemIndexFromObjectValue(
          dmGlobal.IniReadInt(Params[0], TfrxcxComboBoxControl(Instance).Name, 0),
          TfrxcxComboBoxControl(Instance).cxComboBox.Properties.Items,
          Params[1]);
  if (MethodName = UpperCase('Sort'))
    then TStringList(TfrxcxComboBoxControl(Instance).cxComboBox.Properties.Items).Sort();
end;

function TFunctions.CallMethod_cxDateEditControl(Instance: TObject;
  ClassType: TClass; const MethodName: String;
  var Params: Variant): Variant;
begin
  if (MethodName = UpperCase('SaveValueInIniFile'))
    then dmGlobal.IniWriteDouble(Params[0],
                                 TfrxcxDateEditControl(Instance).Name,
                                 TfrxcxDateEditControl(Instance).Date);
  if (MethodName = UpperCase('LoadValueFromIniFile'))
    then TfrxcxDateEditControl(Instance).Date := dmGlobal.IniReadDouble(
                    Params[0],
                    TfrxcxDateEditControl(Instance).Name,
                    VariantToFloat(Params[1]));
end;

constructor TFunctions.Create(AScript: TfsScript);
begin
  inherited;
  with (AScript) do
  begin
    with (AddClass(TfrxcxComboBoxControl, 'TfrxDialogControl')) do
    begin
      AddMethod('procedure FillStringListForSql(aSqlText, aListFieldName, aIdFieldName : string)',
                CallMethod_cxComboBoxControl);
      AddMethod('procedure SaveValueInIniFile(aSectionName : string)',
                CallMethod_cxComboBoxControl);
      AddMethod('procedure LoadValueFromIniFile(aSectionName : string; aDefItemIndex : integer)',
                CallMethod_cxComboBoxControl);
      AddMethod('procedure Sort()',
                CallMethod_cxComboBoxControl);
    end;
    //cxDateEdit
    with (AddClass(TfrxcxDateEditControl, 'TfrxDialogControl')) do
    begin
      AddMethod('procedure SaveValueInIniFile(aSectionName : string)',
                CallMethod_cxDateEditControl);
      AddMethod('procedure LoadValueFromIniFile(aSectionName : string; aDefDate : TDateTime)',
                CallMethod_cxDateEditControl);
    end;
  end;
end;

{ TfrxcxDateEditControl }

constructor TfrxcxDateEditControl.Create(AOwner: TComponent);
begin
  inherited;
  FDateEdit := TcxDateEdit.Create(nil);
  FDateEdit.Properties.OnChange := DoOnChange;
  InitControl(FDateEdit);

  Width := FDateEdit.Width;
  Height := FDateEdit.Height;
end;

procedure TfrxcxDateEditControl.DoOnChange(Sender: TObject);
begin
  if Report <> nil
    then Report.DoNotifyEvent(Self, FOnChange);
end;

class function TfrxcxDateEditControl.GetDescription: String;
resourcestring
  rs_desc = 'TcxDateEdit из DevExpress';
begin
  Result := rs_desc;
end;

procedure TfrxcxDateEditControl.SetDate(aValue: TDateTime);
begin
  FDateEdit.Date := aValue;
end;

function TfrxcxDateEditControl.GetDate: TDateTime;
begin
  FDateEdit.PostEditValue();
  Result := FDateEdit.Date;
end;

function TfrxcxDateEditControl.GetKind: TcxCalendarKind;
begin
  Result := FDateEdit.Properties.Kind;
end;

function TfrxcxDateEditControl.GetSaveTime: boolean;
begin
  Result := FDateEdit.Properties.SaveTime;
end;

function TfrxcxDateEditControl.GetShowTime: boolean;
begin
  Result := FDateEdit.Properties.ShowTime;
end;

procedure TfrxcxDateEditControl.SetKind(aValue: TcxCalendarKind);
begin
  FDateEdit.Properties.Kind := aValue;
end;

procedure TfrxcxDateEditControl.SetSaveTime(aValue: boolean);
begin
  FDateEdit.Properties.SaveTime := aValue;
end;

procedure TfrxcxDateEditControl.SetShowTime(aValue: boolean);
begin
  FDateEdit.Properties.ShowTime := aValue;
end;

initialization
  frxObjects.RegisterObject(TfrxcxComboBoxControl, BMPFromArray(bmp_cxComboBoxControl, SizeOf(bmp_cxComboBoxControl)));
  frxObjects.RegisterObject(TfrxcxDateEditControl, BMPFromArray(bmp_cxDateEditControl, SizeOf(bmp_cxDateEditControl)));
  fsRTTIModules.Add(TFunctions);

finalization
  frxObjects.Unregister(TfrxcxComboBoxControl);
  frxObjects.Unregister(TfrxcxDateEditControl);
end.


Ошибка procedure Access violation at address 005E6671 in module 'Program.ex'. Read of address 00000000. 
Address     Offset         Stack        Module               Base         Unit                 Class               Procedure/Method
---------------------------------------------------------------------------------------------------------------------------------------
005E6671    001E6671    00000000    Program.ex    00400000    Vcl.Graphics    TCanvas            GetHandle    
00644583    00244583    0018E9D4    Program.ex    00400000    Vcl.Controls    TCustomControl    PaintWindow
0063E529    0023E529    0018E9FC    Program.ex    00400000    Vcl.Controls    TWinControl    PaintHandler        
0063ED14    0023ED14    0018EA6C    Program.ex    00400000    Vcl.Controls    TWinControl    WMPaint    
0064451D    0024451D    0018EAD4    Program.ex    00400000    Vcl.Controls    TCustomControl    WMPaint        
0063E35D    0023E35D    0018EC0C    Program.ex    00400000    Vcl.Controls    TWinControl    WndProc    
0063D97C    0023D97C    0018EC58    Program.ex    00400000    Vcl.Controls    TWinControl    MainWndProc
004FC76C    000FC76C    0018EC88    Program.ex    00400000    System.Classes                        StdWndProc    
767562F7    000162F7    0018ECA0    user32.dll            76740000    USER32                                (possible gapfnScSendMessage+815)        
76757311    00017311    0018ECCC    user32.dll            76740000    USER32                                (possible GetDC+77)        
76756DE3    00016DE3    0018ED44    user32.dll            76740000    USER32                                (possible GetThreadDesktop+384)                
76756E41    00016E41    0018EDA0    user32.dll            76740000    USER32                                (possible GetThreadDesktop+478)            
77800117    00010117    0018EDDC    ntdll.dll            777F0000    ntdll                                        KiUserCallbackDispatcher    
76757885    00017885    0018EE58    user32.dll            76740000    USER32                                DispatchMessageW        
0074D29F    0034D29F    0018EE68    Program.ex    00400000    Vcl.Forms    TApplication            ProcessMessage

Комментарии

  • gpigpi
    отредактировано 05:43
    Стили/скины не используются?
  • FAVusFAVus
    отредактировано 05:43
    gpi написал: »
    Стили/скины не используются?
    Нет, все отключено
  • FAVusFAVus
    отредактировано 05:43
    Все, разобрался. Грабли в DevExpress были. Все работает теперь!
  • koliokolio
    отредактировано 05:43
    вопрос из зала: а как это вообще отображается на форме? я так понял можно выбирать дату и выпадалку прям в превью отчета?
  • gpigpi
    отредактировано 05:43
    Не в превью, а в диалоговой форме
  • koliokolio
    отредактировано 05:43
    понял. Попробовал встроить - увы не то, что я искал

    Я ищу возможность редактирования превью
    пока, что в голове 2 мысли:
    1. создавать свой кастомный компонент
    2. допиливать frxMemoView

    опять же, как ловить клики на объекте:
    1. ловить событие ClickObject и рендерить TEdit (пока, что проблема с определнием габаритов объекта на который клацнули, чтобы отрендерить TEdit такого же размера в том же месте) - этот вариант не особо мне нравится, но пока, что самый реальный
    2. создать еще опцию у frxMemoView типа PreviewEditor и ловить в файле frxPreviewPages событие в ветке где if MouseEvent = meClick и там создавать TEdit (новое свойство у frxMemoView), но проблема в том, что TEdit ругается, что нет окна к которому привязан этот компонент
  • koliokolio
    отредактировано 05:43
    по сути мне не хватает всего лишь функционала в превью у frxMemoView такого же, когда в дизайнере выбираешь инструмент "Т" (текст) и нажимаешь на уже размещенный на форме frxMemoView - появляется Memo в самом дизайнере где просто редактируешь текст компонента (без диалогового окна) - и при этом проматывая всё это редактор компонента умеет уезжать под верхнюю границу листа
    у меня же с TEdit думаю будут в этом плане проблемы - так как он полезет НАД превьюхой
  • koliokolio
    отредактировано 05:43
    проблему с определением координат в PX решил через вынос FX, FY, FX1, FY1: Integer в PUBLIC
    уйма проблем отпала - но почему-то именно первый клик отрисовывает TEdit ниже
    и после промоток отчета по высоте промахивается и меняет свою позицию только после второго клика по объекту

    и крайне не хватает события промотки превью, чтобы синхронизировать положение TEdit с редактором

Оставить комментарий

Многофункциональный текстовый редактор. Чтобы отредактировать стиль параграфа, нажмите TAB, чтобы перейти к меню абзаца. Там вы можете выбрать стиль. По умолчанию не выбран ни один стиль. Когда вы выберете текст, появится встроенное меню форматирования. Нажмите TAB, чтобы войти в него. Некоторые элементы, такие как многофункциональные вставки ссылок, картинок, индикаторов загрузки и сообщений об ошибок могут быть вставлены в редактор. Вы можете перемещаться по ним, используя стрелки внутри редактора и удалять с помощью клавиш delete или backspace.

Начало • FastReport VCLКомментировать как ...

© Vanilla Keystone Theme 2024