Fastreport Vcl 4.13, 64 бита

noname001.txtnoname001.txt
отредактировано 10:50 Раздел: FastReport 4.0
Здравствуйте!

В процессе использования FastReport 4.13 в Delphi на 64-битной платформе были замечены следующие недоработки (закомментировано неправильное):

Модуль frxClass.pas:
procedure TfrxDialogPage.DoOnShow(Sender: TObject);
FForm.Perform(CM_FOCUSCHANGED, 0, {Longint}LPARAM(FForm.ActiveControl));

Модуль frxCtrls.pas:
procedure TfrxCustomComboBox.CreateWnd;
SetWindowLong(FListHandle, GWL_WNDPROC, {Longint}NativeInt(FListInstance));
procedure TfrxCustomComboBox.WndProc(var Message: TMessage);
SetWindowLong(FListHandle, GWL_WNDPROC, {Longint}NativeInt(FDefListProc));
procedure TfrxFontComboBox.PopulateList;
EnumFontFamiliesEx(DC, LFont, @EnumFontsProc, {LongInt}NativeInt(str), 0);
EnumFontFamiliesEx(frxPrinters.Printer.Canvas.Handle,
{$IFDEF FPC}@LFont{$ELSE}LFont{$ENDIF}, @EnumFontsProc, {LongInt}NativeInt(str), 0);

Модуль frxDCtrl.pas
procedure TfrxDateEditControl.DropDown(Sender: TObject);
SendMessage(CalHandle, MCM_GETMINREQRECT, 0, {Longint}LPARAM(@CalRect));

Модуль frxDesgn.pas
procedure TfrxDesignerForm.TabDragDrop(Sender, Source: TObject; X, Y: Integer);
HitPage := SendMessage(FTabs.Handle, TCM_HITTEST, 0, {Longint}LPARAM(@HitTestInfo));

