paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 05:38:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

New patch from Aleksey Lagunov:

Browse Source 
1. Send to email addons
 - fix work with post client if client locked exported file
2. Internal scrip
 - add mouse cursors const to script engine
 - localize error messages (add russian messages)
 - fix error on parse string values in scrip (now work ' char in string)
3. Report designer
 - in report designer add check code before save script
 - for memo object on master/detail band add popup menu for
   quick select fields from master/detail datasets
   (see option in designer options dialog)

 - fix show scrip editor for dialog page on mouse duble click

4. Crross report
 - add scrip suppert
 - add internal const "CrosViewIsEmpty" 

5. Cleanup code 

git-svn-id: trunk@52504 -
This commit is contained in:
jesus 2016-06-14 20:44:19 +00:00
parent a539c0253f
commit df0d616b82
29 changed files with 1337 additions and 396 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
components/lazreport/source/addons/lrEmailExport/lrEmailExportFilter.pas
View File

@ -212,6 +212,21 @@ begin
end;
end;
function GetTempFileName(const SExt:string):string;
var
i: Integer;
begin
Result:=SysToUTF8(GetTempDir(false))+'Export'+SExt;
if FileExistsUTF8(Result) then
begin
i:=0;
repeat
Inc(i);
Result:=SysToUTF8(GetTempDir(false))+'Export'+IntToStr(i) + SExt;
until not FileExistsUTF8(Result);
end;
end;
function TlrEmailExportFilter.ProcessTool: boolean;
var
FilterClass: TfrExportFilterClass;
@ -228,7 +243,7 @@ begin
break;
end;
if not Assigned(FilterClass) then exit;
FEmailAttachFileName:=SysToUTF8(GetTempDir(false))+'Export'+SExt;
FEmailAttachFileName:=GetTempFileName(SExt); //SysToUTF8(GetTempDir(false))+'Export'+SExt;
FDoc.ExportTo(FilterClass, FEmailAttachFileName);
for i:=0 to Length(EmailAppArray)-1 do

48
components/lazreport/source/languages/lr_const.cs.po
View File

@ -639,6 +639,54 @@ msgstr "Proměnná"
msgid "&Word wrap"
msgstr "Zalamování řádků"
#: lr_const.serrexpectedassign
msgid "Expected \":=\""
msgstr ""
#: lr_const.serrexpectedclosingbracket1
msgid "Expected \")\""
msgstr ""
#: lr_const.serrexpectedclosingbracket2
msgid "Expected \"]\""
msgstr ""
#: lr_const.serrexpectedcomma
msgid "Expected \",\" or \")\""
msgstr ""
#: lr_const.serrexpecteddo
msgid "Expected \"do\""
msgstr ""
#: lr_const.serrexpectedend
msgid "Expected \";\" or \"end\""
msgstr ""
#: lr_const.serrexpectedthen
msgid "Expected \"then\""
msgstr ""
#: lr_const.serrexpecteduntil
msgid "Expected \";\" or \"until\""
msgstr ""
#: lr_const.serrlabelgoto
msgid "Label in goto must be a number"
msgstr ""
#: lr_const.serrline
msgid "Line"
msgstr ""
#: lr_const.serrneeddo
msgid "Need \"do\" here"
msgstr ""
#: lr_const.serrneedto
msgid "Need \"to\" here"
msgstr ""
#: lr_const.serror
msgid "Error"
msgstr "Error"

48
components/lazreport/source/languages/lr_const.de.po
View File

@ -641,6 +641,54 @@ msgstr "&Variable"
msgid "&Word wrap"
msgstr "&Wortumbruch"
#: lr_const.serrexpectedassign
msgid "Expected \":=\""
msgstr ""
#: lr_const.serrexpectedclosingbracket1
msgid "Expected \")\""
msgstr ""
#: lr_const.serrexpectedclosingbracket2
msgid "Expected \"]\""
msgstr ""
#: lr_const.serrexpectedcomma
msgid "Expected \",\" or \")\""
msgstr ""
#: lr_const.serrexpecteddo
msgid "Expected \"do\""
msgstr ""
#: lr_const.serrexpectedend
msgid "Expected \";\" or \"end\""
msgstr ""
#: lr_const.serrexpectedthen
msgid "Expected \"then\""
msgstr ""
#: lr_const.serrexpecteduntil
msgid "Expected \";\" or \"until\""
msgstr ""
#: lr_const.serrlabelgoto
msgid "Label in goto must be a number"
msgstr ""
#: lr_const.serrline
msgid "Line"
msgstr ""
#: lr_const.serrneeddo
msgid "Need \"do\" here"
msgstr ""
#: lr_const.serrneedto
msgid "Need \"to\" here"
msgstr ""
#: lr_const.serror
msgid "Error"
msgstr "Fehler"

48
components/lazreport/source/languages/lr_const.es.po
View File

@ -634,6 +634,54 @@ msgstr "&Variable"
msgid "&Word wrap"
msgstr "&Plegar palabras"
#: lr_const.serrexpectedassign
msgid "Expected \":=\""
msgstr ""
#: lr_const.serrexpectedclosingbracket1
msgid "Expected \")\""
msgstr ""
#: lr_const.serrexpectedclosingbracket2
msgid "Expected \"]\""
msgstr ""
#: lr_const.serrexpectedcomma
msgid "Expected \",\" or \")\""
msgstr ""
#: lr_const.serrexpecteddo
msgid "Expected \"do\""
msgstr ""
#: lr_const.serrexpectedend
msgid "Expected \";\" or \"end\""
msgstr ""
#: lr_const.serrexpectedthen
msgid "Expected \"then\""
msgstr ""
#: lr_const.serrexpecteduntil
msgid "Expected \";\" or \"until\""
msgstr ""
#: lr_const.serrlabelgoto
msgid "Label in goto must be a number"
msgstr ""
#: lr_const.serrline
msgid "Line"
msgstr ""
#: lr_const.serrneeddo
msgid "Need \"do\" here"
msgstr ""
#: lr_const.serrneedto
msgid "Need \"to\" here"
msgstr ""
#: lr_const.serror
msgid "Error"
msgstr "Error"

48
components/lazreport/source/languages/lr_const.fr.po
View File

@ -634,6 +634,54 @@ msgstr "&Variable"
msgid "&Word wrap"
msgstr "&Mots entiers"
#: lr_const.serrexpectedassign
msgid "Expected \":=\""
msgstr ""
#: lr_const.serrexpectedclosingbracket1
msgid "Expected \")\""
msgstr ""
#: lr_const.serrexpectedclosingbracket2
msgid "Expected \"]\""
msgstr ""
#: lr_const.serrexpectedcomma
msgid "Expected \",\" or \")\""
msgstr ""
#: lr_const.serrexpecteddo
msgid "Expected \"do\""
msgstr ""
#: lr_const.serrexpectedend
msgid "Expected \";\" or \"end\""
msgstr ""
#: lr_const.serrexpectedthen
msgid "Expected \"then\""
msgstr ""
#: lr_const.serrexpecteduntil
msgid "Expected \";\" or \"until\""
msgstr ""
#: lr_const.serrlabelgoto
msgid "Label in goto must be a number"
msgstr ""
#: lr_const.serrline
msgid "Line"
msgstr ""
#: lr_const.serrneeddo
msgid "Need \"do\" here"
msgstr ""
#: lr_const.serrneedto
msgid "Need \"to\" here"
msgstr ""
#: lr_const.serror
msgid "Error"
msgstr "Erreur"

48
components/lazreport/source/languages/lr_const.hu.po
View File

@ -633,6 +633,54 @@ msgstr "&Változó"
msgid "&Word wrap"
msgstr "Szótördelés"
#: lr_const.serrexpectedassign
msgid "Expected \":=\""
msgstr ""
#: lr_const.serrexpectedclosingbracket1
msgid "Expected \")\""
msgstr ""
#: lr_const.serrexpectedclosingbracket2
msgid "Expected \"]\""
msgstr ""
#: lr_const.serrexpectedcomma
msgid "Expected \",\" or \")\""
msgstr ""
#: lr_const.serrexpecteddo
msgid "Expected \"do\""
msgstr ""
#: lr_const.serrexpectedend
msgid "Expected \";\" or \"end\""
msgstr ""
#: lr_const.serrexpectedthen
msgid "Expected \"then\""
msgstr ""
#: lr_const.serrexpecteduntil
msgid "Expected \";\" or \"until\""
msgstr ""
#: lr_const.serrlabelgoto
msgid "Label in goto must be a number"
msgstr ""
#: lr_const.serrline
msgid "Line"
msgstr ""
#: lr_const.serrneeddo
msgid "Need \"do\" here"
msgstr ""
#: lr_const.serrneedto
msgid "Need \"to\" here"
msgstr ""
#: lr_const.serror
msgid "Error"
msgstr "Hiba"

48
components/lazreport/source/languages/lr_const.id.po
View File

@ -641,6 +641,54 @@ msgstr "&Variabel"
msgid "&Word wrap"
msgstr "&Gulung"
#: lr_const.serrexpectedassign
msgid "Expected \":=\""
msgstr ""
#: lr_const.serrexpectedclosingbracket1
msgid "Expected \")\""
msgstr ""
#: lr_const.serrexpectedclosingbracket2
msgid "Expected \"]\""
msgstr ""
#: lr_const.serrexpectedcomma
msgid "Expected \",\" or \")\""
msgstr ""
#: lr_const.serrexpecteddo
msgid "Expected \"do\""
msgstr ""
#: lr_const.serrexpectedend
msgid "Expected \";\" or \"end\""
msgstr ""
#: lr_const.serrexpectedthen
msgid "Expected \"then\""
msgstr ""
#: lr_const.serrexpecteduntil
msgid "Expected \";\" or \"until\""
msgstr ""
#: lr_const.serrlabelgoto
msgid "Label in goto must be a number"
msgstr ""
#: lr_const.serrline
msgid "Line"
msgstr ""
#: lr_const.serrneeddo
msgid "Need \"do\" here"
msgstr ""
#: lr_const.serrneedto
msgid "Need \"to\" here"
msgstr ""
#: lr_const.serror
msgid "Error"
msgstr "Salah"

48
components/lazreport/source/languages/lr_const.it.po
View File

@ -635,6 +635,54 @@ msgstr "&Variabile"
msgid "&Word wrap"
msgstr "Spezza &parole"
#: lr_const.serrexpectedassign
msgid "Expected \":=\""
msgstr ""
#: lr_const.serrexpectedclosingbracket1
msgid "Expected \")\""
msgstr ""
#: lr_const.serrexpectedclosingbracket2
msgid "Expected \"]\""
msgstr ""
#: lr_const.serrexpectedcomma
msgid "Expected \",\" or \")\""
msgstr ""
#: lr_const.serrexpecteddo
msgid "Expected \"do\""
msgstr ""
#: lr_const.serrexpectedend
msgid "Expected \";\" or \"end\""
msgstr ""
#: lr_const.serrexpectedthen
msgid "Expected \"then\""
msgstr ""
#: lr_const.serrexpecteduntil
msgid "Expected \";\" or \"until\""
msgstr ""
#: lr_const.serrlabelgoto
msgid "Label in goto must be a number"
msgstr ""
#: lr_const.serrline
msgid "Line"
msgstr ""
#: lr_const.serrneeddo
msgid "Need \"do\" here"
msgstr ""
#: lr_const.serrneedto
msgid "Need \"to\" here"
msgstr ""
#: lr_const.serror
msgid "Error"
msgstr "Errore"

48
components/lazreport/source/languages/lr_const.lt.po
View File

@ -645,6 +645,54 @@ msgstr "&Kintamasis"
msgid "&Word wrap"
msgstr "&Laužyti tekstą"
#: lr_const.serrexpectedassign
msgid "Expected \":=\""
msgstr ""
#: lr_const.serrexpectedclosingbracket1
msgid "Expected \")\""
msgstr ""
#: lr_const.serrexpectedclosingbracket2
msgid "Expected \"]\""
msgstr ""
#: lr_const.serrexpectedcomma
msgid "Expected \",\" or \")\""
msgstr ""
#: lr_const.serrexpecteddo
msgid "Expected \"do\""
msgstr ""
#: lr_const.serrexpectedend
msgid "Expected \";\" or \"end\""
msgstr ""
#: lr_const.serrexpectedthen
msgid "Expected \"then\""
msgstr ""
#: lr_const.serrexpecteduntil
msgid "Expected \";\" or \"until\""
msgstr ""
#: lr_const.serrlabelgoto
msgid "Label in goto must be a number"
msgstr ""
#: lr_const.serrline
msgid "Line"
msgstr ""
#: lr_const.serrneeddo
msgid "Need \"do\" here"
msgstr ""
#: lr_const.serrneedto
msgid "Need \"to\" here"
msgstr ""
#: lr_const.serror
msgid "Error"
msgstr "Klaida"

48
components/lazreport/source/languages/lr_const.pl.po
View File

@ -638,6 +638,54 @@ msgstr "&Zmienna"
msgid "&Word wrap"
msgstr "&Zawijanie tekstu"
#: lr_const.serrexpectedassign
msgid "Expected \":=\""
msgstr ""
#: lr_const.serrexpectedclosingbracket1
msgid "Expected \")\""
msgstr ""
#: lr_const.serrexpectedclosingbracket2
msgid "Expected \"]\""
msgstr ""
#: lr_const.serrexpectedcomma
msgid "Expected \",\" or \")\""
msgstr ""
#: lr_const.serrexpecteddo
msgid "Expected \"do\""
msgstr ""
#: lr_const.serrexpectedend
msgid "Expected \";\" or \"end\""
msgstr ""
#: lr_const.serrexpectedthen
msgid "Expected \"then\""
msgstr ""
#: lr_const.serrexpecteduntil
msgid "Expected \";\" or \"until\""
msgstr ""
#: lr_const.serrlabelgoto
msgid "Label in goto must be a number"
msgstr ""
#: lr_const.serrline
msgid "Line"
msgstr ""
#: lr_const.serrneeddo
msgid "Need \"do\" here"
msgstr ""
#: lr_const.serrneedto
msgid "Need \"to\" here"
msgstr ""
#: lr_const.serror
msgid "Error"
msgstr "Błąd"

48
components/lazreport/source/languages/lr_const.po
View File

@ -626,6 +626,54 @@ msgstr ""
msgid "&Word wrap"
msgstr ""
#: lr_const.serrexpectedassign
msgid "Expected \":=\""
msgstr ""
#: lr_const.serrexpectedclosingbracket1
msgid "Expected \")\""
msgstr ""
#: lr_const.serrexpectedclosingbracket2
msgid "Expected \"]\""
msgstr ""
#: lr_const.serrexpectedcomma
msgid "Expected \",\" or \")\""
msgstr ""
#: lr_const.serrexpecteddo
msgid "Expected \"do\""
msgstr ""
#: lr_const.serrexpectedend
msgid "Expected \";\" or \"end\""
msgstr ""
#: lr_const.serrexpectedthen
msgid "Expected \"then\""
msgstr ""
#: lr_const.serrexpecteduntil
msgid "Expected \";\" or \"until\""
msgstr ""
#: lr_const.serrlabelgoto
msgid "Label in goto must be a number"
msgstr ""
#: lr_const.serrline
msgid "Line"
msgstr ""
#: lr_const.serrneeddo
msgid "Need \"do\" here"
msgstr ""
#: lr_const.serrneedto
msgid "Need \"to\" here"
msgstr ""
#: lr_const.serror
msgid "Error"
msgstr ""

48
components/lazreport/source/languages/lr_const.pt_BR.po
View File

@ -644,6 +644,54 @@ msgstr "&Variável"
msgid "&Word wrap"
msgstr "&Quebra palavra"
#: lr_const.serrexpectedassign
msgid "Expected \":=\""
msgstr ""
#: lr_const.serrexpectedclosingbracket1
msgid "Expected \")\""
msgstr ""
#: lr_const.serrexpectedclosingbracket2
msgid "Expected \"]\""
msgstr ""
#: lr_const.serrexpectedcomma
msgid "Expected \",\" or \")\""
msgstr ""
#: lr_const.serrexpecteddo
msgid "Expected \"do\""
msgstr ""
#: lr_const.serrexpectedend
msgid "Expected \";\" or \"end\""
msgstr ""
#: lr_const.serrexpectedthen
msgid "Expected \"then\""
msgstr ""
#: lr_const.serrexpecteduntil
msgid "Expected \";\" or \"until\""
msgstr ""
#: lr_const.serrlabelgoto
msgid "Label in goto must be a number"
msgstr ""
#: lr_const.serrline
msgid "Line"
msgstr ""
#: lr_const.serrneeddo
msgid "Need \"do\" here"
msgstr ""
#: lr_const.serrneedto
msgid "Need \"to\" here"
msgstr ""
#: lr_const.serror
msgid "Error"
msgstr "Erro"

48
components/lazreport/source/languages/lr_const.ru.po
View File

@ -633,6 +633,54 @@ msgstr "П&еременная"
msgid "&Word wrap"
msgstr "&Перенос слов"
#: lr_const.serrexpectedassign
msgid "Expected \":=\""
msgstr "Ожидается \":=\""
#: lr_const.serrexpectedclosingbracket1
msgid "Expected \")\""
msgstr "Ожидается \")\""
#: lr_const.serrexpectedclosingbracket2
msgid "Expected \"]\""
msgstr "Ожидается \"]\""
#: lr_const.serrexpectedcomma
msgid "Expected \",\" or \")\""
msgstr "Ожидается \",\" или \")\""
#: lr_const.serrexpecteddo
msgid "Expected \"do\""
msgstr "Ожидается \"do\""
#: lr_const.serrexpectedend
msgid "Expected \";\" or \"end\""
msgstr "Ожидается \";\" или \"end\""
#: lr_const.serrexpectedthen
msgid "Expected \"then\""
msgstr "Ожидается \"then\""
#: lr_const.serrexpecteduntil
msgid "Expected \";\" or \"until\""
msgstr "Ожидается \";\" или \"until\""
#: lr_const.serrlabelgoto
msgid "Label in goto must be a number"
msgstr "Метка в goto должна быть числом"
#: lr_const.serrline
msgid "Line"
msgstr "Строка"
#: lr_const.serrneeddo
msgid "Need \"do\" here"
msgstr "Здесь необходимо \"do\""
#: lr_const.serrneedto
msgid "Need \"to\" here"
msgstr "Здесь необходимо \"to\""
#: lr_const.serror
msgid "Error"
msgstr "Ошибка"

48
components/lazreport/source/languages/lr_const.uk.po
View File

@ -646,6 +646,54 @@ msgstr "&Змінна"
msgid "&Word wrap"
msgstr "&Перенесення слів"
#: lr_const.serrexpectedassign
msgid "Expected \":=\""
msgstr ""
#: lr_const.serrexpectedclosingbracket1
msgid "Expected \")\""
msgstr ""
#: lr_const.serrexpectedclosingbracket2
msgid "Expected \"]\""
msgstr ""
#: lr_const.serrexpectedcomma
msgid "Expected \",\" or \")\""
msgstr ""
#: lr_const.serrexpecteddo
msgid "Expected \"do\""
msgstr ""
#: lr_const.serrexpectedend
msgid "Expected \";\" or \"end\""
msgstr ""
#: lr_const.serrexpectedthen
msgid "Expected \"then\""
msgstr ""
#: lr_const.serrexpecteduntil
msgid "Expected \";\" or \"until\""
msgstr ""
#: lr_const.serrlabelgoto
msgid "Label in goto must be a number"
msgstr ""
#: lr_const.serrline
msgid "Line"
msgstr ""
#: lr_const.serrneeddo
msgid "Need \"do\" here"
msgstr ""
#: lr_const.serrneedto
msgid "Need \"to\" here"
msgstr ""
#: lr_const.serror
msgid "Error"
msgstr "Помилка"

51
components/lazreport/source/lr_class.pas
View File

@ -103,11 +103,14 @@ type
TlrRestriction = (lrrDontModify, lrrDontSize, lrrDontMove, lrrDontDelete);
TlrRestrictions = set of TlrRestriction;
TfrView = class;
TfrBand = class;
TfrPage = class;
TfrObject = class;
TfrView = class;
TfrBand = class;
TfrPage = class;
TfrReport = class;
TfrExportFilter = class;
TfrExportFilter = class;
TfrMemoStrings = class;
TfrScriptStrings = class;
TDetailEvent = procedure(const ParName: String; var ParValue: Variant) of object;
TEnterRectEvent = procedure(Memo: TStringList; View: TfrView) of object;
@ -123,8 +126,9 @@ type
TManualBuildEvent = procedure(Page: TfrPage) of object;
TObjectClickEvent = procedure(View: TfrView) of object;
TMouseOverObjectEvent = procedure(View: TfrView; var ACursor: TCursor) of object;
TPrintReportEvent = procedure(sender: TfrReport) of object;
TFormPageBookmarksEvent = procedure(sender: TfrReport; Backup: boolean) of object;
TPrintReportEvent = procedure(Sender: TfrReport) of object;
TFormPageBookmarksEvent = procedure(Sender: TfrReport; Backup: boolean) of object;
TExecScriptEvent = procedure(frObject:TfrObject; AScript:TfrScriptStrings) of object;
TfrHighlightAttr = packed record
FontStyle: Word;
@ -180,7 +184,7 @@ type
{ TfrObject }
TfrObject = Class(TPersistent)
TfrObject = class(TPersistent)
private
fMemo : TfrMemoStrings;
fName : string;
@ -193,8 +197,9 @@ type
protected
FDesignOptions:TlrDesignOptions;
BaseName : String;
OwnerPage:TfrPage;
OwnerPage : TfrPage;
FOnExecScriptEvent : TExecScriptEvent;
function GetSaveProperty(const Prop : String; aObj : TPersistent=nil) : string;
procedure RestoreProperty(const Prop,aValue : String; aObj : TPersistent=nil);
procedure SetName(const AValue: string); virtual;
@ -212,6 +217,7 @@ type
procedure SetVisible(AValue: Boolean);virtual;
function GetText:string;virtual;
procedure SetText(AValue:string);virtual;
procedure InternalExecScript;virtual;
public
x, y, dx, dy: Integer;
@ -475,6 +481,7 @@ type
procedure ResetLastValue; override;
procedure DoRunScript(AScript: TfrScriptStrings);
procedure DoOnClick;
procedure DoMouseEnter;
procedure DoMouseLeave;
@ -2850,7 +2857,8 @@ begin
BeginDraw(Canvas);
Memo1.Assign(Memo);
CurReport.InternalOnEnterRect(Memo1, Self);
frInterpretator.DoScript(Script);
//frInterpretator.DoScript(Script);
InternalExecScript;
if not Visible then Exit;
Stream.Write(Typ, 1);
@ -4378,7 +4386,8 @@ begin
BeginDraw(TempBmp.Canvas);
Streaming := True;
if DrawMode = drAll then
frInterpretator.DoScript(Script);
InternalExecScript;
//frInterpretator.DoScript(Script);
CanExpandVar := True;
if (DrawMode = drAll) and (Assigned(CurReport.OnEnterRect) or
@ -4479,7 +4488,9 @@ begin
Result := 0;
DrawMode := drAfterCalcHeight;
BeginDraw(TempBmp.Canvas);
frInterpretator.DoScript(Script);
//frInterpretator.DoScript(Script);
InternalExecScript;
if not Visible then Exit;
{$IFDEF DebugLR}
DebugLnEnter('TfrMemoView.CalcHeight %s INIT',[ViewInfo(Self)]);
@ -10102,6 +10113,7 @@ var
D: TfrTDataSet;
F: TfrTField;
s1: String;
aCursr: Longint;
function MasterBand: TfrBand;
begin
@ -10197,6 +10209,12 @@ begin
begin
aValue := Title;
Exit;
end
else
if IdentToCursor(S, aCursr) then
begin
aValue:=aCursr;
exit;
end;
if s <> SubValue then
begin
@ -12907,6 +12925,14 @@ begin
fMemo.Text:=AValue;
end;
procedure TfrObject.InternalExecScript;
begin
if Assigned(FOnExecScriptEvent) then
FOnExecScriptEvent(Self, Script)
else
frInterpretator.DoScript(Script);
end;
procedure TfrObject.SetWidth(AValue: Integer);
begin
DX:=AValue;
@ -13048,6 +13074,7 @@ begin
Memo.Assign(TfrObject(Source).Memo);
Script.Assign(TfrObject(Source).Script);
Visible:=TfrObject(Source).Visible;
FOnExecScriptEvent:=TfrObject(Source).FOnExecScriptEvent;
end;
end;

14
components/lazreport/source/lr_const.pas
View File

@ -819,6 +819,20 @@ resourcestring
sReportCorruptOldKnowVersion = 'This report is corrupt, it probably needs "LRE_OLDV%d_FRF_READ"=true';
sReportCorruptUnknownVersion = 'This report is corrupt, frVersion=%d';
//--- LR_Intrp resources ---------------------------------------------------
sErrLine = 'Line';
sErrExpectedEnd = 'Expected ";" or "end"';
sErrExpectedThen = 'Expected "then"';
sErrExpectedUntil = 'Expected ";" or "until"';
sErrExpectedDO = 'Expected "do"';
sErrLabelGoto = 'Label in goto must be a number';
sErrExpectedAssign = 'Expected ":="';
sErrExpectedClosingBracket1 = 'Expected ")"';
sErrExpectedClosingBracket2 = 'Expected "]"';
sErrExpectedComma ='Expected "," or ")"';
sErrNeedDo = 'Need "do" here';
sErrNeedTo = 'Need "to" here';
const
frRes = 53000;

6
components/lazreport/source/lr_crossarray.pas
View File

@ -70,6 +70,7 @@ type
FBookmark:TBookMark;
public
procedure SaveBookmark(Ds: TDataset);
procedure GotoBookmark;
function IsBookmarkValid: boolean;
destructor destroy; override;
end;
@ -237,6 +238,11 @@ begin
FBookmark := FDataset.GetBookmark;
end;
procedure TExItem.GotoBookmark;
begin
FDataset.Bookmark := FBookmark;
end;
function TExItem.IsBookmarkValid: boolean;
begin
result := (FDataset<>nil) and FDataset.BookmarkValid(FBookmark)

47
components/lazreport/source/lr_crosstab.pas
View File

@ -146,6 +146,8 @@ type
procedure OnPrintColumn(ColNo: Integer; var AWidth: Integer);
procedure OnEnterRect(AMemo: TStringList; AView: TfrView);
procedure OnExecScript(frObject:TfrObject; AScript:TfrScriptStrings);
procedure SetRowTitleCell(AValue: TlrCrossDesignView);
procedure SetRowTotalCell(AValue: TlrCrossDesignView);
procedure SetTotalCHCell(AValue: TlrCrossDesignView);
@ -226,6 +228,7 @@ type
constructor Create(AOwnerPage:TfrPage); override;
end;
TlrHackObject = class(TfrObject);
{ TlrCrossDesignDataView }
@ -330,6 +333,7 @@ end;
begin
DoneCrossData;
FData:=nil;
FD:=nil;
FR:=nil;
@ -378,6 +382,7 @@ begin
P:=FData.GetBookmark;
FData.DisableControls;
try
FData.First;
while not FData.EOF do
begin
@ -397,7 +402,7 @@ begin
FExVarArray.Cell[FC.Value, FR.Value]:=FD.DisplayText;
ExItem:=FExVarArray.CellData[FC.Value, FR.Value];
if Assigned(ExItem) then
if Assigned(ExItem) and not ExItem.IsBookmarkValid then
ExItem.SaveBookmark(FData);
FData.Next;
end;
@ -573,7 +578,7 @@ begin
ExItem:=FExVarArray.CellData[SC, SR];
if Assigned(ExItem) and ExItem.IsBookmarkValid then
ExItem.SaveBookmark(FData);
ExItem.GotoBookmark;
end
else
if S = '-RowTitle-' then
@ -689,6 +694,43 @@ begin
// DX:=10 + 22 * 3;
end;
procedure TlrCrossView.OnExecScript(frObject: TfrObject;
AScript: TfrScriptStrings);
var
M:TfrMemoView;
S: String;
ColNo: Integer;
RecNo: Integer;
V, SC, SR : Variant;
ExItem:TExItem;
begin
ColNo:=FBandCrossRowRT.Parent.DataSet.RecNo;
RecNo:=FBandDataRowRT.Parent.DataSet.RecNo;
M:=TfrMemoView(frObject);
S:= M.Memo[0];
if S='-Cell-' then
begin
SC:=FExVarArray.ColHeader[ColNo];
SR:=FExVarArray.RowHeader[RecNo];
ExItem:=FExVarArray.CellData[SC, SR];
if Assigned(ExItem) and ExItem.IsBookmarkValid then
begin
frVariables['CrossViewIsEmpty']:=false;
ExItem.GotoBookmark;
end
else
frVariables['CrossViewIsEmpty']:=true;
frInterpretator.DoScript(AScript);
end
end;
procedure TlrCrossView.Print(Stream: TStream);
var
FPage : TlrCrossPage;
@ -796,6 +838,7 @@ begin
FView.Assign(FDataCell);
FView.SetBounds(FXPos, FYPos, FDataCell.DX, FDataCell.dy);
FView.Memo.Text:='-Cell-';
TlrHackObject(FView).FOnExecScriptEvent:=@OnExecScript;
if FShowRowTotal or FShowGrandTotal then
begin

133
components/lazreport/source/lr_desgn.lfm
View File

@ -9,7 +9,7 @@ object frDesignerForm: TfrDesignerForm
VertScrollBar.Range = 149
ActiveControl = frDock1
Caption = 'Designer'
ClientHeight = 405
ClientHeight = 406
ClientWidth = 695
KeyPreview = True
Menu = MainMenu1
@ -23,12 +23,12 @@ object frDesignerForm: TfrDesignerForm
OnResize = FormResize
OnShow = FormShow
ShowHint = True
LCLVersion = '1.5'
LCLVersion = '1.7'
WindowState = wsMaximized
object StatusBar1: TStatusBar
Left = 0
Height = 25
Top = 380
Height = 24
Top = 382
Width = 695
Panels = <
item
@ -1651,7 +1651,7 @@ object frDesignerForm: TfrDesignerForm
object C3: TComboBox
Tag = 8
Left = 161
Height = 33
Height = 32
Top = 2
Width = 67
ItemHeight = 0
@ -1683,7 +1683,7 @@ object frDesignerForm: TfrDesignerForm
object C2: TComboBox
Tag = 7
Left = 1
Height = 35
Height = 34
Top = 2
Width = 155
ItemHeight = 13
@ -2080,7 +2080,7 @@ object frDesignerForm: TfrDesignerForm
object E1: TEdit
Tag = 6
Left = 4
Height = 31
Height = 30
Top = 1
Width = 31
TabOrder = 0
@ -2145,21 +2145,21 @@ object frDesignerForm: TfrDesignerForm
end
object frDock2: TPanel
Left = 0
Height = 300
Height = 302
Top = 80
Width = 27
Align = alLeft
ClientHeight = 300
ClientHeight = 302
ClientWidth = 27
FullRepaint = False
TabOrder = 1
object panForDlg: TPanel
Left = 1
Height = 298
Height = 300
Top = 1
Width = 25
Align = alClient
ClientHeight = 298
ClientHeight = 300
ClientWidth = 25
FullRepaint = False
TabOrder = 1
@ -2225,11 +2225,11 @@ object frDesignerForm: TfrDesignerForm
end
object Panel4: TPanel
Left = 1
Height = 298
Height = 300
Top = 1
Width = 25
Align = alClient
ClientHeight = 298
ClientHeight = 300
ClientWidth = 25
FullRepaint = False
TabOrder = 0
@ -2528,7 +2528,7 @@ object frDesignerForm: TfrDesignerForm
end
object Tab1: TTabControl
Left = 27
Height = 300
Height = 302
Top = 80
Width = 641
TabStop = False
@ -2542,24 +2542,24 @@ object frDesignerForm: TfrDesignerForm
TabOrder = 2
object panTab: TPanel
Left = 2
Height = 262
Top = 36
Height = 265
Top = 35
Width = 637
Align = alClient
BevelOuter = bvNone
Caption = 'panTab'
ClientHeight = 262
ClientHeight = 265
ClientWidth = 637
TabOrder = 1
object ScrollBox1: TScrollBox
Left = 0
Height = 262
Height = 265
Top = 0
Width = 637
HorzScrollBar.Page = 488
VertScrollBar.Page = 174
Align = alClient
ClientHeight = 260
ClientHeight = 263
ClientWidth = 635
Color = clGray
ParentColor = False
@ -3817,17 +3817,32 @@ object frDesignerForm: TfrDesignerForm
OnClick = frSpeedButton1Click
end
end
object IEButton: TSpeedButton
Left = 379
Height = 22
Top = 140
Width = 16
Glyph.Data = {
92000000424D9200000000000000760000002800000007000000070000000100
0400000000001C00000000000000000000000000000000000000000000000000
8000008000000080800080000000800080008080000080808000C0C0C0000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00FFF0FFF0FF00
0FF0FF000FF0F00000F0F00000F00000000000000000
}
Visible = False
OnClick = IEButtonClick
end
end
end
end
object frDock4: TPanel
Left = 668
Height = 300
Height = 302
Top = 80
Width = 27
Align = alRight
Anchors = [akTop, akRight]
ClientHeight = 300
ClientHeight = 302
ClientWidth = 27
FullRepaint = False
TabOrder = 3
@ -4622,9 +4637,81 @@ object frDesignerForm: TfrDesignerForm
Caption = '&Edit'
object N46: TMenuItem
Action = edtUndo
Bitmap.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000018A6C3691AA7C46900A0C4180000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000A0C45D66DBEAB211A6C2AE0000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000A0C42243C4DBFC43C5D8FE23A6C07F00000000000000000000
00000000000000000000000000000000000000A0C4FF00000000000000000000
000000000000000000000EAACBFE5DDAE9FE23A6C0EF00000000000000000000
000000000000000000000000000000A0C4FF00A0C4FF00000000000000000000
000000000000009EC11A02ACC8FF88E7F2FE11A2C2FF00000000000000000000
00000000000005797D1100A0C4FF76EDFBFF00A0C4FF000000000000000000A0
C4300099B95000A0C4C96DE6F5FF76E2EFFF19A3C1FF00000000000000000000
000005797D1100A0C4FF76EDFBFF76EDFBFF00A0C4FF00A0C4FF00A0C4FF00A0
C4FF01A9C4FF6EE1EEFF0FC9DFFF69E4F2FF1AA4C0F800000000000000000579
7D1100A0C4FF76EDFBFF04C3DAFF76EDFBFF69EAF9FF69EAF9FF69EAF9FF69EA
F9FF05DDF7FF0AC8DFFF07C2D8FF6FDCEBFF1BA3BFF40000000005797E1100A0
C4FF79EDFBFF32E2F8FF2CDFF4FF04C0D6FF04C0D6FF04C0D6FF1DD2E8FF1DD2
E8FF1DD2E8FF0BC8DFFF6AE5F3FF1BABC5F815A0BCCB0000000000A0C4FFADF3
FBFF2FE0F6FF32E2F8FF32E2F7FF32E2F7FF2FE0F5FF29DBF1FF1DD2E8FF1DD2
E8FF1DD2E8FF36D9ECFF40CDE1FF16A1BDCA05797D0A0000000005797D0A00A0
C4FFADF3FBFF2FE0F6FF32E2F7FF29DBF1FF2FE0F5FF29DBF1FF16CDE3FF36D9
ECFF69E7F6FF41CEE3FE13A3C1E405797D320000000000000000000000000579
7D1100A0C4FFADF3FBFF31E1F6FF20E3FAFF73ECFAFF6FEBFAFF6EE8F7FF6CE8
F7F814A1BCD414A3C1D505797D1C000000000000000000000000000000000000
000005797D1100A0C4FFADF3FBFF25E4FBFF00A0C4FF00A0C4FF13A1BEE7159F
BBCF1BA1BBA4067A7C0B00000000000000000000000000000000000000000000
00000000000005797D1100A0C4FFADF3FBFF00A0C4FF00000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000009DBF1400A0C4FF00A0C4FF00000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000A0C4FF00000000000000000000
0000000000000000000000000000000000000000000000000000
}
end
object N48: TMenuItem
Action = edtRedo
Bitmap.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000FFFFFF000000
000000A0C4181AA7C46918A6C369000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFFFFF000000
000011A6C2AE66DBEAB200A0C45D000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFFFFF0023A6
C07F43C5D8FE43C4DBFC00A0C422000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFFFFF0023A6
C0EF5DDAE9FE0EAACBFE000000000000000000000000000000000000000000A0
C4FF000000000000000000000000000000000000000000000000FFFFFF0011A2
C2FF88E7F2FE02ACC8FF009EC11A0000000000000000000000000000000000A0
C4FF00A0C4FF0000000000000000000000000000000000000000FFFFFF0019A3
C1FF76E2EFFF6DE6F5FF00A0C4C90099B95000A0C430000000000000000000A0
C4FF76EDFBFF00A0C4FF05797D11000000000000000000000000FFFFFF001AA4
C0F869E4F2FF0FC9DFFF6EE1EEFF01A9C4FF00A0C4FF00A0C4FF00A0C4FF00A0
C4FF76EDFBFF76EDFBFF00A0C4FF05797D110000000000000000FFFFFF001BA3
BFF46FDCEBFF07C2D8FF0AC8DFFF05DDF7FF69EAF9FF69EAF9FF69EAF9FF69EA
F9FF76EDFBFF04C3DAFF76EDFBFF00A0C4FF05797D1100000000FFFFFF0015A0
BCCB1BABC5F86AE5F3FF0BC8DFFF1DD2E8FF1DD2E8FF1DD2E8FF04C0D6FF04C0
D6FF04C0D6FF2CDFF4FF32E2F8FF79EDFBFF00A0C4FF05797E11FFFFFF000579
7D0A16A1BDCA40CDE1FF36D9ECFF1DD2E8FF1DD2E8FF1DD2E8FF29DBF1FF2FE0
F5FF32E2F7FF32E2F7FF32E2F8FF2FE0F6FFADF3FBFF00A0C4FFFFFFFF000000
000005797D3213A3C1E441CEE3FE69E7F6FF36D9ECFF16CDE3FF29DBF1FF2FE0
F5FF29DBF1FF32E2F7FF2FE0F6FFADF3FBFF00A0C4FF05797D0AFFFFFF000000
00000000000005797D1C14A3C1D514A1BCD46CE8F7F86EE8F7FF6FEBFAFF73EC
FAFF20E3FAFF31E1F6FFADF3FBFF00A0C4FF05797D1100000000FFFFFF000000
00000000000000000000067A7C0B1BA1BBA4159FBBCF13A1BEE700A0C4FF00A0
C4FF25E4FBFFADF3FBFF00A0C4FF05797D110000000000000000FFFFFF000000
00000000000000000000000000000000000000000000000000000000000000A0
C4FFADF3FBFF00A0C4FF05797D11000000000000000000000000FFFFFF000000
00000000000000000000000000000000000000000000000000000000000000A0
C4FF00A0C4FF009DBF1400000000000000000000000000000000FFFFFF000000
00000000000000000000000000000000000000000000000000000000000000A0
C4FF000000000000000000000000000000000000000000000000
}
end
object N47: TMenuItem
Caption = '-'
@ -5234,4 +5321,8 @@ object frDesignerForm: TfrDesignerForm
0000000000000000000000000000
}
end
object IEPopupMenu: TPopupMenu
left = 411
top = 280
end
end

