paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-06 01:37:12 +01:00
Code Issues Packages Projects Releases Wiki Activity

LazReport, handle position and dimesion of objects in Object Inspector using selected units

Browse Source 
git-svn-id: trunk@15976 -
This commit is contained in:
jesus 2008-08-06 17:30:17 +00:00
parent 9cdbd4cf27
commit 81d36b8670
3 changed files with 109 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,5 +1,5 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
{ This file was automatically created by Lazarus. do not edit!
This source is only used to compile and install the package.
}
unit lazreport;
@ -8,9 +8,9 @@ interface
uses
LR_Class, LR_Desgn, LR_Register, LR_Flds, LR_DBSet, LR_BarC, LR_BndEd,
LR_PGrid, LR_View, lr_expres, lr_funct_editor_unit, lr_funct_editor_unit1,
LR_Prntr, LR_Edit, LR_Pars, LR_fmted, LR_Const, LR_pgopt, LR_Dopt,
LR_GEdit, LR_Utils, LR_GrpEd, lr_propedit, LazarusPackageIntf;
LR_PGrid, LR_View, lr_expres, lr_funct_editor_unit, lr_funct_editor_unit1,
LR_Prntr, LR_Edit, LR_Pars, LR_fmted, LR_Const, LR_pgopt, LR_Dopt, LR_GEdit,
LR_Utils, LR_GrpEd, lr_propedit, LazarusPackageIntf;
implementation

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

@ -194,10 +194,17 @@ type
fStreamMode: TfrStreamMode;
fFormat : Integer;
fFormatStr : string;
function GetHeight: Double;
function GetLeft: Double;
function GetTop: Double;
function GetWidth: Double;
procedure P1Click(Sender: TObject);
procedure SetFillColor(const AValue: TColor);
procedure SetFrames(const AValue: TfrFrameBorders);
procedure SetHeight(const AValue: Double);
procedure SetLeft(const AValue: Double);
procedure SetTop(const AValue: Double);
procedure SetWidth(const AValue: Double);
protected
SaveX, SaveY, SaveDX, SaveDY: Integer;
SaveFW: Single;
@ -267,10 +274,10 @@ type
property StreamMode: TfrStreamMode read fStreamMode write fStreamMode;
published
property Left;
property Top;
property Width;
property Height;
property Left: double read GetLeft write SetLeft;
property Top: double read GetTop write SetTop;
property Width: double read GetWidth write SetWidth;
property Height: double read GetHeight write SetHeight;
end;
TfrStretcheable = class(TfrView)
@ -951,6 +958,10 @@ type
procedure BeforeChange; virtual; abstract;
procedure AfterChange; virtual; abstract;
procedure RedrawPage; virtual; abstract;
//
function PointsToUnits(x: Integer): Double; virtual; abstract;
function UnitsToPoints(x: Double): Integer; virtual; abstract;
procedure MoveObjects(dx, dy: Integer; aResize: Boolean); virtual; abstract;
end;
TfrDataManager = class(TObject)
@ -1695,10 +1706,10 @@ begin
CreateUniqueName;
end;
Left := XML.GetValue(Path + 'Size/Left/Value', 0); // TODO Check default
Top := XML.GetValue(Path + 'Size/Top/Value', 0); // TODO Check default
Width := XML.GetValue(Path + 'Size/Width/Value', 100); // TODO Check default
Height:= XML.GetValue(Path + 'Size/Height/Value', 100); // TODO Check default
x := XML.GetValue(Path + 'Size/Left/Value', 0);
y := XML.GetValue(Path + 'Size/Top/Value', 0);
dx := XML.GetValue(Path + 'Size/Width/Value', 100);
dy := XML.GetValue(Path + 'Size/Height/Value', 100);
Flags := Word(XML.GetValue(Path + 'Flags/Value', 0)); // TODO Check default
FFrameWidth := XML.GetValue(Path+'Frames/FrameWidth/Value', 1); // TODO Check default
@ -1920,6 +1931,42 @@ begin
frDesigner.AfterChange;
end;
function TfrView.GetLeft: Double;
begin
if frDesigner<>nil then
result := frDesigner.PointsToUnits(inherited Left)
else
result := inherited Left;
WriteLn('GetLeft=',FloatToStr(result),' Left=',inherited Left);
end;
function TfrView.GetHeight: Double;
begin
if frDesigner<>nil then
result := frDesigner.PointsToUnits(inherited Height)
else
result := inherited Height;
WriteLn('GetHeight=',FloatToStr(result),' Height=',inherited Height);
end;
function TfrView.GetTop: Double;
begin
if frDesigner<>nil then
result := frDesigner.PointsToUnits(inherited Top)
else
result := inherited Top;
WriteLn('GetTop=',FloatToStr(result),' Top=',inherited Top);
end;
function TfrView.GetWidth: Double;
begin
if frDesigner<>nil then
result := frDesigner.PointsToUnits(inherited Width)
else
result := inherited Width;
WriteLn('GetWidth=',FloatToStr(result),' Width=',inherited Width);
end;
procedure TfrView.SetFillColor(const AValue: TColor);
begin
if (aValue<>fFillColor) and (fUpdate=0) then
@ -1935,6 +1982,50 @@ begin
fFrames:=AValue;
end;
procedure TfrView.SetHeight(const AValue: Double);
var
tmp: Integer;
begin
if frDesigner<>nil then begin
tmp := frDesigner.UnitsToPoints(AValue);
frDesigner.MoveObjects(0,tmp-dy,true);
end else
dy := round(Avalue);
end;
procedure TfrView.SetLeft(const AValue: Double);
var
tmp: Integer;
begin
if frDesigner<>nil then begin
tmp := frDesigner.UnitsToPoints(AValue);
frDesigner.MoveObjects(tmp-x, 0, false);
end else
x := round(AValue);
end;
procedure TfrView.SetTop(const AValue: Double);
var
tmp: Integer;
begin
if frDesigner<>nil then begin
tmp := frDesigner.UnitsToPoints(AValue);
frDesigner.MoveObjects(0, tmp-y, false);
end else
y := round(AValue);
end;
procedure TfrView.SetWidth(const AValue: Double);
var
tmp: Integer;
begin
if frDesigner<>nil then begin
tmp := frDesigner.UnitsToPoints(AValue);
frDesigner.MoveObjects(tmp-dx, 0, true);
end else
dx := round(AValue);
end;
{----------------------------------------------------------------------------}
constructor TfrMemoView.Create;
begin

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

@ -485,7 +485,6 @@ type
function DelEnabled: Boolean;
function EditEnabled: Boolean;
procedure ColorSelected(Sender: TObject);
procedure MoveObjects(dx, dy: Integer; aResize: Boolean);
procedure SelectAll;
procedure Unselect;
procedure CutToClipboard;
@ -533,9 +532,10 @@ type
procedure ShowEditor;
procedure RedrawPage; override;
procedure OnModify(Item: Integer; var EditText: String);
function PointsToUnits(x: Integer): Double;
function UnitsToPoints(x: Double): Integer;
function PointsToUnits(x: Integer): Double; override;
function UnitsToPoints(x: Double): Integer; override;
procedure MoveObjects(dx, dy: Integer; aResize: Boolean); override;
property CurDocName: String read FCurDocName write SetCurDocName;
property CurPage: Integer read FCurPage write SetCurPage;
property GridSize: Integer read FGridSize write SetGridSize;