Модуль frxDsgnIntf.pas
TfrxPropertyEditor = class(TObject)
function GetOrdValue: {$IFDEF FPC}frxInteger{$ELSE}{Integer}NativeInt{$ENDIF};
procedure SetOrdValue(Value: {$IFDEF FPC}frxInteger{$ELSE}{Integer}NativeInt{$ENDIF});
procedure TfrxIntegerProperty.SetValue(const Value: String);
begin
//Неправильно — надо использовать 64-битный инт не только для ФПЦ
{{$IFDEF FPC}
{$IFDEF CPU64}
SetOrdValue(StrToInt64(Value));
{$ELSE}
SetOrdValue(StrToInt(Value));
{$ENDIF}
(*{$ELSE}
SetOrdValue(StrToInt(Value));
{$ENDIF}*)
end;
procedure TfrxComponentProperty.SetValue(const Value: String);
var
c: TComponent;
begin
c := nil;
if Value <> '' then
begin
c := frComponent.Report.FindObject(Value);
if c = nil then
raise Exception.Create(frxResources.Get('prInvProp'));
end;
//Неправильно — надо использовать 64-битный инт не только для ФПЦ
{{$IFDEF FPC}
SetOrdValue(frxInteger©);
(*{$ELSE}
SetOrdValue(Integer©);
{$ENDIF}*)
end;
function TfrxFontProperty.Edit: Boolean;
var
FontDialog: TFontDialog;
begin
FontDialog := TFontDialog.Create(Application);
try
FontDialog.Font := TFont(GetOrdValue);
FontDialog.Options := FontDialog.Options + [fdForceFontExist];
{$IFNDEF FPC}
FontDialog.Device := fdBoth;
{$ENDIF}
Result := FontDialog.Execute;
if Result then
//Неправильно — надо использовать 64-битный инт не только для ФПЦ
{{$IFDEF FPC}
SetOrdValue(frxInteger(FontDialog.Font));
(*{$ELSE}
SetOrdValue(Integer(FontDialog.Font));
{$ENDIF}*)
finally
FontDialog.Free;
end;
end;

Модуль frxOLE.pas
constructor TfrxOLEView.Create(AOwner: TComponent);
SendMessage(frxParentForm.Handle, WM_CREATEHANDLE, {Integer}WPARAM(FOleContainer), 0);
destructor TfrxOLEView.Destroy;
SendMessage(frxParentForm.Handle, WM_DESTROYHANDLE, {Integer}WPARAM(FOleContainer), 0);

Модуль frxPreview.pas
procedure TfrxPreviewForm.Init;
ToolBar.Buttons.Tag := NativeInt(m);//Integer(m);

Модуль frxPreviewPages.pas
TfrxPreviewPages = class(TfrxCustomPreviewPages)
FXMLSize: NativeInt;//Integer;

Модуль frxRichEdit.pas
function GetRichEditOle(Wnd: HWnd; var RichEditOle): Boolean;
Result := SendMessage(Wnd, EM_GETOLEINTERFACE, 0, {Longint}LPARAM(@RichEditOle)) <> 0;
function TRichEditStrings.Get(Index: Integer): string;
L := SendMessage(RichEdit.Handle, EM_GETLINE, Index, {Longint}LPARAM(@Text));
procedure TRichEditStrings.Put(Index: Integer; const S: string);
SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, {Longint}LPARAM(@Selection));
SendMessage(RichEdit.Handle, WM_USER + 97 {EM_SETTEXTEX}, {Integer}WPARAM(@SetText),
{Integer}LPARAM(PAnsiChar(AnsiStr))) четырежды
procedure TRichEditStrings.Insert(Index: Integer; const S: string);
SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, {Longint}LPARAM(@Selection));
SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, {Longint}LPARAM(PChar(Str)));
procedure TRichEditStrings.Delete(Index: Integer);
SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, {Longint}LPARAM(@Selection));
SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, {Longint}LPARAM(Empty));
function AdjustLineBreaks(Dest: PByte; Source: TBytes; Start, Len: Integer): Integer;
//Result := Integer(P) - Integer(Dest);
Result := NativeInt(P) - NativeInt(Dest);
procedure TRichEditStrings.LoadFromStream(Stream: TStream);
dwCookie := {Longint}DWORD_PTR(Pointer(@StreamInfo));
SendMessage(RichEdit.Handle, EM_STREAMIN, TextType, {Longint}LPARAM(@EditStream));
SendMessage(RichEdit.Handle, EM_STREAMIN, TextType, {Longint}LPARAM(@EditStream));
procedure TRichEditStrings.SaveToStream(Stream: TStream);
dwCookie := {Longint}DWORD_PTR(Pointer(@StreamInfo));
SendMessage(RichEdit.Handle, EM_STREAMOUT, TextType, {Longint}LPARAM(@EditStream));
procedure TRxCustomRichEdit.CreateWnd;
SendMessage(Handle, EM_AUTOURLDETECT, {Longint}WPARAM(FAutoURLDetect), 0);
function TRxCustomRichEdit.GetCaretPos: TPoint;
SendMessage(Handle, EM_EXGETSEL, 0, {Longint}LPARAM(@CharRange));
procedure TRxCustomRichEdit.SetAutoURLDetect(Value: Boolean);
SendMessage(Handle, EM_AUTOURLDETECT, {Longint}WPARAM(FAutoURLDetect), 0);
function TRxCustomRichEdit.GetSelection: TCharRange;
SendMessage(Handle, EM_EXGETSEL, 0, {Longint}LPARAM(@Result));
procedure TRxCustomRichEdit.SetSelection(StartPos, EndPos: Longint;
SendMessage(Handle, EM_EXSETSEL, 0, {Longint}LPARAM(@CharRange));
function TRxCustomRichEdit.GetTextRange(StartPos, EndPos: Longint): string;
SetLength(Result, SendMessage(Handle, EM_GETTEXTRANGE, 0, {Longint}LPARAM(@TextRange)));
procedure TRxCustomRichEdit.EMReplaceSel(var Message: TMessage);
Perform(EM_EXGETSEL, 0, {Longint}LPARAM(@CharRange));
Perform(EM_EXSETSEL, 0, {Longint}LPARAM(@CharRange));
function TRxCustomRichEdit.PasteSpecialDialog: Boolean;
SendMessage(Handle, EM_EXGETSEL, 0, {Longint}LPARAM(@Selection));
SendMessage(Handle, EM_EXSETSEL, 0, {Longint}LPARAM(@Selection));
function TRxCustomRichEdit.InsertObjectDialog: Boolean;
SendMessage(Handle, EM_EXGETSEL, 0, {Longint}LPARAM(@Selection));
SendMessage(Handle, EM_EXSETSEL, 0, {Longint}LPARAM(@Selection));
procedure TRxCustomRichEdit.Print(const Caption: string);
LastChar := SendMessage(Self.Handle, EM_FORMATRANGE, 1, {Longint}LPARAM(@Range));
function TRxCustomRichEdit.FindText(const SearchStr: string;
Result := SendMessage(Handle, EM_FINDTEXTEX, Flags, {Longint}LPARAM(@Find));
SendMessage(Handle, EM_EXSETSEL, 0, {Longint}LPARAM(@Find.chrgText));
function TRxCustomRichEdit.GetTextLen: Integer;
Result := Perform(EM_GETTEXTLENGTHEX, {Integer}WPARAM(@TextLen), 0)

Модуль frxRichEditor.pas
procedure TfrxRichEditorForm.SetEditRect;
SendMessage(Handle, EM_SETRECT, 0, {Longint}LPARAM(@R));

Модуль frxUnicodeCtrls.pas
procedure TUnicodeEdit.SetSelText(const Value: WideString);
SendMessageW(Handle, EM_REPLACESEL, 0, {Longint}LPARAM(PWideChar(Value)));
procedure TUnicodeMemo.SetSelText(const Value: WideString);
SendMessageW(Handle, EM_REPLACESEL, 0, {Longint}LPARAM(PWideChar(Value)));

Модуль frxZLib.pas
procedure ZCompress(const inBuffer: Pointer; inSize: Integer;
zstream.next_out := PByte{AnsiChar}({Integer}NativeInt(outBuffer) + zstream.total_out);
procedure ZDecompress(const inBuffer: Pointer; inSize: Integer;
zstream.next_out := PByte{AnsiChar}({Integer}NativeInt(outBuffer) + zstream.total_out);

Модуль ExportPack\frxBIFF.pas
procedure TBiffRC4.EncryptEx(Data: Pointer; Size: LongInt);
if Data <> nil then Data := Pointer({Longint}NativeInt(Data) + FTail);
Data := Pointer({Longint}NativeInt(Data) + n);

Модуль ExportPack\frxCrypto.pas
function GetNBytesAt(const Base; Offset, N: Integer): Integer;
Move(Pointer({Integer}NativeInt(@Base) + Offset)^, Result, N);
procedure SetNBytesAt(var Base; Offset, N, Value: Integer);
Move(Value, Pointer({Integer}NativeInt(@Base) + Offset)^, N);
procedure TCryptoHash.Push(const Data; Size: Integer);
Move(Pointer({Integer}NativeInt(@Data) + Offset)^, FChunk[Used], n);
procedure TCryptoWhirlpool.GetDigest(out Digest; Size: Integer);
Move(FState[i, 0], Pointer({Integer}NativeInt(@Digest) + i*8)^, 8);

Модуль ExportPack\frxExportCSV.pas
function AnsiPos(const Substr, S: AnsiString): Integer;
Result := {Integer}NativeInt(P) - {Integer}NativeInt(PAnsiChar(S)) + 1;
procedure PushChar(c: AnsiChar);
PAnsiChar({Integer}NativeInt® + ri)^ := c;

Модуль ExportPack\frxGML.pas
TGmlRtf = class
FPos: {LongInt}NativeInt; // current pointer to the source document
procedure TGmlRtf.Pop(Discard: Boolean);
FPos := {LongInt}NativeInt(FStack.Last);

Модуль ExportPack\frxRC4.pas
procedure TfrxRC4.Start(Key: Pointer; KeyLength: Integer);
k := PByte({integer}NativeInt(Key) + (i mod KeyLength))^;

Модуль ExportPack\frxStorage.pas
function TBlockStream.GetBlockData(i: LongInt): Pointer;
Result := Pointer({LongInt}NativeInt(Memory) + i shl FBlockShift);
function TBlockStream.Imm(Value, Count: LongInt): Pointer;
Result := Pointer({LongInt}NativeInt(Memory) + Size - Count);
function TCachedArray.GetItemData(Index: Integer): Pointer;
Result := Pointer({Integer}NativeInt(b.Data) + (Index mod FBlock) * ItemSize);
function TCachedStream.Write(const Buffer; Count: Integer): Longint;
Move(Pointer({Integer}NativeInt(@Buffer) + p)^, FChunk[FUsed], n);
function TBase64Encoder.Write(const Buffer; Count: Integer): Longint;
Write(Pointer({Integer}NativeInt(@Buffer) + n)^, Count - n);
Encode(PInteger({Integer}NativeInt(@Buffer) + n)^, 3);
FCache := PInteger({Integer}NativeInt(@Buffer) + n)^ and BitMask(Count - n);
function THexEncoder.Write(const Buffer; Count: Integer): Longint;
b := PByte({Integer}NativeInt(@Buffer) + i)^;
function TLineSplitter.Write(const Buffer; Count: Integer): Longint;
p := Pointer({Integer}NativeInt(p) + n);

Как проявляется проблема: если пакет времени выполнения FastReport загрузить по адресам выше 4 (2) гигабайт, в указанных местах могут происходить исключения вплоть до access violation.

Кроме того, код
StartClassGroup(TControl);
ActivateClassGroup(TControl);
GroupDescendentsWith(..., TControl);
приводит к тому, что в design-time не работают Ctrl-C/Ctrl-V, так как имеются четыре группы классов (TPersistent, TControl, TFMXObject почему-то дважды), и в момент вставки FindClass для Tfrx* возвращает nil, так как активна группа TPersistent. Нужно или отказываться от группировки, или непосредственно перед вставкой устанавливать активную группу явно.

Комментарии

  • noname001.txtnoname001.txt
    отредактировано 10:50
    Модуль ExportPack\frxBIFF.pas
    dc: LongWord // HDC
    font: LongWord; // HFONT

    Здесь нельзя LongWord, в 64-битном режиме функции CreateDC, CreateFontW могут возвращать значения, превышающие $FFFFFFFF, что при включенном Range Check приведёт к исключению, а при отключенном — к результату "от фонаря". Хуже того, ошибка воспроизводится нестабильно по понятным причинам.

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

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

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

© Vanilla Keystone Theme 2024