I have a TeeChart with 32 series and 6 custom axes. I need to print this chart, and we're using ReportBuilder everywhere else in our software to print charts (where there will be a printpreview on the screen first). We're using the CloneChart-method to have the Chart copied to ReportBuilder. With this chart we have the problem that the chart is not fully visible, like it is not stretching.
I also notice that the custom axes are not visible in ReportBuilder.
My goal is to have an exact copy of the TeeChart on the form, in ReportBuilder for printing purposes.
I tried copying the custom-axis, added the custom-axis in the ReportBuiled ppChart. Point is that the series are created at runtime. Hmmm, I need to link the series with the right custom axes or something.
I tried several other things in a search for streching, without success.
for i := 0 to aChartSource.SeriesCount - 1 do
begin
if aChartSource[i].Active then
begin
s := CloneChartSeries(aChartSource[i]);
s.ParentChart := AChartTarget.Chart;
s.GetVertAxis.Grid.Visible := (s.GetVertAxis.Grid.Visible and aShowGrid);
s.GetHorizAxis.Grid.Visible := (s.GetHorizAxis.Grid.Visible and aShowGrid);
s.Marks.Visible := (s.Marks.Visible and aShowMarks);
s.OnGetMarkText := GetMarkText;
for ii := 0 to AChartSource[i].Count -1 do
begin
if (s.ValueColor[ii] <> AChartSource[i].ValueColor[ii]) then
begin
s.ValueColor[ii] := AChartSource[i].ValueColor[ii];
vRedraw := TRUE;
end;
end;
end;
end;
{ Duplicate the axis }
for i := 0 to aChartSource.CustomAxes.Count - 1 do
begin
ppchrtKPI.Chart.CustomAxes.Add;
LAxis.
LAxis := ppchrtKPI.Chart.CustomAxes[ppchrtKPI.Chart.CustomAxes.Count-1];
LAxis.Assign(aChartSource.CustomAxes[i]);
end;
The ouput on the ReportBuilder's PrintPreview form is a chart with the series, but without the custom vertical axes. And the Teechart in ReportBuilder seems to be cropped; the series near the bottom X-axis are not visible
As said here, the problem with the custom axes sounds like the ticket #780 which was fixed in v2018.24.180321.
Related
I want to load pictures from an ImageList to a TImage (mobile application, fmx). The TImage is part of my customstyle Listbox (LBItem.StylesData['myimage']). The standard approach would be ImageList.GetBitmap(). However the GetBitmap method gives me an error: 'TimageList does not contain a member named GetBitmap'. Any explanation or alternatives? Thanks in advance!
procedure TForm3.Button1Click(Sender: TObject);
var
i : Integer;
LBItem : TListBoxItem;
Bitmap : TBitMap;
begin
ListBox1.BeginUpdate;
ListBox1.Items.Clear;
Bitmap := TBitMap.Create;
try
for i := 0 to 3 do begin
LBItem := TListBoxItem.Create(nil);
LBItem.Parent := ListBox1;
LBItem.StyleLookup := 'mystyle';
LBItem.StylesData['mylabel'] := 'Some text...';
//Bitmap.LoadFromFile('D:\Koala.jpg');
ImageList1.GetBitmap(i, Bitmap);
LBItem.StylesData['myimage']:= Bitmap;
end;
finally
ListBox1.EndUpdate;
end;
end;
Assuming you have an TImage with name Image1, a TImageList with name ImageList1 and at least one entry in the list with image for scale 1.0 called Image1Hover, then you can use the following example to load a "hover picture" in the OnEnter event of Image1:
procedure TForm1.Image1MouseEnter(Sender: TObject);
var
Item: TCustomBitmapItem;
Size: TSize;
begin
ImageList1.BitmapItemByName('Image1Hover', Item, Size);
Image1.Bitmap := Item.MultiResBitmap.Bitmaps[1.0];
end;
This answer is translate from fire-monkey.ru
Use ImageList1.Bitmap(Size, Index);. The size is in physical pixels, i.e. we consider the scale independently (this method knows nothing about the scale of the canvas). This function selects the most appropriate size of the image that is available.
So, your code should look something like this:
LBItem.StylesData['myimage'] := ImageList1.Bitmap(
TSizeF.Create(myImageWidth * Canvas.Scale, myImageHeight * Canvas.Scale),
i);
// Not sure of the correctness of this assignment to 'myimage'
Note 1 All the bitmaps obtained in the 'ImageList1.Bitmap` are stored in the imagelist cache. So don't release them.
Note 2 ListBox has internal mechanism to interact with ImageList. Try to use icon: TImage style item and LBItem.ImageIndex property, without load bitmaps.
In FMX you don't need any additional coding for that, just use TGlyph instead of TImage if you want to display images directly form ImageList.
example :
Glyph1.ImageIndex := i;
I'm building multiplatform( iOS, Android, OSX, Windows APP) in Firemonkey. One of the things I'm trying to do is create a custom listbox item( with more data elements) that will work on all these platforms:
will give you ability to select item(s), display properly.
According to research I did, probably the best way for this is to create custom style for list box item and define data elements there. That's what I did.
I'm creating items from client dataset in this procedure:
procedure TMasterDetailForm.LoadAvailable;
var i: Integer;
Item: TListBoxItem;
begin
lstAvailable.Clear;
//Add Header
lstAvailable.BeginUpdate;
Item := TListBoxItem.Create( lstAvailable );
Item.Parent := lstAvailable;
Item.Height := 70;
//Item.OnApplyStyleLookup := ListItemApplyStyleLookupHandler;
Item.StyleLookup := AvailableListHeaderStyle;
//Add Details
cdsAvailable.First;
for I := 1 to cdsAvailable.RecordCount do
begin
Item := TListBoxItem.Create( lstAvailable );
Item.Parent := lstAvailable;
Item.Height := 50;
//Item.Selectable := True;
//Item.OnApplyStyleLookup := ListItemApplyStyleLookupHandler;
Item.StyleLookup := AvailableListItemStyle;
//Item.StyleLookup := 'ListboxItem1Style1';
Item.StylesData[ txtWoNum ] := cdsAvailable.FieldByName( 'work package' ).AsString;
Item.StylesData[ txtAircraft ] := cdsAvailable.FieldByName('aircraft').AsString;
Item.StylesData[ txtTaskDescription ] := cdsAvailable.FieldByName('task').AsString;
cdsAvailable.Next;
end;
lstAvailable.EndUpdate;
end;
Everything gets styled properly on all platforms, except that tapping(clicking) on ListBoxItem on Android or iOS, doesn't highlight the ListBoxItem. If I unissign style then selecting items also works.I can't figure out how to fix this.
Btw, onclick event on ListBox seems to work properly( itemindex changes).
Any input will be greatly appreciated.
Edit( 12/12/2014) : I tried simplifying the example by adding items manually in the ListBox editor and discarding this code here, and I found out that animation for selecting the listbox item changes. So, I customized the listbox item and only changed TextColor to blue. In runtime on Android when you select the listbox item it just changes the color of the text to black instead of painting the whole row. Any ideas how to have listbox behave in similar way like when there is no style attached to it?
Sorry my english is bad.
I have a solution (tested in XE7):
Open a form
Change the IDE Style to "iOS"
Select the TListBox an open a context menu and select "Edit Default
Style": the StyleBook2 is created.
Add a TRectangle component in the style "listboxstyle/background"
with the name "selection". This is the magic!
Now, Firemonkey found the 'selection' component and work fine!
If you already have StyleBook2 component before these steps, you may need to delete it, be careful!
I have a number of list view controls (TListView) that are used to display data. All these list view are set to "Detail" mode and all have TImageList assigned to their "SmallIcons" properties.
I'm trying to set the width of these column based on their contents exactly in the same way as if the user double-clicked on the separator slider at the end of each of the column headers.
First, I tried to set the column width to "-1" and "-2" for auto-sizing them: not only did that fail to work perfectly (some columns containing local characters - I'm using D6 and that means ANSI strings - are too low) but it also made the display of the column extremely slow (up to 30 seconds to display a list view with 6 column and 150 items when it's instantaneous with fixed width).
I have tried to use GetTextExtent on each cell to obtain the expected width of the text, adding some margin (from 2 to 10 pixels) and the expand the width of the column if it is lower than the calculated text width. Special treatment is applied to the first column (Items.caption) to take into account the display of the icon (I add the width of the icon, plus margin, to the width of the cell's text).
That didn't work either: in many cases (for instance, displaying the date in "yyyy/mm/dd hh:nn:ss" format results in a text too large to fit in the column).
Thinking that the issue could come from the window theme engine, I've switched to use GetThemeTextExtent instead of GetTextExtent but obtained the same result.
The only thing that seems to work is to add an arbitrary large margin (20 pixels) to each column width but, of course, that produces columns that are larger than they should be.
So, is there any alternative strategy ? I don't need anything but something that will calculate the correct width once: when the list is first populated. The code behind "clicking the column separator" works just fine but I can't find how to trigger it by code (well, I guess I could send the double click messages to the header directly as a hack)
For clarification, here are the things I tried the following code:
(in call case, there is a call made to ListView.canvas.Font.Assign(ListView.font). It is not in theses functions because a single assignment is enough but the code loops on all non-autosized columns of the listview).
Edit
My initial attempt using Windows Theme API:
function _GetTextWidth1(AText: widestring; IsHeader: boolean = false): Integer;
var
ATheme: HTheme;
rValue: TRect;
iPartID: integer;
AWidetext: WideString;
const
LVP_GROUPHEADER = 6;
begin
// try to get text width using theme API
ZeroMemory(#rValue, SizeOf(rValue));
ATheme := OpenThemeData(ListView.Handle, 'LISTVIEW');
try
if not IsHeader then
iPartID := LVP_LISTITEM
else
iPartID := LVP_GROUPHEADER;
AWidetext := AText;
GetThemeTextExtent( ATheme,
ListView.Canvas.Handle,
iPartID,
LIS_NORMAL,
PWideChar(AWidetext),
-1,
DT_LEFT or DT_SINGLELINE or DT_CALCRECT,
nil,
rValue
);
finally // wrap up
CloseThemeData(ATheme);
end; // try/finally
result := rValue.Right;
end;
next attempt using DrawText/DrawTextW:
function _GetTextWidth2(AText: widestring; IsHeader: boolean = false): Integer;
var
rValue: TRect;
lFlags: Integer;
begin
// try to get text width using DrawText/DrawTextW
rValue := Rect(0, 0, 0, 0);
lFlags := DT_CALCRECT or DT_EXPANDTABS or DT_NOPREFIX or DT_LEFT or DT_EXTERNALLEADING;
DrawText(ListView.canvas.Handle, PChar(AText), Length(AText), rValue, lFlags);
//DrawTextW(ListView.canvas.Handle, PWideChar(AText), Length(AText), rValue, lFlags);
result := rValue.Right;
end;
Third attempt using delphi's TextWidth function
function _GetTextWidth3(AText: widestring; IsHeader: boolean = false): Integer;
begin
// try to get text width using delphi wrapped around GetTextExtentPoint32
result := ListView.canvas.TextWidth(Atext);
end;
In all cases, I add a margin to the resulting width: I tried values as high as 20 pixels. I also take into account the possibility that the view use icons (in which case I add the width of the icon plus the margin again to the first column).
You could use canvas.TextWidth method. But be sure to use TListView canvas (not other, i.e. TForm) and first assign a font to canvas from TListView.
For example:
var
s: integer;
begin
ListView1.AddItem('test example item', nil);
ListView1.canvas.Font.Assign(ListView1.font);
s := ListView1.canvas.TextWidth(ListView1.Items[0].Caption) + 10; //this "+10" is a small additional margin
if s > ListView1.Columns[0].Width then
ListView1.Columns[0].Width := s;
It works fine for me.
I try to display formatted text on the screen. At first the very simple HTML text is parsed (there are tags like b,u,i) and then each character is rendered using Canvas.TextOut function in appropriate position and font.
The first thing I noticed is, that rendering of every separate character on the canvas is rather slow. The rendering of whole sentence is much faster. It is obvious, when the canvas is forced to repaint, when form is moved around the screen.
One solution would be to cluster the characters with even fonts and render them at once. But it won't help too much, when the formatting is rich. In addition I need the characters to be the discrete entities, which could be rendered in any way. For example, there is no WinAPI to support text alignment taJustify or in block writing...
Another approach is to render on bitmap, or to use wisely ClipRect property of TCanvas (I haven't tried yet).
Anyway, when the same formatted text is displayed in TRichEdit, there is no time penalty by repaint operation. Another quick example are all major browsers, which has no problem to display tons of formated text... do they render each character like I do, but they do it more efficiently ??? I do not know.
So do you know some recipe to speeding up the application (formatted text rendering?).
Thanx for your ideas...
Sample code: (make TForm as big as possible, grab it with mouse and drag it down under screen. When you move it up, you will see "jumpy" movement)
procedure TForm1.FormPaint(Sender: TObject);
var i, w, h, j:integer;
s:string;
switch:Boolean;
begin
w:=0;
h:=0;
s:='';
for j:=0 to 5 do
for i:=65 to 90 do s:=s + Char(i);
switch:=False; // set true to see the difference
if switch then
begin
for j:=0 to 70 do begin
for i := 1 to Length(s) do
begin
Form1.Canvas.TextOut(50+ w,h +70 , s[i]);
w:=w + Form1.Canvas.TextWidth(s[i]);
end;
w:=0;
h:=h+15;
end;
end
else
begin
for j:=0 to 70 do begin
Form1.Canvas.TextOut(50+ w,h +70 , s);
w:=w + Form1.Canvas.TextWidth(s); // not optimalized just for comparison
w:=0; // not optimalized just for comparison
h:=h+15;
end;
end;
end;
Use a profiler, such as AQTime, to find where your code is actually spending its time. Chances are that it will not be TextOut() itself that is taking the most time. You are indexing through a String one character at a time, passing each character to TextOut() and TextWidth(). Neither of those methods accept Char parameters as input, they only take String input instead, so the RTL is spending effort allocating and freeing a lot of temporary Strings in memory, depending on how long your source String is. I've seen things like that kill loop performance.
To avoid flicker, have best performance and still have all advanced text rendering features (like kerning), the answer is using a temporary bitmap.
Drawing text is very fast in Windows, but displaying a pre-computed bitmap will be much faster.
You can divide your layout to render only the shown part of the text. Or try to split your text into "boxes" of text (just like the great TeX engine does), using a cache for the width of each box. But Windows itself does such caching, so only use such technique if you find a real bottleneck, via proper profiling of the whole code.
Do not reinvent the wheel. On real content, you will find out that text rendering is much more complex than imagined, e.g. if you mix languages and layouts (Arabic and English for instance). You should better rely on Windows, e.g. its UniScribe API, for such complex work. When we made our open source pdf engine, we re-used it as much as possible.
For instance, FireMonkey suffers from reinventing the wheel, and fails when rendering complex text content. So using existing APIs is IMHO the best path...
On my pc, it's about twice as fast when you render to a bitmap, and then draw that to the canvas. Well, the slow version becomes twice as fast. The fast version stays the same.
Another optimization that might work.
You can also pre-calculate character widths into an array, so you don't have to call canvas.TextWidth() often.
Keep a variable like this
widths:array[char] of byte;
Fill it like this:
for c := low(widths) to high(widths) do
widths[c] := Canvas.TextWidth(char(c));
Filling this 65536 element array is slow, so perhaps it's better to just create a 65..90 element-array, and drop unicode-support.
Another thing..
Calling Winapi.Windows.TextOut() is faster than canvas.TextOut().
You can actually win a lot with that.
Winapi.Windows.TextOut(bmp.Canvas.Handle, w, h, #s[i], 1);
Modified version of your code:
// set up of off-screen bitmap.. needs to be resized when the form resizes.
procedure TForm1.FormCreate(Sender: TObject);
begin
bmp := TBitmap.Create;
bmp.SetSize(width,height);
end;
This is
procedure TForm36.PaintIt2;
var h,i,j,w: Integer; s: string;
begin
w := 0; h := 0; s := '';
for j := 0 to 5 do
for i := 65 to 90 do
s := s + Char(i);
bmp.Canvas.Brush.Color := Color;
bmp.Canvas.FillRect(bmp.Canvas.ClipRect);
if Checkbox1.Checked then
begin
for j := 0 to 70 do
begin
for i := 1 to Length(s) do
begin
Winapi.Windows.TextOut(bmp.Canvas.Handle, w, h, #s[i], 1);
w := w + widths[s[i]];
end;
w := 0; h := h + 15;
end;
end
else
for j := 0 to 70 do
begin
bmp.Canvas.TextOut(w, h, s);
w := 0; h := h + 15;
end;
canvas.Draw(0,0,bmp);
end;
I timed the performance with this procedure:
procedure TForm1.Button2Click(Sender: TObject);
var i : Integer; const iterations=300;
begin
with TStopwatch.StartNew do
begin
for I := 1 to iterations do
PaintIt2;
Caption := IntToStr(Elapsed.Ticks div iterations);
end;
end;
Last note:
I've tried disabling cleartype/anti-aliasing, but strangely enough that makes rendering twice as slow! This is how I turned anti-aliasing off:
tagLOGFONT: TLogFont;
GetObject(
bmp.Canvas.Font.Handle,
SizeOf(TLogFont),
#tagLOGFONT);
tagLOGFONT.lfQuality := NONANTIALIASED_QUALITY;
bmp.Canvas.Font.Handle := CreateFontIndirect(tagLOGFONT);
I am running Lazarus v0.9.30 (32 bit compiler).
This question is an extension of a previous question of mine.
The previous question revolved around how to change the orientation of text in the TGridColumns objects that I loaded at runtime into a standard TStringGrid. The solution involved overriding the DrawCellText event of the string grid.
My question is this. When I attempt to load the TStringGrid what I find is that the text orientation remains the same but the column cell height changes back to the default height.
The code I use to load the grid is shown below.
procedure TTmMainForm.vLoadWorldScoutGrid;
var
aMember : TTmMember;
anIndex1: integer;
anIndex2: integer;
begin
//Clear the string grid and set the row count to 1 to take into account the fixed row.
SgWorldScout.Clear;
SgWorldScout.RowCount := 1;
for anIndex1 := 0 to Pred(FManager.Members.Count) do
begin
//Add a new row to the string grid.
SgMembers.RowCount := SgMembers.RowCount + 1;
//Get the TTmMember object from the collection.
aMember := TTmMember(FManager.Members.Items[anIndex1]);
//Populate the row cells in the string grid.
SgMembers.Cells[0, SgMembers.RowCount - 1] := aMember.stMemberNumber;
SgMembers.Cells[1, SgMembers.RowCount - 1] := aMember.stPatrol;
SgMembers.Cells[2, SgMembers.RowCount - 1] := aMember.stSurname;
SgMembers.Cells[3, SgMembers.RowCount - 1] := aMember.stFirstName;
//Add the TTmMember object to every row cell.
for anIndex2 := 0 to SgMembers.ColCount - 1 do
SgMembers.Objects[anIndex2, SgMembers.RowCount - 1] := aMember;
end; {for}}
vSetWorldScoutGridPushbuttons;
end;
I suspect that when I call 'SgWorldScout.Clear' that the properties of the string grid cells may get reset / modified as the default DrawCellText event gets called, which would explain the change in cell height. Not sure why the text orientation doesn't change either. Would someone be able to explain the behaviour of the DrawCellText event and why I am seeing this?
The Clear sets the RowCount and ColCount to 0 as you suspected. Then it's quite logical that the RowHeights is cleared too, because when you have RowCount set to 0 there are no heights to store. If you want to clear and add only the non fixed rows then simply set only the RowCount to 1 without clearing the whole grid. So modify your code this way:
procedure TTmMainForm.vLoadWorldScoutGrid;
var
aMember : TTmMember;
anIndex1: integer;
anIndex2: integer;
begin
// set the row count to 1 to keep the fixed row along with its settings
SgWorldScout.RowCount := 1;
for anIndex1 := 0 to Pred(FManager.Members.Count) do
...
end;