178
components/lazreport/source/lr_desgn.pas
View File

@ -18,7 +18,7 @@ interface
{$define sbod} // status bar owner draw
{$define ppaint}
uses
Classes, SysUtils, LazFileUtils, LazUTF8, LMessages,
Classes, SysUtils, Types, LazFileUtils, LazUTF8, LMessages,
Forms, Controls, Graphics, Dialogs, ComCtrls,
ExtCtrls, Buttons, StdCtrls, Menus,
@ -248,6 +248,8 @@ type
edtRedo: TAction;
edtUndo: TAction;
MenuItem2: TMenuItem;
IEPopupMenu: TPopupMenu;
IEButton: TSpeedButton;
tlsDBFields: TAction;
FileBeforePrintScript: TAction;
FileOpen: TAction;
@ -396,7 +398,6 @@ type
Align9: TSpeedButton;
Align10: TSpeedButton;
frTBSeparator13: TPanel;
//** Tab1: TTabControl;
frDock4: TPanel;
HelpMenu: TMenuItem;
N34: TMenuItem;
@ -449,6 +450,7 @@ type
procedure ScrollBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure ScrollBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure IEButtonClick(Sender: TObject);
procedure tlsDBFieldsExecute(Sender: TObject);
procedure ZB1Click(Sender: TObject);
procedure ZB2Click(Sender: TObject);
@ -626,6 +628,7 @@ type
procedure DuplicateView(View: TfrView; Data: PtrInt);
procedure ResetDuplicateCount;
function lrDesignAcceptDrag(const Source: TObject): TControl;
procedure InplaceEditorMenuClick(Sender: TObject);
private
FTabMouseDown:boolean;
FTabsPage:TlrTabEditControl;
@ -634,6 +637,8 @@ type
procedure TabsEditMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure TabsEditMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure TabsEditMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ShowIEButton(AView: TfrMemoView);
procedure HideIEButton;
protected
procedure SetModified(AValue: Boolean);override;
function IniFileName:string;
@ -650,6 +655,7 @@ type
procedure AfterChange; override;
procedure ShowMemoEditor;
procedure ShowEditor;
procedure ShowDialogPgEditor(APage:TfrPageDialog);
procedure RedrawPage; override;
procedure OnModify({%H-}sender: TObject);
function PointsToUnits(x: Integer): Double; override;
@ -673,6 +679,7 @@ var
frTemplateDir: String;
edtScriptFontName : string = '';
edtScriptFontSize : integer = 0;
edtUseIE : boolean = false;
implementation
@ -684,7 +691,7 @@ uses
LR_Pgopt, LR_GEdit, LR_Templ, LR_Newrp, LR_DsOpt, LR_Const, LR_Pars,
LR_Prntr, LR_Hilit, LR_Flds, LR_Dopt, LR_Ev_ed, LR_BndEd, LR_VBnd,
LR_BTyp, LR_Utils, LR_GrpEd, LR_About, LR_IFlds, LR_DBRel,LR_DBSet,
DB, lr_design_ins_filed, IniFiles;
DB, lr_design_ins_filed, IniFiles, LR_DSet, math;
type
THackView = class(TfrView)
@ -1700,9 +1707,10 @@ begin
end;
GetMultipleSelected;
if not DontChange then begin
FDesigner.SelectionChanged;
FDesigner.ResetDuplicateCount;
if not DontChange then
begin
FDesigner.SelectionChanged;
FDesigner.ResetDuplicateCount;
end;
end
else
@ -2137,6 +2145,9 @@ begin
NPDrawLayerObjects(ClipRgn, TopSelected);
{$endif}
FDesigner.ShowPosition;
if T is TfrMemoView then
FDesigner.ShowIEButton(T as TfrMemoView);
end;
end;
@ -2302,7 +2313,10 @@ begin
else
Cursor := crDefault;
end;
if Down then
FDesigner.HideIEButton;
//selecting a lot of objects
if Down and RFlag then
begin
@ -2666,7 +2680,8 @@ begin
if TfrDesignerForm(frDesigner).SelNum = 0 then
begin
if FDesigner.Page is TfrPageDialog then
FDesigner.ShowEditor
FDesigner.ShowDialogPgEditor(TfrPageDialog(FDesigner.Page))
//FDesigner.ShowEditor
else
FDesigner.PgB3Click(nil);
DFlag := True;
@ -3024,6 +3039,7 @@ begin
PageView.OnDragDrop:=@ScrollBox1DragDrop;
PageView.OnDragOver:=@ScrollBox1DragOver;
IEPopupMenu.Parent:=PageView;
ColorSelector := TColorSelector.Create(Self);
ColorSelector.OnColorSelected := @ColorSelected;
@ -3044,6 +3060,8 @@ begin
MenuItems := TFpList.Create;
ItemWidths := TStringlist.Create;
IEPopupMenu.Parent:=PageView;
{
if FirstInstance then
begin
@ -3219,14 +3237,14 @@ end;
procedure TfrDesignerForm.FileBeforePrintScriptExecute(Sender: TObject);
begin
EditorForm.View := nil;
//EditorForm.View := nil;
EditorForm.M2.Lines.Assign(CurReport.Script);
EditorForm.MemoPanel.Visible:=false;
EditorForm.CB1.OnClick:=nil;
EditorForm.CB1.Checked:=true;
EditorForm.CB1.OnClick:=@EditorForm.CB1Click;
EditorForm.ScriptPanel.Align:=alClient;
if EditorForm.ShowModal = mrOk then
if EditorForm.ShowEditor(nil) = mrOk then
begin
CurReport.Script.Assign(EditorForm.M2.Lines);
end;
@ -3287,6 +3305,8 @@ procedure TfrDesignerForm.FilePreviewExecute(Sender: TObject); // preview
var
TestRepStream:TMemoryStream;
Rep, SaveR:TfrReport;
FSaveGetPValue: TGetPValueEvent;
FSaveFunEvent: TFunctionEvent;
procedure DoClearFormsName;
var
@ -3316,6 +3336,9 @@ begin
// DoClearFormsName;
CurReport:=nil;
FSaveGetPValue:=frParser.OnGetValue;
FSaveFunEvent:=frParser.OnFunction;
Rep:=TfrReport.Create(SaveR.Owner);
Rep.OnBeginBand:=SaveR.OnBeginBand;
@ -3352,6 +3375,8 @@ begin
TestRepStream.Free;
CurReport:=SaveR;
CurPage := 0;
frParser.OnGetValue := FSaveGetPValue;
frParser.OnFunction := FSaveFunEvent;
// DoResoreFormsName;
end;
@ -4487,6 +4512,19 @@ begin
Result:=nil;
end;
procedure TfrDesignerForm.InplaceEditorMenuClick(Sender: TObject);
var
t: TfrView;
begin
t := TfrView(Objects[TopSelected]);
if Assigned(T) and (T is TfrMemoView) then
begin
TfrMemoView(T).Memo.Text:='[' + (Sender as TMenuItem).Caption + ']';
PageView.Invalidate;
frDesigner.Modified:=true;
end;
end;
{$endif}
procedure TfrDesignerForm.TabsEditDragOver(Sender, Source: TObject; X,
@ -4535,6 +4573,78 @@ begin
FTabMouseDown:=false;
end;
procedure TfrDesignerForm.ShowIEButton(AView:TfrMemoView);
var
lrObj: TfrObject;
Band: TfrBandView;
i, L, j: Integer;
C: TComponent;
M: TMenuItem;
begin
if not edtUseIE then exit;
Band:=nil;
for i:=0 to Objects.Count-1 do
begin
lrObj:=TfrObject(Objects[i]);
if lrObj is TfrBandView then
begin
if (AView.y >= TfrBandView(lrObj).y) and ((AView.dy + AView.y) <= (lrObj.y+lrObj.dy)) then
Band:=TfrBandView(lrObj);
end;
end;
if not Assigned(Band) then exit;
C:=frFindComponent(CurReport.Owner, Band.DataSet);
if C is TfrDBDataSet then
C:=TfrDBDataSet(C).DataSet;
if (not Assigned(C)) or (not (C is TDataSet)) then exit;
L:=TDataSet(C).Fields.Count;
if (L = 0) then
begin
TDataSet(C).FieldDefs.Update;
L:=TDataSet(C).FieldDefs.Count;
end;
if L > 0 then
begin
IEButton.Parent:=PageView;
IEButton.Visible:=true;
IEButton.Left:=AView.X + AView.dx;
IEButton.Top:=AView.y;
IEButton.Height:=Max(10, AView.dy);
IEPopupMenu.Items.Clear;
if TDataSet(C).Fields.Count>0 then
begin
for j:=0 to TDataSet(C).Fields.Count-1 do
begin
M:=TMenuItem.Create(IEPopupMenu.Owner);
M.Caption:=TDataSet(C).Name + '."'+TDataSet(C).Fields[j].FieldName+'"';
M.OnClick:=@InplaceEditorMenuClick;
IEPopupMenu.Items.Add(M);
end;
end
else
begin
for j:=0 to TDataSet(C).FieldDefs.Count-1 do
begin
M:=TMenuItem.Create(IEPopupMenu.Owner);
M.Caption:=TDataSet(C).Name + '."'+TDataSet(C).FieldDefs[j].Name+'"';
M.OnClick:=@InplaceEditorMenuClick;
IEPopupMenu.Items.Add(M);
end;
end;
end;
end;
procedure TfrDesignerForm.HideIEButton;
begin
IEButton.Visible:=false;
end;
procedure TfrDesignerForm.SetModified(AValue: Boolean);
begin
inherited SetModified(AValue);
@ -4631,10 +4741,15 @@ end;
procedure TfrDesignerForm.SelectionChanged;
var
t: TfrView;
i, j, L: Integer;
B: TfrObject;
C: TComponent;
M: TMenuItem;
begin
{$IFDEF DebugLR}
debugLnEnter('TfrDesignerForm.SelectionChanged INIT, SelNum=%d',[SelNum]);
{$ENDIF}
HideIEButton;
Busy := True;
ColorSelector.Hide;
LinePanel.Hide;
@ -4683,6 +4798,10 @@ begin
end;
end;
end;
if T is TfrMemoView then
ShowIEButton(T as TfrMemoView);
end
else if SelNum > 1 then
begin
@ -5290,8 +5409,7 @@ end;
procedure TfrDesignerForm.ShowMemoEditor;
begin
EditorForm.View := TfrView(Objects[TopSelected]);
if EditorForm.ShowEditor = mrOk then
if EditorForm.ShowEditor(TfrView(Objects[TopSelected])) = mrOk then
begin
PageView.NPDrawSelection;
PageView.NPDrawLayerObjects(EditorForm.View.GetClipRgn(rtExtended), TopSelected);
@ -5389,6 +5507,24 @@ begin
ActiveControl := nil;
end;
procedure TfrDesignerForm.ShowDialogPgEditor(APage: TfrPageDialog);
begin
EditorForm.M2.Lines.Assign(APage.Script);
EditorForm.MemoPanel.Visible:=false;
EditorForm.CB1.OnClick:=nil;
EditorForm.CB1.Checked:=true;
EditorForm.CB1.OnClick:=@EditorForm.CB1Click;
EditorForm.ScriptPanel.Align:=alClient;
if EditorForm.ShowEditor(nil) = mrOk then
begin
APage.Script.Assign(EditorForm.M2.Lines);
frDesigner.Modified:=true;
end;
EditorForm.ScriptPanel.Align:=alBottom;
EditorForm.MemoPanel.Visible:=true;
ActiveControl := nil;
end;
procedure TfrDesignerForm.ReleaseAction(ActionRec: TfrUndoRec);
var
p, p1: PfrUndoObj;
@ -5988,6 +6124,7 @@ begin
DesOptionsForm.ComboBox2.Text:=edtScriptFontName;
DesOptionsForm.SpinEdit2.Value:=edtScriptFontSize;
DesOptionsForm.CheckBox2.Checked:=edtUseIE;
if ShowModal = mrOk then
begin
@ -6015,6 +6152,7 @@ begin
edtScriptFontName:=DesOptionsForm.ComboBox2.Text;
edtScriptFontSize:=DesOptionsForm.SpinEdit2.Value;
edtUseIE:=DesOptionsForm.CheckBox2.Checked;
RedrawPage;
SaveState;
@ -6103,6 +6241,14 @@ begin
Accept:= (Control = lrFieldsList.lbFieldsList) or (Control = lrFieldsList.ValList);
end;
procedure TfrDesignerForm.IEButtonClick(Sender: TObject);
var
P: TPoint;
begin
P:=IEButton.ClientToScreen(Point(IEButton.Width, IEButton.Height));
IEPopupMenu.PopUp(P.X, P.Y);
end;
procedure TfrDesignerForm.tlsDBFieldsExecute(Sender: TObject);
begin
if Assigned(lrFieldsList) then
@ -6338,13 +6484,14 @@ begin
Ini.WriteBool('frEditorForm', rsButtons, GrayedButtons);
Ini.WriteBool('frEditorForm', rsEdit, EditAfterInsert);
Ini.WriteInteger('frEditorForm', rsSelection, Integer(ShapeMode));
Ini.WriteBool('frEditorForm', 'UseInplaceEditor', edtUseIE);
DoSaveToolbars([Panel1, Panel2, Panel3, Panel4, Panel5, Panel6]);
// Save ObjInsp Position
Ini.WriteInteger('ObjInsp', 'Left', ObjInsp.Left);
Ini.WriteInteger('ObjInsp', 'Top', ObjInsp.Top);
{ if SpeedButton1.Caption = '+' then
{ if IEButton.Caption = '+' then
Ini.WriteInteger('Position', 'Height', FLastHeight)
else
Ini.WriteInteger('Position', 'Height', Height);}
@ -6384,10 +6531,11 @@ begin
// GrayedButtons := Ini.ReadBool('frEditorForm', rsButtons, False);
EditAfterInsert := Ini.ReadBool('frEditorForm', rsEdit, True);
ShapeMode := TfrShapeMode(Ini.ReadInteger('frEditorForm', rsSelection, 1));
edtUseIE:=Ini.ReadBool('frEditorForm', 'UseInplaceEditor', edtUseIE);
ObjInsp.Left:=Ini.ReadInteger('ObjInsp', 'Left', ObjInsp.Left);
ObjInsp.Top:=Ini.ReadInteger('ObjInsp', 'Top', ObjInsp.Top);
{ if SpeedButton1.Caption = '+' then
{ if IEButton.Caption = '+' then
Ini.WriteInteger('Position', 'Height', FLastHeight)
else
Ini.WriteInteger('Position', 'Height', Height);}
@ -7733,7 +7881,7 @@ begin
try
if frFieldsForm.ShowModal = mrOk then
begin
TfrHackView(GetComponent(0)).DataField:=frFieldsForm.DBField;
TfrHackView(GetComponent(0)).DataField:='[' + frFieldsForm.DBField + ']';
frDesigner.Modified:=true;
end;
finally

215
components/lazreport/source/lr_dsopt.lfm
View File

@ -1,50 +1,50 @@
object frDesOptionsForm: TfrDesOptionsForm
Left = 399
Height = 428
Height = 453
Top = 216
Width = 422
ActiveControl = PageControl1
Caption = 'Options'
ClientHeight = 428
ClientHeight = 453
ClientWidth = 422
OnCreate = FormCreate
Position = poScreenCenter
LCLVersion = '1.3'
LCLVersion = '1.5'
object PageControl1: TPageControl
Left = 0
Height = 375
Height = 399
Top = 0
Width = 422
ActivePage = TabSheet1
ActivePage = Tab1
Align = alClient
TabIndex = 1
TabIndex = 0
TabOrder = 0
object Tab1: TTabSheet
Caption = 'Designer'
ClientHeight = 344
ClientWidth = 418
ClientHeight = 360
ClientWidth = 416
object GroupBox1: TGroupBox
AnchorSideLeft.Control = Tab1
AnchorSideTop.Control = Tab1
AnchorSideRight.Control = Label5
Left = 6
Height = 87
Height = 91
Top = 6
Width = 197
Width = 196
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Around = 6
Caption = 'Grid'
ClientHeight = 64
ClientWidth = 193
ClientHeight = 68
ClientWidth = 192
TabOrder = 0
object CB1: TCheckBox
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = GroupBox1
Left = 6
Height = 23
Height = 25
Top = 6
Width = 88
Width = 89
HelpContext = 66
BorderSpacing.Around = 6
Caption = '&Show grid'
@ -55,9 +55,9 @@ object frDesOptionsForm: TfrDesOptionsForm
AnchorSideTop.Control = CB1
AnchorSideTop.Side = asrBottom
Left = 6
Height = 23
Top = 35
Width = 101
Height = 25
Top = 37
Width = 102
HelpContext = 75
BorderSpacing.Around = 6
Caption = 'Align to &grid'
@ -70,24 +70,24 @@ object frDesOptionsForm: TfrDesOptionsForm
AnchorSideTop.Control = Tab1
AnchorSideRight.Control = Tab1
AnchorSideRight.Side = asrBottom
Left = 216
Height = 87
Left = 215
Height = 91
Top = 6
Width = 196
Width = 195
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Around = 6
Caption = 'Object moving'
ClientHeight = 64
ClientWidth = 192
ClientHeight = 68
ClientWidth = 191
TabOrder = 1
object RB4: TRadioButton
AnchorSideLeft.Control = GroupBox2
AnchorSideTop.Control = GroupBox2
Left = 6
Height = 23
Height = 25
Top = 6
Width = 63
Width = 64
HelpContext = 84
BorderSpacing.Around = 6
Caption = 'S&hape'
@ -100,9 +100,9 @@ object frDesOptionsForm: TfrDesOptionsForm
AnchorSideTop.Control = RB4
AnchorSideTop.Side = asrBottom
Left = 6
Height = 23
Top = 35
Width = 84
Height = 25
Top = 37
Width = 85
HelpContext = 94
BorderSpacing.Around = 6
Caption = '&Contents'
@ -116,24 +116,24 @@ object frDesOptionsForm: TfrDesOptionsForm
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Tab1
AnchorSideRight.Side = asrBottom
Left = 216
Height = 116
Top = 99
Width = 196
Left = 215
Height = 122
Top = 103
Width = 195
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Around = 6
Caption = 'Report units'
ClientHeight = 93
ClientWidth = 192
ClientHeight = 99
ClientWidth = 191
TabOrder = 2
object RB6: TRadioButton
AnchorSideLeft.Control = GroupBox3
AnchorSideTop.Control = GroupBox3
Left = 6
Height = 23
Height = 25
Top = 6
Width = 62
Width = 63
HelpContext = 102
BorderSpacing.Around = 6
Caption = '&Pixels'
@ -146,9 +146,9 @@ object frDesOptionsForm: TfrDesOptionsForm
AnchorSideTop.Control = RB6
AnchorSideTop.Side = asrBottom
Left = 6
Height = 23
Top = 35
Width = 47
Height = 25
Top = 37
Width = 48
HelpContext = 112
BorderSpacing.Around = 6
Caption = '&MM'
@ -159,9 +159,9 @@ object frDesOptionsForm: TfrDesOptionsForm
AnchorSideTop.Control = RB7
AnchorSideTop.Side = asrBottom
Left = 6
Height = 23
Top = 64
Width = 65
Height = 25
Top = 68
Width = 66
HelpContext = 121
BorderSpacing.Around = 6
Caption = '&Inches'
@ -174,23 +174,23 @@ object frDesOptionsForm: TfrDesOptionsForm
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Label5
Left = 12
Height = 116
Top = 99
Width = 191
Height = 122
Top = 103
Width = 190
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Around = 6
Caption = 'Grid size'
ClientHeight = 93
ClientWidth = 187
ClientHeight = 99
ClientWidth = 186
TabOrder = 3
object RB1: TRadioButton
AnchorSideLeft.Control = GroupBox4
AnchorSideTop.Control = GroupBox4
Left = 6
Height = 23
Height = 25
Top = 6
Width = 74
Width = 75
HelpContext = 131
BorderSpacing.Around = 6
Caption = '&4 pixels'
@ -203,9 +203,9 @@ object frDesOptionsForm: TfrDesOptionsForm
AnchorSideTop.Control = RB1
AnchorSideTop.Side = asrBottom
Left = 6
Height = 23
Top = 35
Width = 74
Height = 25
Top = 37
Width = 75
HelpContext = 141
BorderSpacing.Around = 6
Caption = '&8 pixels'
@ -216,9 +216,9 @@ object frDesOptionsForm: TfrDesOptionsForm
AnchorSideTop.Control = RB2
AnchorSideTop.Side = asrBottom
Left = 6
Height = 23
Top = 64
Width = 130
Height = 25
Top = 68
Width = 131
HelpContext = 151
BorderSpacing.Around = 6
Caption = '&18 pixels (5mm)'
@ -232,23 +232,23 @@ object frDesOptionsForm: TfrDesOptionsForm
AnchorSideRight.Control = Tab1
AnchorSideRight.Side = asrBottom
Left = 6
Height = 116
Top = 221
Width = 406
Height = 122
Top = 231
Width = 404
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Around = 6
Caption = 'Other'
ClientHeight = 93
ClientWidth = 402
ClientHeight = 99
ClientWidth = 400
TabOrder = 4
object CB3: TCheckBox
AnchorSideLeft.Control = GroupBox5
AnchorSideTop.Control = GroupBox5
Left = 6
Height = 23
Height = 25
Top = 6
Width = 129
Width = 130
HelpContext = 161
BorderSpacing.Around = 6
Caption = 'Colored &buttons'
@ -260,9 +260,9 @@ object frDesOptionsForm: TfrDesOptionsForm
AnchorSideTop.Control = CB3
AnchorSideTop.Side = asrBottom
Left = 6
Height = 23
Top = 35
Width = 143
Height = 25
Top = 37
Width = 144
HelpContext = 171
BorderSpacing.Around = 6
Caption = '&Editing after insert'
@ -273,19 +273,40 @@ object frDesOptionsForm: TfrDesOptionsForm
AnchorSideTop.Control = CB4
AnchorSideTop.Side = asrBottom
Left = 6
Height = 23
Top = 64
Width = 133
Height = 25
Top = 68
Width = 134
BorderSpacing.Around = 6
Caption = 'Show band &titles'
TabOrder = 2
end
object CheckBox2: TCheckBox
AnchorSideLeft.Control = Label6
AnchorSideTop.Control = GroupBox5
Left = 206
Height = 25
Top = 6
Width = 140
BorderSpacing.Around = 6
Caption = 'Use inplace editor'
TabOrder = 3
end
object Label6: TLabel
AnchorSideLeft.Control = GroupBox5
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = GroupBox5
Left = 200
Height = 1
Top = 0
Width = 1
ParentColor = False
end
end
object Label5: TLabel
AnchorSideLeft.Control = Tab1
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = Tab1
Left = 209
Left = 208
Height = 1
Top = 0
Width = 1
@ -294,31 +315,31 @@ object frDesOptionsForm: TfrDesOptionsForm
end
object TabSheet1: TTabSheet
Caption = 'Editor'
ClientHeight = 344
ClientWidth = 418
ClientHeight = 360
ClientWidth = 416
object GroupBox6: TGroupBox
AnchorSideLeft.Control = TabSheet1
AnchorSideTop.Control = TabSheet1
AnchorSideRight.Control = TabSheet1
AnchorSideRight.Side = asrBottom
Left = 6
Height = 153
Height = 157
Top = 6
Width = 406
Width = 404
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Around = 6
Caption = 'Memo editor'
ClientHeight = 130
ClientWidth = 402
ClientHeight = 134
ClientWidth = 400
TabOrder = 0
object RadioButton1: TRadioButton
AnchorSideLeft.Control = GroupBox6
AnchorSideTop.Control = GroupBox6
Left = 6
Height = 23
Height = 25
Top = 6
Width = 180
Width = 181
BorderSpacing.Around = 6
Caption = 'Use Memo font settings'
Checked = True
@ -331,9 +352,9 @@ object frDesOptionsForm: TfrDesOptionsForm
AnchorSideTop.Control = RadioButton1
AnchorSideTop.Side = asrBottom
Left = 6
Height = 23
Top = 35
Width = 171
Height = 25
Top = 37
Width = 172
BorderSpacing.Around = 6
Caption = 'Use fixed font settings'
OnClick = RadioButton1Change
@ -346,8 +367,8 @@ object frDesOptionsForm: TfrDesOptionsForm
AnchorSideRight.Control = SpinEdit1
Left = 6
Height = 33
Top = 91
Width = 282
Top = 95
Width = 280
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 6
BorderSpacing.Right = 6
@ -362,7 +383,7 @@ object frDesOptionsForm: TfrDesOptionsForm
AnchorSideTop.Side = asrBottom
Left = 6
Height = 21
Top = 64
Top = 68
Width = 69
BorderSpacing.Around = 6
Caption = 'Font name'
@ -372,9 +393,9 @@ object frDesOptionsForm: TfrDesOptionsForm
AnchorSideLeft.Control = SpinEdit1
AnchorSideTop.Control = RadioButton2
AnchorSideTop.Side = asrBottom
Left = 300
Left = 298
Height = 21
Top = 64
Top = 68
Width = 59
BorderSpacing.Around = 6
Caption = 'Font size'
@ -385,9 +406,9 @@ object frDesOptionsForm: TfrDesOptionsForm
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox6
AnchorSideRight.Side = asrBottom
Left = 294
Left = 292
Height = 31
Top = 91
Top = 95
Width = 102
Anchors = [akTop, akRight]
BorderSpacing.Top = 6
@ -404,14 +425,14 @@ object frDesOptionsForm: TfrDesOptionsForm
AnchorSideRight.Side = asrBottom
Left = 6
Height = 95
Top = 165
Width = 406
Top = 169
Width = 404
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Around = 6
Caption = 'Script editor'
ClientHeight = 72
ClientWidth = 402
ClientWidth = 400
TabOrder = 1
object Label3: TLabel
AnchorSideLeft.Control = GroupBox7
@ -432,7 +453,7 @@ object frDesOptionsForm: TfrDesOptionsForm
Left = 6
Height = 33
Top = 33
Width = 282
Width = 280
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 6
BorderSpacing.Right = 6
@ -444,7 +465,7 @@ object frDesOptionsForm: TfrDesOptionsForm
object Label4: TLabel
AnchorSideLeft.Control = SpinEdit2
AnchorSideTop.Control = GroupBox7
Left = 300
Left = 298
Height = 21
Top = 6
Width = 59
@ -457,7 +478,7 @@ object frDesOptionsForm: TfrDesOptionsForm
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox7
AnchorSideRight.Side = asrBottom
Left = 294
Left = 292
Height = 31
Top = 33
Width = 102
@ -473,9 +494,9 @@ object frDesOptionsForm: TfrDesOptionsForm
AnchorSideTop.Control = GroupBox7
AnchorSideTop.Side = asrBottom
Left = 6
Height = 23
Top = 266
Width = 156
Height = 25
Top = 270
Width = 157
BorderSpacing.Around = 6
Caption = 'Use syntax highlight'
TabOrder = 2
@ -484,8 +505,8 @@ object frDesOptionsForm: TfrDesOptionsForm
end
object ButtonPanel1: TButtonPanel
Left = 6
Height = 41
Top = 381
Height = 42
Top = 405
Width = 410
OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True

2
components/lazreport/source/lr_dsopt.pas
View File

@ -27,6 +27,7 @@ type
TfrDesOptionsForm = class(TForm)
ButtonPanel1: TButtonPanel;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
ComboBox1: TComboBox;
ComboBox2: TComboBox;
GroupBox6: TGroupBox;
@ -36,6 +37,7 @@ type
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
PageControl1: TPageControl;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;

90
components/lazreport/source/lr_edit.lfm
View File

@ -10,23 +10,22 @@ object frEditorForm: TfrEditorForm
ClientWidth = 589
Font.Color = clBlack
KeyPreview = True
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnHide = FormHide
OnKeyDown = FormKeyDown
OnResize = FormResize
OnShow = FormShow
Position = poScreenCenter
ShowHint = True
LCLVersion = '1.3'
LCLVersion = '1.7'
object Panel2: TPanel
Left = 0
Height = 53
Top = 383
Height = 52
Top = 384
Width = 589
Align = alBottom
AutoSize = True
BevelOuter = bvNone
ClientHeight = 53
ClientHeight = 52
ClientWidth = 589
FullRepaint = False
TabOrder = 0
@ -34,7 +33,7 @@ object frEditorForm: TfrEditorForm
AnchorSideTop.Control = Panel2
AnchorSideRight.Control = Button2
Left = 475
Height = 41
Height = 40
Top = 4
Width = 38
HelpContext = 40
@ -52,7 +51,7 @@ object frEditorForm: TfrEditorForm
AnchorSideRight.Control = Panel2
AnchorSideRight.Side = asrBottom
Left = 519
Height = 41
Height = 40
Top = 4
Width = 64
HelpContext = 50
@ -69,7 +68,7 @@ object frEditorForm: TfrEditorForm
AnchorSideLeft.Control = Panel2
AnchorSideTop.Control = Panel2
Left = 6
Height = 41
Height = 40
Top = 4
Width = 71
HelpContext = 60
@ -86,9 +85,9 @@ object frEditorForm: TfrEditorForm
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel2
Left = 83
Height = 41
Height = 40
Top = 4
Width = 70
Width = 71
HelpContext = 70
Anchors = [akLeft, akBottom]
AutoSize = True
@ -102,8 +101,8 @@ object frEditorForm: TfrEditorForm
AnchorSideLeft.Control = Button6
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel2
Left = 241
Height = 41
Left = 242
Height = 40
Top = 4
Width = 66
HelpContext = 110
@ -119,8 +118,8 @@ object frEditorForm: TfrEditorForm
AnchorSideLeft.Control = Button4
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel2
Left = 159
Height = 41
Left = 160
Height = 40
Top = 4
Width = 76
HelpContext = 70
@ -136,7 +135,7 @@ object frEditorForm: TfrEditorForm
object ScriptPanel: TPanel
Left = 0
Height = 152
Top = 231
Top = 232
Width = 589
Align = alBottom
BevelOuter = bvNone
@ -146,7 +145,7 @@ object frEditorForm: TfrEditorForm
TabOrder = 1
object Label2: TLabel
Left = 4
Height = 21
Height = 20
Top = 0
Width = 38
Caption = 'S&cript'
@ -169,7 +168,7 @@ object frEditorForm: TfrEditorForm
OnEnter = M1Enter
BookMarkOptions.Xoffset = 2
Gutter.Color = 13605511
Gutter.Width = 57
Gutter.Width = 55
Gutter.MouseActions = <
item
ClickCount = ccAny
@ -591,7 +590,6 @@ object frEditorForm: TfrEditorForm
'End'
)
VisibleSpecialChars = [vscSpace, vscTabAtLast]
SelectedColor.FrameEdges = sfeAround
SelectedColor.BackPriority = 50
SelectedColor.ForePriority = 50
SelectedColor.FramePriority = 50
@ -599,23 +597,17 @@ object frEditorForm: TfrEditorForm
SelectedColor.ItalicPriority = 50
SelectedColor.UnderlinePriority = 50
SelectedColor.StrikeOutPriority = 50
IncrementColor.FrameEdges = sfeAround
HighlightAllColor.FrameEdges = sfeAround
BracketHighlightStyle = sbhsBoth
BracketMatchColor.Background = clNone
BracketMatchColor.Foreground = clNone
BracketMatchColor.FrameEdges = sfeAround
BracketMatchColor.Style = [fsBold]
FoldedCodeColor.Background = clNone
FoldedCodeColor.Foreground = clGray
FoldedCodeColor.FrameColor = clGray
FoldedCodeColor.FrameEdges = sfeAround
MouseLinkColor.Background = clNone
MouseLinkColor.Foreground = clBlue
MouseLinkColor.FrameEdges = sfeAround
LineHighlightColor.Background = clNone
LineHighlightColor.Foreground = clNone
LineHighlightColor.FrameEdges = sfeAround
inline TSynGutterPartList
object TSynGutterMarks
AutoSize = False
@ -623,11 +615,10 @@ object frEditorForm: TfrEditorForm
MouseActions = <>
end
object TSynGutterLineNumber
Width = 19
Width = 17
MouseActions = <>
MarkupInfo.Background = clNone
MarkupInfo.Foreground = clNone
MarkupInfo.FrameEdges = sfeAround
DigitCount = 2
ShowOnlyLineNumbersMultiplesOf = 1
ZeroStart = False
@ -644,7 +635,6 @@ object frEditorForm: TfrEditorForm
MouseActions = <>
MarkupInfo.Background = clWhite
MarkupInfo.Foreground = clGray
MarkupInfo.FrameEdges = sfeAround
end
object TSynGutterCodeFolding
MouseActions = <
@ -675,7 +665,6 @@ object frEditorForm: TfrEditorForm
end>
MarkupInfo.Background = clWhite
MarkupInfo.Foreground = clGray
MarkupInfo.FrameEdges = sfeAround
MouseActionsExpanded = <
item
ClickCount = ccAny
@ -704,7 +693,7 @@ object frEditorForm: TfrEditorForm
object MemoPanel: TPanel
Left = 0
Height = 185
Top = 37
Top = 38
Width = 589
Align = alClient
BevelOuter = bvNone
@ -721,8 +710,8 @@ object frEditorForm: TfrEditorForm
AnchorSideBottom.Control = MemoPanel
AnchorSideBottom.Side = asrBottom
Left = 0
Height = 152
Top = 33
Height = 153
Top = 32
Width = 589
Anchors = [akTop, akLeft, akRight, akBottom]
OnEnter = M1Enter
@ -735,7 +724,7 @@ object frEditorForm: TfrEditorForm
AnchorSideLeft.Control = MemoPanel
AnchorSideTop.Control = MemoPanel
Left = 6
Height = 21
Height = 20
Top = 6
Width = 40
BorderSpacing.Around = 6
@ -747,7 +736,7 @@ object frEditorForm: TfrEditorForm
Cursor = crVSplit
Left = 0
Height = 9
Top = 222
Top = 223
Width = 589
Align = alBottom
Anchors = [akLeft, akBottom]
@ -760,23 +749,23 @@ object frEditorForm: TfrEditorForm
AnchorSideTop.Control = Owner
AnchorSideRight.Control = Owner
Left = 0
Height = 37
Height = 38
Top = 0
Width = 589
Align = alTop
AutoSize = True
BevelOuter = bvLowered
ClientHeight = 37
ClientHeight = 38
ClientWidth = 589
FullRepaint = False
TabOrder = 4
object CB1: TCheckBox
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel3
Left = 4
Height = 23
Left = 7
Height = 24
Top = 7
Width = 61
Width = 62
HelpContext = 80
BorderSpacing.Around = 6
Caption = '&Script'
@ -787,10 +776,10 @@ object frEditorForm: TfrEditorForm
AnchorSideLeft.Control = CB1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel3
Left = 71
Height = 23
Left = 75
Height = 24
Top = 7
Width = 74
Width = 75
HelpContext = 90
BorderSpacing.Around = 6
Caption = '&Big font'
@ -801,10 +790,10 @@ object frEditorForm: TfrEditorForm
AnchorSideLeft.Control = CB2
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel3
Left = 151
Height = 23
Left = 156
Height = 24
Top = 7
Width = 94
Width = 95
HelpContext = 100
BorderSpacing.Around = 6
Caption = '&Word wrap'
@ -816,20 +805,9 @@ object frEditorForm: TfrEditorForm
DefaultFilter = '(TSynHighlighterAttributes)'
Enabled = False
AsmAttri.Foreground = 5812813
AsmAttri.FrameEdges = sfeAround
CommentAttri.Foreground = 13461314
CommentAttri.FrameEdges = sfeAround
IDEDirectiveAttri.FrameEdges = sfeAround
IdentifierAttri.FrameEdges = sfeAround
KeyAttri.FrameEdges = sfeAround
NumberAttri.Foreground = clRed
NumberAttri.FrameEdges = sfeAround
SpaceAttri.FrameEdges = sfeAround
StringAttri.Foreground = 15226932
StringAttri.FrameEdges = sfeAround
SymbolAttri.FrameEdges = sfeAround
CaseLabelAttri.FrameEdges = sfeAround
DirectiveAttri.FrameEdges = sfeAround
CompilerMode = pcmDelphi
NestedComments = False
left = 228

111
components/lazreport/source/lr_edit.pas
View File

@ -49,6 +49,7 @@ type
SynPasSyn1: TSynPasSyn;
procedure Button3Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
procedure M1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormKeyDown(Sender: TObject; var Key: Word;
@ -57,33 +58,32 @@ type
procedure M1Enter(Sender: TObject);
procedure CB1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormHide(Sender: TObject);
procedure CB2Click(Sender: TObject);
procedure CB3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure FormResize(Sender: TObject);
private
{ Private declarations }
FActiveMemo: TWinControl;
//** procedure WMGetMinMaxInfo(var Msg: TLMGetMinMaxInfo); message LM_GETMINMAXINFO;
procedure InsertText(const S:string);
function CheckScript:boolean;
public
{ Public declarations }
function ShowEditor: TModalResult; override;
function ShowEditor(AView: TfrView): TModalResult; virtual;
end;
implementation
{$R *.lfm}
uses LR_Desgn, LR_Fmted, LR_Var, LR_Flds, LR_Const, lr_expres;
uses LR_Desgn, LR_Fmted, LR_Var, LR_Flds, LR_Const, lr_expres, strutils;
function TfrEditorForm.ShowEditor: TModalResult;
function TfrEditorForm.ShowEditor(AView: TfrView): TModalResult;
begin
Result := mrCancel;
if Assigned(View) then
Result := inherited ShowEditor;
Button5.Enabled:=Assigned(AView);
CB1.Enabled:=Assigned(AView);
CB2.Enabled:=Assigned(AView);
CB3.Enabled:=Assigned(AView);
Result := inherited ShowEditor(AView);
end;
procedure TfrEditorForm.FormShow(Sender: TObject);
@ -123,32 +123,6 @@ begin
{$ENDIF}
end;
procedure TfrEditorForm.FormHide(Sender: TObject);
begin
if ModalResult = mrOk then
begin
frDesigner.BeforeChange;
M1.WordWrap := False;
if Assigned(View) then
begin
View.Memo.Text := M1.Text;
View.Script.Text := M2.Text;
end;
end;
end;
//**
{
procedure TfrEditorForm.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
begin
with Msg.MinMaxInfo^ do
begin
ptMinTrackSize.x := Button2.Left + Button2.Width + 4 + 8;
ptMinTrackSize.y := 200;
end;
end;
}
procedure TfrEditorForm.Button3Click(Sender: TObject);
begin
frVarForm := TfrVarForm.Create(Application);
@ -174,6 +148,26 @@ begin
end;
end;
procedure TfrEditorForm.FormCloseQuery(Sender: TObject; var CanClose: boolean);
begin
if ModalResult = mrOk then
begin
CanClose:=CheckScript;
if CanClose then
begin
frDesigner.BeforeChange;
M1.WordWrap := False;
if Assigned(View) then
begin
View.Memo.Text := M1.Text;
View.Script.Text := M2.Text;
end;
end
else
ModalResult:=mrNone;
end;
end;
procedure TfrEditorForm.M1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
@ -262,6 +256,7 @@ procedure TfrEditorForm.Button5Click(Sender: TObject);
var
t: TfrMemoView;
begin
if not Assigned(View) then Exit;
t := TfrMemoView(View);
frFmtForm := TfrFmtForm.Create(nil);
with frFmtForm do
@ -278,15 +273,6 @@ begin
frFmtForm.Free;
end;
procedure TfrEditorForm.FormResize(Sender: TObject);
begin
//**
{
ptMinTrackSize.x := Button2.Left + Button2.Width + 4 + 8;
ptMinTrackSize.y := 200;
}
end;
procedure TfrEditorForm.InsertText(const S: string);
begin
if S<>'' then
@ -299,5 +285,40 @@ begin
end;
end;
function TfrEditorForm.CheckScript: boolean;
var
sl1, sl2: TStringList;
procedure ErrorPosition(S:string);
var
X, Y: LongInt;
begin
if Pos('/', S) = 0 then exit;
Y := StrToInt(Copy2SymbDel(S, '/'));
X := StrToInt(Copy2SymbDel(S,':'));
M2.CaretX:=X;
M2.CaretY:=Y;
M2.SetFocus;
end;
begin
Result:=true;
sl1 := TStringList.Create;
sl2 := TStringList.Create;
try
frInterpretator.PrepareScript(M2.Lines, sl1, sl2);
if sl2.Count > 0 then
begin
ErrorPosition(Copy(sl2.Text, Length(sErrLine)+1));
ShowMessage(sl2.Text);
Result:=false;
end;
finally
sl1.Free;
sl2.Free;
end;
end;
end.

34
components/lazreport/source/lr_intrp.pas
View File

@ -41,7 +41,8 @@ type
procedure SetValue(const {%H-}Name: String; {%H-}Value: Variant); virtual;
procedure DoFunction(const {%H-}name: String; {%H-}p1, {%H-}p2, {%H-}p3: Variant;
var {%H-}val: Variant); virtual;
procedure PrepareScript(MemoFrom, MemoTo, MemoErr: TStringList); virtual;
//procedure PrepareScript(MemoFrom, MemoTo, MemoErr: TStringList); virtual;
procedure PrepareScript(MemoFrom, MemoTo, MemoErr: TStrings); virtual;
procedure DoScript(Memo: TStringList); virtual;
end;
@ -70,7 +71,7 @@ type
implementation
uses Variants;
uses Variants, LR_Const;
type
LRec = record
@ -285,7 +286,8 @@ begin
inherited Destroy;
end;
procedure TfrInterpretator.PrepareScript(MemoFrom, MemoTo, MemoErr: TStringList);
//procedure TfrInterpretator.PrepareScript(MemoFrom, MemoTo, MemoErr: TStringList);
procedure TfrInterpretator.PrepareScript(MemoFrom, MemoTo, MemoErr: TStrings);
var
i, j, lastp: Integer;
s, bs: String;
@ -355,7 +357,7 @@ procedure DoFuncId; forward;
if c = 0 then break;
Inc(i);
end;
MemoErr.Add('Line ' + IntToStr(i + 1) + '/' + IntToStr(j - 1) + ': ' + s);
MemoErr.Add(Format('%s %d/%d: %s', [sErrLine, i+1, j-1, s]));
end;
procedure ProcessBrackets(var i: Integer);
@ -403,7 +405,7 @@ procedure DoFuncId; forward;
if Pos('END', bs) = 1 then
cur := cur - Length(bs) + 3
else
AddError('Expected ";" or "end"');
AddError(sErrExpectedEnd);
end;
procedure DoIf;
@ -436,7 +438,7 @@ procedure DoFuncId; forward;
cur := nsm;
end;
end
else AddError('Expected "then"');
else AddError(sErrExpectedThen);
end;
procedure DoRepeat;
@ -461,7 +463,7 @@ procedure DoFuncId; forward;
DoExpression;
MemoTo.Add(ttIf + Chr(nl) + Chr(nl div 256) + CopyArr(nsm, cur - nsm));
end
else AddError('Expected ";" or "until"');
else AddError(sErrExpectedUntil);
end;
procedure DoWhile;
@ -484,7 +486,7 @@ procedure DoFuncId; forward;
MemoTo[nl] := bs;
end
else
AddError('Expected "do"');
AddError(sErrExpectedDO);
end;
procedure DoGoto;
@ -495,7 +497,7 @@ procedure DoFuncId; forward;
nsm := cur;
lastp := cur;
DoDigit;
if Error then AddError('Label in goto must be a number');
if Error then AddError(sErrLabelGoto);
MemoTo.Add(ttGoto + Trim(CopyArr(nsm, cur - nsm)));
end;
@ -532,7 +534,7 @@ procedure DoFuncId; forward;
MemoTo.Add(s);
end
else
AddError('Expected ":="');
AddError(sErrExpectedAssign);
end;
{-------------------------------------}
procedure DoExpression;
@ -614,7 +616,7 @@ procedure DoFuncId; forward;
SkipSpace;
lastp := cur;
if buf^[cur] = ')' then Inc(cur)
else AddError('Expected ")"');
else AddError(sErrExpectedClosingBracket1);
end
else
if (bs<>'') and (bs[1] = '[') then
@ -624,7 +626,7 @@ procedure DoFuncId; forward;
SkipSpace;
lastp := cur;
if buf^[cur] = ']' then Inc(cur)
else AddError('Expected "]"');
else AddError(sErrExpectedClosingBracket2);
end
else
if (bs<>'') and ((bs[1] = '+') or (bs[1] = '-')) then
@ -738,7 +740,7 @@ procedure DoFuncId; forward;
goto 1;
end
else if buf^[cur] = ')' then Inc(cur)
else AddError('Expected "," or ")"');
else AddError(sErrExpectedComma);
end;
end;
@ -778,7 +780,7 @@ procedure DoFuncId; forward;
MemoTo[nl] := bs;
end
else
AddError('Need "do" here');
AddError(sErrNeedDo);
end
else
if S = 'DOWNTO' then
@ -802,10 +804,10 @@ procedure DoFuncId; forward;
MemoTo[nl] := bs;
end
else
AddError('Need "do" here');
AddError(sErrNeedDo);
end
else
AddError('Need "to" here');
AddError(sErrNeedTo);
end;

41
components/lazreport/source/lr_pars.pas
View File

@ -39,6 +39,7 @@ type
end;
function GetBrackedVariable(s: String; var i: integer; out j: Integer): String;
function ExtractString(const S:string):string;
implementation
@ -55,6 +56,40 @@ const
ttUnMinus = #9; ttUnPlus = #10; ttStr = #11;
ttNot = #12; ttMod = #13; ttRound = #14;
function ExtractString(const S:string):string;
var
i: Integer;
FInStr:boolean;
begin
Result:='';
FInStr:=false;
// if S=#$27#$27 then exit;
i:=1;
while i<=Length(S) do
begin
if (S[i]='''') then
begin
if FInStr then
begin
if I < Length(S) then
begin
if S[i+1] = '''' then
begin
Result:=Result + '''';
Inc(i);
end
else
FInStr:=false;
end;
end
else
FInStr:=true;
end
else
Result:=Result + S[i];
Inc(i);
end;
end;
function GetBrackedVariable(s: String; var i: integer; out j: Integer): String;
var
@ -201,10 +236,10 @@ begin
begin
if s[i] = '''' then
begin
s1 := GetString(s, i);
s1 := Copy(s1, 2, Length(s1) - 2);
s1 := ExtractString(GetString(s, i));
{ s1 := Copy(s1, 2, Length(s1) - 2);
while Pos('''' + '''', s1) <> 0 do
Delete(s1, Pos('''' + '''', s1), 1);
Delete(s1, Pos('''' + '''', s1), 1);}
nm[st] := s1;
k := i;
end

10
components/lazreport/source/lr_propedit.pas
View File

@ -12,18 +12,20 @@ type
{ TPropEditor }
TPropEditor = class(TForm)
protected
FView: TfrView;
public
View: TfrView;
function ShowEditor: TModalResult; virtual;
function ShowEditor(AView: TfrView): TModalResult; virtual;
property View: TfrView read FView;
end;
implementation
{ TPropEditor }
function TPropEditor.ShowEditor: TModalResult;
function TPropEditor.ShowEditor(AView: TfrView): TModalResult;
begin
FView:=AView;
Result := ShowModal;
end;

72
components/lazreport/source/lr_view.lfm
View File

@ -22,7 +22,7 @@ object frPreviewForm: TfrPreviewForm
OnMouseDown = FormMouseDown
OnResize = FormResize
ShowHint = True
LCLVersion = '1.3'
LCLVersion = '1.5'
WindowState = wsMaximized
object PanTop: TPanel
Left = 0
@ -39,18 +39,18 @@ object frPreviewForm: TfrPreviewForm
Left = 0
Height = 30
Top = 0
Width = 683
Width = 687
Align = alTop
BevelInner = bvSpace
BevelOuter = bvNone
ClientHeight = 30
ClientWidth = 683
ClientWidth = 687
FullRepaint = False
TabOrder = 0
object ZoomBtn: TBitBtn
Tag = 200
Left = 182
Height = 24
Height = 28
Top = 1
Width = 76
Align = alLeft
@ -101,7 +101,7 @@ object frPreviewForm: TfrPreviewForm
object LoadBtn: TBitBtn
Tag = 201
Left = 1
Height = 24
Height = 28
Top = 1
Width = 32
Align = alLeft
@ -150,7 +150,7 @@ object frPreviewForm: TfrPreviewForm
object SaveBtn: TBitBtn
Tag = 202
Left = 33
Height = 24
Height = 28
Top = 1
Width = 32
Align = alLeft
@ -199,7 +199,7 @@ object frPreviewForm: TfrPreviewForm
object PrintBtn: TBitBtn
Tag = 203
Left = 101
Height = 24
Height = 28
Top = 1
Width = 28
Align = alLeft
@ -246,8 +246,8 @@ object frPreviewForm: TfrPreviewForm
end
object ExitBtn: TBitBtn
Tag = 205
Left = 650
Height = 24
Left = 658
Height = 28
Top = 1
Width = 28
Align = alRight
@ -294,7 +294,7 @@ object frPreviewForm: TfrPreviewForm
end
object frTBSeparator1: TPanel
Left = 76
Height = 24
Height = 28
Top = 1
Width = 25
Align = alLeft
@ -304,7 +304,7 @@ object frPreviewForm: TfrPreviewForm
end
object frTBSeparator2: TPanel
Left = 129
Height = 24
Height = 28
Top = 1
Width = 25
Align = alLeft
@ -314,7 +314,7 @@ object frPreviewForm: TfrPreviewForm
end
object frTBSeparator3: TPanel
Left = 286
Height = 24
Height = 28
Top = 1
Width = 25
Align = alLeft
@ -324,7 +324,7 @@ object frPreviewForm: TfrPreviewForm
end
object PgUp: TSpeedButton
Left = 331
Height = 24
Height = 28
Top = 1
Width = 20
Align = alLeft
@ -370,7 +370,7 @@ object frPreviewForm: TfrPreviewForm
end
object PgDown: TSpeedButton
Left = 454
Height = 24
Height = 28
Top = 1
Width = 20
Align = alLeft
@ -416,7 +416,7 @@ object frPreviewForm: TfrPreviewForm
end
object LbPanel: TPanel
Left = 351
Height = 24
Height = 28
Top = 1
Width = 103
Align = alLeft
@ -430,7 +430,7 @@ object frPreviewForm: TfrPreviewForm
end
object BtPgFirst: TSpeedButton
Left = 311
Height = 24
Height = 28
Top = 1
Width = 20
Align = alLeft
@ -476,7 +476,7 @@ object frPreviewForm: TfrPreviewForm
end
object BtPgLast: TSpeedButton
Left = 474
Height = 24
Height = 28
Top = 1
Width = 20
Align = alLeft
@ -522,7 +522,7 @@ object frPreviewForm: TfrPreviewForm
end
object BtZoomOut: TBitBtn
Left = 154
Height = 24
Height = 28
Top = 1
Width = 28
Align = alLeft
@ -569,7 +569,7 @@ object frPreviewForm: TfrPreviewForm
end
object BtZoomIn: TBitBtn
Left = 258
Height = 24
Height = 28
Top = 1
Width = 28
Align = alLeft
@ -616,7 +616,7 @@ object frPreviewForm: TfrPreviewForm
end
object frTBSeparator4: TPanel
Left = 494
Height = 24
Height = 28
Top = 1
Width = 25
Align = alLeft
@ -626,7 +626,7 @@ object frPreviewForm: TfrPreviewForm
end
object FindBtn: TBitBtn
Left = 519
Height = 24
Height = 28
Top = 1
Width = 28
Align = alLeft
@ -672,7 +672,7 @@ object frPreviewForm: TfrPreviewForm
end
object SpeedButton1: TSpeedButton
Left = 65
Height = 24
Height = 28
Top = 1
Width = 11
Align = alLeft
@ -703,9 +703,9 @@ object frPreviewForm: TfrPreviewForm
TabOrder = 1
object ScrollBox1: TScrollBox
Left = 1
Height = 465
Height = 469
Top = 1
Width = 662
Width = 666
HorzScrollBar.Page = 1
VertScrollBar.Page = 1
Align = alClient
@ -715,19 +715,19 @@ object frPreviewForm: TfrPreviewForm
object BPanel: TPanel
Left = 1
Height = 19
Top = 466
Width = 681
Top = 470
Width = 685
Align = alBottom
BevelOuter = bvNone
ClientHeight = 19
ClientWidth = 681
ClientWidth = 685
FullRepaint = False
TabOrder = 1
object HScrollBar: TScrollBar
Left = 2
Height = 13
Top = 2
Width = 659
Height = 15
Top = 4
Width = 667
Align = alBottom
BorderSpacing.Left = 2
BorderSpacing.Right = 16
@ -741,21 +741,21 @@ object frPreviewForm: TfrPreviewForm
end
end
object RPanel: TPanel
Left = 663
Height = 465
Left = 667
Height = 469
Top = 1
Width = 19
Align = alRight
BevelOuter = bvNone
ClientHeight = 465
ClientHeight = 469
ClientWidth = 19
FullRepaint = False
TabOrder = 2
object VScrollBar: TScrollBar
Left = 2
Height = 461
Left = 4
Height = 469
Top = 0
Width = 13
Width = 15
Align = alRight
Kind = sbVertical
LargeChange = 200

88
components/lazreport/source/lr_view.pas
View File

@ -10,15 +10,6 @@
unit LR_View;
(*
Notes
Not implemented because TMetaFile not exists :
procedure TfrPreviewForm.FindText;
procedure TfrPreviewForm.FindInEMF(emf: TMetafile);
*)
interface
{$I LR_Vers.inc}
@ -1486,85 +1477,6 @@ begin
end;
end;
//**
(*
function EnumEMFRecordsProc(DC: HDC; HandleTable: PHandleTable;
EMFRecord: PEnhMetaRecord; nObj: Integer; OptData: Pointer): Bool; stdcall;
var
Typ: Byte;
s: String;
t: TEMRExtTextOut;
begin
Result := True;
Typ := EMFRecord^.iType;
if Typ in [83, 84] then
begin
t := PEMRExtTextOut(EMFRecord)^;
s := WideCharLenToString(PWideChar(PChar(EMFRecord) + t.EMRText.offString),
t.EMRText.nChars);
if not CurPreview.CaseSensitive then s := AnsiUpperCase(s);
CurPreview.StrFound := Pos(CurPreview.FindStr, s) <> 0;
if CurPreview.StrFound and (RecordNum >= CurPreview.LastFoundObject) then
begin
CurPreview.StrBounds := t.rclBounds;
Result := False;
end;
end;
Inc(RecordNum);
end;
*)
{
procedure TfrPreviewForm.FindInEMF(emf: TMetafile);
begin
CurPreview := Self;
RecordNum := 0;
EnumEnhMetafile(0, emf.Handle, @EnumEMFRecordsProc, nil, Rect(0, 0, 0, 0));
end;
procedure TfrPreviewForm.FindText;
var
EMF: TMetafile;
EMFCanvas: TMetafileCanvas;
PageInfo: PfrPageInfo;
begin
PaintAllowed := False;
StrFound := False;
while LastFoundPage < TfrEMFPages(EMFPages).Count do
begin
PageInfo := TfrEMFPages(EMFPages)[LastFoundPage];
EMF := TMetafile.Create;
EMF.Width := PageInfo.PrnInfo.PgW;
EMF.Height := PageInfo.PrnInfo.PgH;
EMFCanvas := TMetafileCanvas.Create(EMF, 0);
PageInfo.Visible := True;
TfrEMFPages(EMFPages).Draw(LastFoundPage, EMFCanvas,
Rect(0, 0, PageInfo.PrnInfo.PgW, PageInfo.PrnInfo.PgH));
EMFCanvas.Free;
FindInEMF(EMF);
EMF.Free;
if StrFound then
begin
CurPage := LastFoundPage + 1;
ShowPageNum;
VScrollBar.Position := PageInfo.r.Top + Round(StrBounds.Top * per) - 10;
HScrollBar.Position := PageInfo.r.Left + Round(StrBounds.Left * per) - 10;
LastFoundObject := RecordNum;
break;
end
else
begin
PageInfo.Visible := False;
TfrEMFPages(EMFPages).Draw(LastFoundPage, EMFCanvas,
Rect(0, 0, PageInfo.PrnInfo.PgW, PageInfo.PrnInfo.PgH));
end;
LastFoundObject := 0;
Inc(LastFoundPage);
end;
PaintAllowed := True;
end;
}
procedure TfrPreviewForm.FindText;
begin
PaintAllowed := False;