paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-08 09:20:49 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazReport: Formatting and cleanup

Browse Source 
git-svn-id: trunk@43776 -
This commit is contained in:
jesus 2014-01-20 03:38:35 +00:00
parent d877b82218
commit 8656af3464
1 changed files with 19 additions and 290 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -10254,31 +10254,31 @@ var
end; end;
{$ENDIF} {$ENDIF}
procedure InternalPrintEMFPage; procedure InternalPrintEMFPage;
var var
i, j:integer; i, j:integer;
begin
for i := 0 to EMFPages.Count - 1 do
begin begin
if (pgList.Count = 0) or (pgList.IndexOf(IntToStr(i + 1)) <> -1) then for i := 0 to EMFPages.Count - 1 do
begin begin
for j := 0 to Copies - 1 do if (pgList.Count = 0) or (pgList.IndexOf(IntToStr(i + 1)) <> -1) then
begin begin
{$IFDEF DebugLR} for j := 0 to Copies - 1 do
DebugPrnInfo('=== Before PrintPage('+IntToStr(i)+')');
{$ENDIF}
PrintPage(i);
if Terminated then
begin begin
Printer.Abort; {$IFDEF DebugLR}
pgList.Free; DebugPrnInfo('=== Before PrintPage('+IntToStr(i)+')');
Exit; {$ENDIF}
PrintPage(i);
if Terminated then
begin
Printer.Abort;
pgList.Free;
Exit;
end;
end; end;
end; end;
end; end;
end; end;
end;
begin begin
{$IFDEF DebugLR} {$IFDEF DebugLR}
@ -10319,28 +10319,6 @@ begin
end end
else else
InternalPrintEMFPage; InternalPrintEMFPage;
(* begin
for i := 0 to EMFPages.Count - 1 do
begin
if (pgList.Count = 0) or (pgList.IndexOf(IntToStr(i + 1)) <> -1) then
begin
for j := 0 to Copies - 1 do
begin
{$IFDEF DebugLR}
DebugPrnInfo('=== Before PrintPage('+IntToStr(i)+')');
{$ENDIF}
PrintPage(i);
if Terminated then
begin
Printer.Abort;
pgList.Free;
Exit;
end;
end;
end;
end;
end; *)
Printer.EndDoc; Printer.EndDoc;
pgList.Free; pgList.Free;
@ -10661,91 +10639,6 @@ var
i:integer; i:integer;
begin begin
(*
{ !!!! Надо переписать и дописать!!!!
if Name = 'CURY' then
begin
Value := CurPage.CurY;
Exit;
end;
if Name = 'FREESPACE' then
begin
Value := CurPage.CurBottomY - CurPage.CurY;
Exit;
end;
if Name = 'FINALPASS' then
begin
Value := MasterReport.FinalPass;
Exit;
end;
if Name = 'PAGEHEIGHT' then
begin
Value := CurPage.CurBottomY;
Exit;
end;
if Name = 'PAGEWIDTH' then
begin
Value := CurPage.RightMargin;
Exit;
end;
}
N:=PosLast('.', AName);
t:=nil;
if N>0 then
begin
Prop:=Copy(AName, N+1, Length(AName));
Delete(AName, N, Length(AName));
//Проверим - существует ли такой объект?
t := FindObjectByName(AName);
if Assigned(T) then
begin
PropInfo:=GetPropInfo(t,Prop);
if Assigned(PropInfo) then
begin
{$IFDEF DebugLR}
DebugLn('TInterpretator.GetValue(',Name,') Prop=',Prop,
' Kind=',InttoStr(Ord(PropInfo^.PropType^.Kind)));
{$ENDIF}
Case PropInfo^.PropType^.Kind of
tkChar,tkAString,tkWString,
tkSString,tkLString : begin
St:=GetStrProp(t,Prop);
{$IFDEF DebugLR}
DebugLn('St=',St);
{$ENDIF}
AValue:=St;
end;
tkBool,tkInt64,tkQWord,
tkInteger : AValue:=GetOrdProp(t,PropInfo);
tkSet : begin
St:=GetSetProp(t,Prop);
{$IFDEF DebugLR}
DebugLn('St=',St);
{$ENDIF}
AValue:=St;
end;
tkFloat : AValue:=GetFloatProp(t,Prop);
tkEnumeration : begin
St:=GetEnumProp(t,Prop);
{$IFDEF DebugLR}
DebugLn('St=',St);
{$ENDIF}
AValue:=St;
end;
end;
{ if (t <> nil) and (t.PropRec[Prop] <> nil) then
Value := t.Prop[Prop]
else if frConsts.IndexOf(Name) <> -1 then
Value := frConsts[Name];}
end;
end;
end;
*)
t := CurView; t := CurView;
Prop := AName; Prop := AName;
@ -10771,20 +10664,7 @@ begin
//Проверим - существует ли такой объект? //Проверим - существует ли такой объект?
t := FindObjectByName(AName); t := FindObjectByName(AName);
end; end;
(*
if Pos('.', AName) <> 0 then
begin
//Find Object
t := CurPage.FindRTObject(Copy(AName, 1, Pos('.', AName) - 1));
if not Assigned(t) then
t:=CurReport.FindObject(Copy(AName, 1, Pos('.', AName) - 1));
//Property of object
Prop:=Copy(AName, Pos('.', AName)+1, Length(AName));
end;
*)
// if not Assigned(t) then
// frParser.OnGetValue(Name, Value)
// else
if Assigned(t) then if Assigned(t) then
begin begin
//Retreive property informations //Retreive property informations
@ -10864,20 +10744,7 @@ begin
end; end;
{$IFDEF DebugLR} {$IFDEF DebugLR}
DebugLn('TInterpretator.GetValue(',Name,') No Propinfo for Prop=',Prop); DebugLn('TInterpretator.GetValue(',Name,') No Propinfo for Prop=',Prop,' Value=',dbgs(AValue));
{$ENDIF}
(*
if VarIsNull(AValue) or VarIsEmpty(AValue) then
begin
{$IFDEF DebugLR}
DebugLn('TInterpretator.GetValue(',Name,')=NULL >> Value="',Name,'"');
{$ENDIF}
AValue:=Name;
end
*)
{$IFDEF DebugLR}
else
DebugLn('TInterpretator.GetValue(',Name,')=',VarToStr(Value));
{$ENDIF} {$ENDIF}
end; end;
end; end;
@ -11573,149 +11440,11 @@ begin
{$ENDIF} {$ENDIF}
end; end;
{$WARNINGS OFF}
procedure TInterpretator.GetValue(const Name: String; var Value: Variant); procedure TInterpretator.GetValue(const Name: String; var Value: Variant);
var
t : TfrObject;
Prop : String;
PropInfo : PPropInfo;
St : String;
i : Integer;
begin begin
if Assigned(frParser.OnGetValue) then if Assigned(frParser.OnGetValue) then
frParser.OnGetValue(Name, Value); frParser.OnGetValue(Name, Value);
(*
{$IFDEF DebugLR}
DebugLn('TInterpretator.GetValue(',Name,') INIT');
{$ENDIF}
//Value := 0;
t := CurView;
Prop := Name;
if frVariables.IndexOf(Name) <> -1 then
begin
Value := frVariables[Name];
Exit;
end;
if Name = 'FREESPACE' then
begin
Value:=IntToStr(CurPage.CurBottomY-CurPage.CurY);
Exit;
end;
if Pos('.', Name) <> 0 then
begin
//Find Object
t := CurPage.FindRTObject(Copy(Name, 1, Pos('.', Name) - 1));
if not Assigned(t) then
t:=CurReport.FindObject(Copy(Name, 1, Pos('.', Name) - 1));
//Property of object
Prop:=Copy(Name, Pos('.',Name)+1,255);
end;
if not Assigned(t) then
frParser.OnGetValue(Name, Value)
else
begin
//Retreive property informations
PropInfo:=GetPropInfo(t,Prop);
if Assigned(PropInfo) then
begin
{$IFDEF DebugLR}
DebugLn('TInterpretator.GetValue(',Name,') Prop=',Prop,
' Kind=',InttoStr(Ord(PropInfo^.PropType^.Kind)));
{$ENDIF}
Case PropInfo^.PropType^.Kind of
tkChar,tkAString,tkWString,
tkSString,tkLString : begin
St:=GetStrProp(t,Prop);
{$IFDEF DebugLR}
DebugLn('St=',St);
{$ENDIF}
Value:=St;
end;
tkBool,tkInt64,tkQWord,
tkInteger : Value:=GetOrdProp(t,PropInfo);
tkSet : begin
St:=GetSetProp(t,Prop);
{$IFDEF DebugLR}
DebugLn('St=',St);
{$ENDIF}
Value:=St;
end;
tkFloat : Value:=GetFloatProp(t,Prop);
tkEnumeration : begin
St:=GetEnumProp(t,Prop);
{$IFDEF DebugLR}
DebugLn('St=',St);
{$ENDIF}
Value:=St;
end;
end;
end else
begin
// it's not a property of t, try with known color names first
for i := 0 to 16 do
if AnsiCompareText(ColNames[i], Prop) = 0 then
begin
// color constant found.
if i <> 16 then
Value := frColors[i] else
Value := clNone;
exit;
end;
// it's not a color name, try with customized properties
// not included directly in t
if not (t is TfrBandView) then
begin
for i:=0 to propcount-1 do
if CompareText(PropNames[i], Prop)=0 then
begin
{$IFDEF DebugLR}
DbgOut('A CustomField was found ', Prop);
if i=0 then
DbgOut(', t.memo.text=',DbgStr(t.Memo.Text));
DebugLn;
{$ENDIF}
case i of
0: Value := t.GetText; //t.Memo.Text;
1: Value := TfrMemoView(t).Font.Name;
2: Value := TfrMemoView(t).Font.Size;
3: Value := frGetFontStyle(TfrMemoView(t).Font.Style);
4: Value := TfrMemoView(t).Font.Color;
5: Value := TfrMemoView(t).Adjust;
end;
exit;
end;
end;
// no luck yet, try next if it's a custom variable
if Assigned(frParser.OnGetValue) then
frParser.OnGetValue(Name, Value);
end;
{$IFDEF DebugLR}
DebugLn('TInterpretator.GetValue(',Name,') No Propinfo for Prop=',Prop);
{$ENDIF}
if VarIsNull(Value) or VarIsEmpty(Value) then
begin
{$IFDEF DebugLR}
DebugLn('TInterpretator.GetValue(',Name,')=NULL >> Value="',Name,'"');
{$ENDIF}
Value:=Name;
end
{$IFDEF DebugLR}
else
DebugLn('TInterpretator.GetValue(',Name,')=',VarToStr(Value));
{$ENDIF}
end;
*)
end; end;
{$WARNINGS ON}
procedure TInterpretator.SetValue(const Name: String; Value: Variant); procedure TInterpretator.SetValue(const Name: String; Value: Variant);
var var