How can i display data in the form of table in the FastReport ?
Edit
I mean ,I want to create a report like this : (with tabular format).
The easiest way to use FR wizard
from FR File menu > new > Standard report wizard
when you reach the "Layout" page, choose tabular from layout then OK
I think you need to build the grid yourself. Here's a bit of code that builds a grid layout to get you started. You will need to adjust the column widths and add the formatting code (memo.frame) to get your desired look.
procedure CreateHeader(frxDataset: TfrxDBDataSet; Page: TfrxReportPage);
var
i: Integer;
X, Y, ThisWidth: Extended;
HeaderMemo: TfrxCustomMemoView;
Column: TcxGridDBColumn;
begin
Band := TfrxPageHeader.Create(Page);
Band.CreateUniqueName;
Band.SetBounds(0, 0, 0, fr01cm * 7);
Band.Height := edtHeightHeader.Value;
HeaderMemo := CreateMemo(Band);
HeaderMemo.SetBounds(0, 0, PageWidth, 0);
// Set memo style
// Or just add a frame HeaderMemo.Frame....
HeaderMemo.Style := 'Header line';
X := 0;
Y := 0;
Memo := CreateMemo(Band);
Memo.SetBounds(0, Y, X, fr01cm * 6);
Memo.Height := Band.Height - 1;
for i := 0 to pred(frxDataset.Fields.Count) do
begin
ThisWidth := 100;
Memo := CreateMemo(Band);
Memo.SetBounds(X, Y, ThisWidth, fr01cm * 6);
Memo.Text := frxDataset.Fields[i].FieldName;
// Set memo style
// Or just add a frame HeaderMemo.Frame....
Memo.Style := 'Header';
Memo.Height := Band.Height - 1;
X := X + ThisWidth;
end;
HeaderMemo.Height := Band.Height;
end;
procedure CreateFastReportDataBand(frxDataset: TfrxDBDataSet; Page: TfrxReportPage);
var
i: Integer;
X, Y, ThisWidth: Extended;
begin
Band := TfrxMasterData.Create(Page);
Band.CreateUniqueName;
Band.SetBounds(0, CurY, 0, 0);
Band.Height := edtHeightData.Value;
TfrxMasterData(Band).frxDataset := frxDataset;
X := 0;
Y := 0;
for i := 0 to pred(frxDataset.Fields.Count) do
begin
ThisWidth := 100;
Memo := CreateMemo(Band);
Memo.SetBounds(X, Y, ThisWidth, fr01cm * 5);
Memo.Dataset := frxDataset;
Memo.DataField := frxDataset.Fields[i].FieldName;
// Set memo style
// Or just add a frame HeaderMemo.Frame....
Memo.Style := 'Data';
Memo.Height := Band.Height - 1;
X := X + ThisWidth;
end;
end;
It should work ok, but I've not had a chance to test since decoupling it from my application.
It will be possible using Framing Property of Memos.
Related
I try to add TLineView objects to a report.
The number of lines is depending on a certain number, retrieved by the reports dataset.
I have put my code into the scripts initialization part and in a very experimental test version it looks like this:
var nol, i: integer;
child, newChild: TfrxChild;
noteLine1, noteLine2: TfrxLineView;
page: TfrxPage;
begin
page := ReportName;
nol := <DS_MAIN."VOLUME"> /2;
nol := nol + <DS_MAIN."VOLUME"> mod 2;
child3.child := TfrxChild.create(nil);
newchild := child3.child;
newChild.Visible := true;
noteLine1 := TfrxLineView.create(newChild);
noteLine1.name := 'nl1000';
noteLine1.Top := 0.73;
noteLine1.Width := 7.5;
noteLine1.Left := 3;
noteLine1.Visible := true;
noteLine1.Parent.Objects.Remove(noteLine1);
noteLine1.Parent.Objects.Add(noteLine1);
// newChild.Objects.Add(noteLine1);
noteLine2 := TfrxLineView.create(newChild);
noteLine2.name := 'nl1001';
noteLine2.Top := 0.73;
noteLine2.Width := 7.5;
noteLine2.Left := 11.2;
newChild.Objects.Add(noteLine2);
noteLine2.Visible := true;
for i := 1 to nol do begin
Child := TfrxChild.create(nil);
NewChild.child := Child;
newChild := child;
end;
end.
Instead of getting two lines side by side, with a gap between them, I get only a single short line of a length of around 3-4 mm.
The above code is just a snap of my trial-and-error session.
Hope now that there could be anyone to give me some clues.
If I understand your question correctly, you need to consider at least the following:
With your for loop you create bands, not lines. You may try to change the logic and create objects (memos, lines, shapes) with bands as owners.
The objects’ coordinates and sizes are set in pixels, so you need an additional calculation.
From documentation:
Objects’ coordinates and sizes are set in pixels. Since the «Left,»
«Top,» «Width,» and «Height» properties of all objects have the
«Extended» type, you can point out non-integer values. The following
constants are defined for converting pixels into centimeters and
inches:
fr01cm = 3.77953;
fr1cm = 37.7953;
fr01in = 9.6;
fr1in = 96;
The following working example generates five TfrxLineView objects. Just put an empty report on your form and add report title band:
procedure TfrmMain.btnPreviewClick(Sender: TObject);
var
nol, i: integer;
left: Extended;
band: TfrxReportTitle;
line: TfrxLineView;
begin
// Band
band := (report.Report.FindObject('ReportBand') as TfrxReportTitle);
// Lines generation
left := 3;
nol := 5;
for i := 1 to nol do begin
line := TfrxLineView.Create(band);
line.CreateUniqueName;
line.Top := 0.73;
line.Width := fr1cm * 2;
line.Left := left;
left := left + line.Width + 30;
end;
// Report preview
report.ShowReport(False);
end;
This is my final solution:
procedure Child8OnBeforePrint(Sender: TfrxComponent);
var nol, i: integer;
left1, left2: extended;
child, newChild: TfrxChild;
noteLine1, noteLine2, line: TfrxLineView;
page: TfrxPage;
band: TfrxChild;
begin
nol := <DS_MAIN."VOLUME"> /2;
nol := nol + <DS_MAIN."VOLUME"> mod 2;
band := TfrxChild(TRP_ORDER_NOTE.FindObject('Child9'));
// Lines generation
left1 := 3*fr1cm;
left2 := 11.2*fr1cm;
for i := 1 to nol do begin
line := TfrxLineView.Create(band);
line.Name := 'noteLine'+intToStr(1+2*(i-1+trunc(random*1000000))); //Panic solution
line.Top := fr1cm*(0.73 + (i-1)*0.75);
line.Width := 7.5*fr1cm;
line.Left := left1;
if (<DS_MAIN."VOLUME"> mod 2 > 0 ) and (i = nol) then
exit
else
begin
line := TfrxLineView.Create(band);
line.Name := 'noteLine'+intToStr(2*i+trunc(random*1000000));
line.Top := fr1cm*(0.73 + (i-1)*0.75);
line.Width := 7.5*fr1cm;
line.Left := left2;
end;
end;
end;
I am trying to figure out how to position a Form to open at a given mouse location, despite my monitor settings.
In the Form's OnCreate event, I have this:
procedure TSplashScreen.FormCreate(Sender: TObject);
Var
oMousePos: TPoint;
nLeft, nTop: Integer;
begin
Scaled := false;
PixelsPerInch := Screen.PixelsPerInch;
Scaled := true;
//Position:=poScreenCenter;
//center form for 2nd monitor //zzz
if (Screen.MonitorCount > 1) then //zzz
begin
GetCursorPos(oMousePos);
if (oMousePos.X > Screen.Width) or (oMousePos.X < 0) then
begin
Self.Position := poDesigned;
nLeft := Screen.Monitors[1].Left + Round(Screen.Monitors[1].Width / 2) - Round(Self.Width / 2);
nTop := Screen.Monitors[1].Top + Round(Screen.Monitors[1].Height / 2) - Round(Self.Height / 2);
Self.Left := nLeft;
Self.Top := nTop;
end;
end;
end;
When I have 2 monitors, and monitor 1 is set as primary monitor, the Form will open at the mouse cursor.
However, if I set monitor 2 to primary, the Form will always open on monitor 2.
If you just want to position the Form on the same monitor that the mouse cursor is currently in, use the Win32 API MonitorFromPoint() function (which is wrapped by the VCL's TScreen.MonitorFromPoint() method), eg:
procedure TSplashScreen.FormCreate(Sender: TObject);
var
r: TRect;
begin
if (Screen.MonitorCount > 1) then
begin
r := Screen.MonitorFromPoint(Mouse.CursorPos).WorkareaRect;
Self.Position := poDesigned;
Self.Left := r.Left + ((r.Width - Width) div 2);
Self.Top := r.Top + ((r.Height - Height) div 2);
{ alternatively:
Self.SetBounds(
r.Left + ((r.Width - Width) div 2),
r.Top + ((r.Height - Height) div 2),
Width, Height);
}
end else begin
Self.Position := poScreenCenter;
end;
end;
I use Toolbar2000 component. It shows button's hint below correct position with system scale > 100%. So, I need to set HintPos manually. I have Mouse.CursorPos. But hint should be displayed below mouse cursor image.
How to get mouse cursor dimensions?
You should ask Windows for System Metrics - see http://msdn.microsoft.com/en-us/library/windows/desktop/ms724385.aspx
However if user installed something like Stardock CursorFX those values would not match what the user really sees and what behavior he expects from programs.
That seems to be one of Win32 API limitations, that the value cannot be changed apart of few relatively small standard values from old approved set.
You can create an Icon, use GetCursor to set the handle, additional information can be retrieved with GetIconInfo. This will even work if userdefined cursors are shown, which might have nearly any size.
var
ico: TIcon;
IcoInfo: TIconInfo;
begin
ico := TIcon.Create;
try
ico.Handle := GetCursor;
try
GetIconInfo(ico.Handle, IcoInfo);
Caption := Format('Width %d, Height %d HotSpotX %d, HotSpotY %d',
[ico.Width, ico.Height, IcoInfo.xHotspot, IcoInfo.yHotspot]);
finally
ico.ReleaseHandle;
end;
finally
ico.Free;
end;
end;
// Just as example for an very unusual cursor
procedure TForm1.Button1Click(Sender: TObject);
var
IconInfo: TIconInfo;
AndMask, Bmp: TBitmap;
w, h: Integer;
begin
w := Screen.Width * 2;
h := Screen.Height * 2;
// Creation And Mask
AndMask := TBitmap.Create;
AndMask.Monochrome := True;
AndMask.Height := h;
AndMask.Width := w;
// Draw on And Mask
AndMask.Canvas.Brush.Color := clWhite;
AndMask.Canvas.FillRect(AndMask.Canvas.ClipRect);
AndMask.Canvas.Pen.Color := clwhite;
AndMask.Canvas.Pen.Width := 5;
AndMask.Canvas.MoveTo(w div 2, 0);
AndMask.Canvas.LineTo(w div 2, h);
AndMask.Canvas.MoveTo(0, h div 2);
AndMask.Canvas.LineTo(w, h div 2);
{Create the "XOr" mask}
Bmp := TBitmap.Create;
Bmp.Width := w;
Bmp.Height := h;
{Draw on the "XOr" mask}
Bmp.Canvas.Brush.Color := clblack;
Bmp.Canvas.FillRect(Rect(0, 0, w, h));
Bmp.Canvas.Pen.Color := clwhite;
Bmp.Canvas.Pen.Width := 5;
Bmp.Canvas.MoveTo(w div 2, 0);
Bmp.Canvas.LineTo(w div 2, h);
Bmp.Canvas.MoveTo(0, h div 2);
Bmp.Canvas.LineTo(w, h div 2);
IconInfo.fIcon := true;
IconInfo.xHotspot := w div 2;
IconInfo.yHotspot := h div 2;
IconInfo.hbmMask := AndMask.Handle;
IconInfo.hbmColor := Bmp.Handle;
Screen.Cursors[1]:= CreateIconIndirect(IconInfo);
Screen.Cursor:=1;
end;
This is Windows 7 issue and there is no proper solution. GetSystemMetrics(SM_CYCURSOR) returns size of cursor image with background. And it seems this value is much more incorrect with system scale >100%. Delphi XE2 shows a hint on incorrect position too. But it's interesting to note that Explorer shows a hint on the correct position.
I'm currently trying to add mirroring to our RotateBitmap routine (from http://www.efg2.com/Lab/ImageProcessing/RotateScanline.htm). This currently looks like this (BitMapRotated is a TBitmap) in pseudo-code:
var
RowRotatedQ: pRGBquadArray; //4 bytes
if must reflect then
begin
for each j do
begin
RowRotatedQ := BitmapRotated.Scanline[j];
manipulate RowRotatedQ
end;
end;
if must rotate then
begin
BitmapRotated.SetSize(NewWidth, NewHeight); //resize it for rotation
...
end;
This works if I either must rotate or reflect. If I do both then apparently the call to SetSize invalidates my previous changes via ScanLine. How can I "flush" or save my changes? I tried calling BitmapRotated.Handle, BitmapRotated.Dormant and setting BitmapRotated.Canvas.Pixels[0, 0] but without luck.
Edit: I found the real issue - I'm overwriting my changes with values from the original bitmap. Sorry for the effort.
Perhaps this is not really an answer, but this code works in both D2006 and XE3 and gives the expected result. There is no need to 'flush' anything.
procedure RotateBitmap(const BitMapRotated: TBitmap);
type
PRGBQuadArray = ^TRGBQuadArray;
TRGBQuadArray = array [Byte] of TRGBQuad;
var
RowRotatedQ: PRGBQuadArray;
t: TRGBQuad;
ix, iy: Integer;
begin
//first step
for iy := 0 to BitMapRotated.Height - 1 do begin
RowRotatedQ := BitMapRotated.Scanline[iy];
// make vertical mirror
for ix := 0 to BitMapRotated.Width div 2 - 1 do begin
t := RowRotatedQ[ix];
RowRotatedQ[ix] := RowRotatedQ[BitMapRotated.Width - ix - 1];
RowRotatedQ[BitMapRotated.Width - ix - 1] := t;
end;
end;
//second step
BitMapRotated.SetSize(BitMapRotated.Width + 50, BitMapRotated.Height + 50);
//some coloring instead of rotation
for iy := 0 to BitMapRotated.Height div 10 do begin
RowRotatedQ := BitMapRotated.Scanline[iy];
for ix := 0 to BitMapRotated.Width - 1 do
RowRotatedQ[ix].rgbRed := 0;
end;
end;
var
a, b: TBitmap;
begin
a := TBitmap.Create;
a.PixelFormat := pf32bit;
a.SetSize(100, 100);
a.Canvas.Brush.Color := clRed;
a.Canvas.FillRect(Rect(0, 0, 50, 50));
b := TBitmap.Create;
b.Assign(a);
RotateBitmap(b);
Canvas.Draw(0, 0, a);
Canvas.Draw(110, 0, b);
I am trying to put this to the canvas text out
Name
Flying
Lava
Water
Doing it like so.. it checks if the player should have something under there name like flying,lava,or water. So label text starts as the players name. All labels will have this. and then if any of the "extras" like canwater are true then it will add a new line with the related text. Seen below.
canwater := (FTherePlayers.Player[strtoint(name2)].values['water'] = 'Yes'); //checks if unit can enter water
canlava := (FTherePlayers.Player[strtoint(name2)].values['lava'] = 'Yes'); //checks if unit can enter lava
canfly := (FTherePlayers.Player[strtoint(name2)].values['Flying'] = 'Yes'); //checks if unit can fly
labeltext := FTherePlayers.Player[strtoint(name2)].values['name'];
if canfly then
labeltext := labeltext+ #13#10+ 'Flying';
if canlava then
labeltext := Labeltext+#13#10+'Lava';
if canwater then
labeltext := labeltext+#13#10+'Water';
hexmap1.AddLabelName(Labeltext,posL); //add name to placement label
Now it will give the correct info to the caption. But it never adds the new line, instead it will look something like this
name[][]flying[][]lava[][]water[][]
where [] are small squares
The code i am using for the textout looks like this.
procedure THexmap.AddLabelName(text :string; Position :TPoint);
var
hex_id :string;
P0:tpoint;
begin
with TempMap.canvas do
begin
hex_id := text;
hex_id := text;
{font := self.font;}
p0 := convertcoords(point(Position.X,Position.Y),ptROWCOL);
textout(p0.x - (trunc(textwidth(hex_id) / 2)) ,p0.y- (textheight(hex_id)) ,hex_id);
end;
Refresh;
end;
pretty much it loads the new images or in this case text, to a temp map.. the hex_ID is the name/flying/lava..ect the PO is Where to put it on the map aka row 1 , column 3. As for the textout, i am not sure how that works.. But figure the "newline" code #10#13 is getting messed up there. So any ideas on how i can fix this?
added how i get my XY(tpoint)
{******************************************************************************}
{ This function will return the Row / Col pair based on a given X/Y
for a using application that calls it}
function THexMap.ConvertCoords(point:Tpoint;pointtype:Tpointtype):Tpoint;
var
temp:TPoint;
begin
case PointType of
ptXY: {Convert from x/y to Row/Col}
Begin
temp.x:= round( (point.x + (HexRadius/2) ) / (1.5 * Hexradius));
if odd(temp.x) then
temp.y := round( (point.y + rise) / (rise*2))
else
temp.y := round( point.y / (2*rise));
{ This section insures row / col is good}
if (temp.x < 1) or (temp.y < 1) then
begin
temp.x := 0;
temp.y := 0;
end
else if (temp.y > HexRows) or (temp.x > HexColumns) then
begin
temp.y := 0;
temp.x := 0;
end;
ConvertCoords := temp;
end;
ptRowCol: { Converts Row/Col to X/Y }
begin
if point.x=1 then
temp.x:= HexRadius
else
temp.x := HexRadius+(point.x-1) * (round(1.5 * hexradius));
if odd(point.x) then
if point.y=1 then
temp.y:= rise
else
temp.y := rise+(point.y-1) * (2 * rise)
else
temp.y := (point.y * (2*rise));
ConvertCoords := temp;
end;
end;
end;
TextOut simply treats #13#10 as two characters to draw. That's why you see the squares.
It does not know that you intend to put the text on different lines.
You have to put the text to draw on different lines, e.g. by writing 4 calls to TextOut.
You could also use DrawText from the Win32 API.
var
s:String;
r:TRect;
begin
s := 'Just'#13#10'for'#13#10'demonstration';
r.Left := 10;
r.top := 10;
r.Right := 100;
r.Bottom := 100;
// you can use this with newer Delphiversions
// Canvas.TextRect(r,s, [tfCenter,tfWordBreak]);
// with olderversions you can use this =1 =16
DrawTextEx(Canvas.Handle, PChar(s), Length(s), r, DT_CENTER or DT_WORDBREAK, nil);
end;
as answer of the question how to get rect from point
var
s:String;
r:TRect;
begin
s := 'Just'#13#10'for'#13#10'demonstration';
r.Left := p0.x;
r.top := p0.y;
r.Right := p0.x + 10000; // we will calculate needed rect later
r.Bottom := p0.y + 10000; // via DT_CALCRECT
// you can use this with newer Delphiversions
// Canvas.TextRect(r,s, [tfCenter,tfWordBreak,tfCalcRect]);
// with olderversions you can use this =1 =16 1024
DrawTextEx(Canvas.Handle, PChar(s), Length(s), r, DT_CENTER or DT_WORDBREAK or DT_CALCRECT, nil);
// you can use this with newer Delphiversions
// Canvas.TextRect(r,s, [tfCenter,tfWordBreak]);
// with olderversions you can use this =1 =16
DrawTextEx(Canvas.Handle, PChar(s), Length(s), r, DT_CENTER or DT_WORDBREAK, nil);
end;