laborer2008
Newbie | Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
С недавних пор начал использовать fast report 4.5 и обнаружил несколько несуразностей/недоработок.
frxPreviewPageSettings.pas
В диалоге настроек параметров страницы пользователь может случайно ввести некорректные данные и при нажатии на 'Ok' программа ему ответит Access violation'ом. Данные конечно можно подправить и параметры страницы примут новые значения, но программа так ругающаяся оставляет впечатление недоделанной.
Чтобы этого не было, добавлены проверки корректности введённых данных в окна Edit. Для этого написаны обработчики OnExit:
Код:
{для MarginLeftE, MarginLeftR, MarginTopE, MarginBottonE}
procedure TfrxPageSettingsForm.MarginLeftEExit(Sender: TObject);
begin
try
frxStrToFloat(TEdit(Sender).Text);
except
TEdit(Sender).Text:='0';
end;
end;
{для WidthE, HeightE}
procedure TfrxPageSettingsForm.WidthEExit(Sender: TObject);
var f:Double;
begin
try
f:=frxStrToFloat(TEdit(Sender).Text);
if (f<0.1)then begin
f:=0.1;// ограничиваем размер бумаги
TEdit(Sender).Text:=frxFloatToStr(f);
end;
except
TEdit(Sender).Text:=frxFloatToStr(0.1);
end;
end;
|
Ограничено количество вводимых символов во все Edit'ы - MaxLength:=30
было:
Код:
procedure TfrxPageSettingsForm.FormHide(Sender: TObject);
begin
if ModalResult = mrOk then
begin
if PortraitRB.Checked then
Page.Orientation := poPortrait else
Page.Orientation := poLandscape;
Page.PaperWidth := UnitsTomm(frxStrToFloat(WidthE.Text));
Page.PaperHeight := UnitsTomm(frxStrToFloat(HeightE.Text));
Page.PaperSize := frxPrinters.Printer.PaperNameToNumber(SizeCB.Text);
Page.LeftMargin := UnitsTomm(frxStrToFloat(MarginLeftE.Text));
Page.RightMargin := UnitsTomm(frxStrToFloat(MarginRightE.Text));
Page.TopMargin := UnitsTomm(frxStrToFloat(MarginTopE.Text));
Page.BottomMargin := UnitsTomm(frxStrToFloat(MarginBottomE.Text));
Page.AlignChildren;
end;
end;
|
стало:
Код:
procedure TfrxPageSettingsForm.FormHide(Sender: TObject);
begin
if ModalResult = mrOk then
begin
MarginLeftEExit(MarginLeftE);
MarginLeftEExit(MarginRightE);
MarginLeftEExit(MarginTopE);
MarginLeftEExit(MarginBottomE);
WidthEExit(WidthE);
WidthEExit(HeightE);
if PortraitRB.Checked then
Page.Orientation := poPortrait else
Page.Orientation := poLandscape;
Page.PaperWidth := UnitsTomm(frxStrToFloat(WidthE.Text));
Page.PaperHeight := UnitsTomm(frxStrToFloat(HeightE.Text));
Page.PaperSize := frxPrinters.Printer.PaperNameToNumber(SizeCB.Text);
Page.LeftMargin := UnitsTomm(frxStrToFloat(MarginLeftE.Text));
Page.RightMargin := UnitsTomm(frxStrToFloat(MarginRightE.Text));
Page.TopMargin := UnitsTomm(frxStrToFloat(MarginTopE.Text));
Page.BottomMargin := UnitsTomm(frxStrToFloat(MarginBottomE.Text));
Page.AlignChildren;
end;
end;
|
frxPrintDialog.pas
Похожая недоделка и в этом диалоге.
Если пользователь в PageNumbersE вводит некорректные данные, то возникают системные сообщения об ошибках.
Мне не понятно, почему тут проверку не сделали. Вроде бы есть стандартный диалог печати, который информирует пользователя в случае, если пользователь ошибётся.
Для предотвращения этого, добавлено:
Код:
TfrxPrintDialog
private
...
function CheckPageNumbersE: Boolean;// возвращает false, если в PageNumber.Text
содержатся некорректные данные
function TfrxPrintDialog.CheckPageNumbersE: Boolean;
var i, start,a:Integer;
s,txt:AnsiString;
begin
Result:=true;
start:=1;
txt:=PageNumbersE.Text;
for i:=1 to Length(txt) do begin
if not(txt[i] in ['0','1','2','3','4','5','6','7','8','9',',','-'])then
begin
Result:=false;
break;
end;
if (txt[i]=',') or (txt[i]='-')then begin
s:=Copy(txt, start, i-start);
try
a:=StrToInt(s);
if (a<=0)then Abort;
start:=i+1;
// тут по=хорошему надо бы добавить ещё и проверку, чтобы a не превышала количество страниц в отчёте.
except
Result:=false;
break;
end;
end;
end;
end;
|
написаны два обработчика:
Код:
procedure TfrxPrintDialog.OkBClick(Sender: TObject);// для OkB
begin
if CheckPageNumbersE then OkB.ModalResult:=mrOk
else begin
Application.MessageBox(PChar(frxGet(9)), 'bla-bla-bla', MB_OK or MB_ICONERROR);
OkB.ModalResult:=mrNone;
PageNumbersE.SetFocus;
end;
end;
procedure TfrxPrintDialog.FormClose(Sender: TObject; // для формы
var Action: TCloseAction);
begin
if (OkB.ModalResult=mrNone)then Action:=caNone;
OkB.ModalResult:=mrOk;
end;
|
frxExportRTF.pas:
Первая же попытка сделать экспорт в RTF закончилась неудачей - вылетела ошибка. Стал разбираться.
Разработку я веду естественно при включённых опциях отладки (в том числе и Range check Error). Последняя опция проявляется, например, когда отрицательное число типа Integer пытаемся преобразовать к DWORD. А Integer - это тот же TColor. В функциях этого файла как раз и не учитывается последнее обстоятельство.
Решение - во всех местах где осуществлялись неявные приведения типов, стали осуществлятся явные приведения типов.
было:
Код:
function TfrxRTFExport.GetRTFColor(const c: DWORD): string;
var
cn: DWORD;
begin
cn := ColorToRGB(c);
Result := '\red' + IntToStr(GetRValue(cn)) +
'\green' + IntToStr(GetGValue(cn)) +
'\blue' + IntToStr(GetBValue(cn)) + ';'
end;
|
Стало:
Код:
function TfrxRTFExport.GetRTFColor(const c: DWORD): string;
var
cn: DWORD;
begin
cn := ColorToRGB(TColor(c));
Result := '\red' + IntToStr(GetRValue(cn)) +
'\green' + IntToStr(GetGValue(cn)) +
'\blue' + IntToStr(GetBValue(cn)) + ';'
end;
|
Встречающиеся вызовы GetRFGColor(НекийColor)в многочисленных местах заменены на GetRFGColor(DWORD(НекийColor))
В следующих местах добавил дополнительные проверки. Без которых также выскакивали ошибки.
frxXML.pas
было:
Код:
function Dup(n: Integer): String;
begin
SetLength(Result, n);// тут почему-то у меня получался нулевой n.
// ни времени, ни желания сильно разбираться не было, поэтому нашёл простое решение -
// проверять на "положительность".
FillChar(Result[1], n, ' ');
end;
|
стало:
Код:
function Dup(n: Integer): String;
begin
if (n>0)then begin
SetLength(Result, n);
FillChar(Result[1], n, ' ');
end else Result:='';
end;
|
Ситуация с этим модулем была аналогична предыдущей. При построении отчёта - вываливалась ошибка.
frxAggregate.pas:
процедура вложенная в
procedure TfrxAggregateList.FindAggregates(Memo: TfrxCustomMemoView;
DataBand: TfrxDataBand);
было:
Код:
procedure FindIn(const s: String);
var
i, j: Integer;
s1, s2, s3, s4: String;
begin
if Check(s) then
Exit;
{ this is an expression }
i := 1;
while i <= Length(s) do
begin
{ skip non-significant chars }
while (i <= Length(s)) and (s[i] in Spaces) do
Inc(i);
case s[i] of
'<':
begin
FindIn(frxGetBrackedVariable(s, '<', '>', i, j));
i := j;
end;
|
стало:
Код:
procedure FindIn(const s: String);
var
i, j: Integer;
s1, s2, s3, s4: String;
begin
if Check(s) then
Exit;
{ this is an expression }
i := 1;
while i <= Length(s) do
begin
{ skip non-significant chars }
while (i <= Length(s)) and (s[i] in Spaces) do
Inc(i);
//здесь i становился больше Length(s) и проявлялся Range Check Error. Добавил дополнительную проверку.
if i>Length(s)then break;
case s[i] of
'<':
begin
FindIn(frxGetBrackedVariable(s, '<', '>', i, j));
i := j;
end;
|
|
