Steema TeeChart Horizontal Bar Series. How to use Stacked100? - delphi

I wish to show a number of stacked values in a horizontal bar series. I can show the values stacked with their individual values OK, but I am unable to show them as mbStacked100 (so that the values take up 100% of the graph width) I have several values in the series, each with a corresponding color.
This code works to add the individual values, but I have not been able to successfully use mbStacked100 to show the series as a percentage rather than the individual values.
procedure TForm4.Button1Click(Sender: TObject);
var
Rnd : Integer;
i : Integer;
j : Integer;
MyColour : TColor;
HSeries : array of THorizBarSeries; {added here to clarify}
begin
{attempt to add a data set to the bar chart}
SetLength(HSeries, 0);
Chart1.RemoveAllSeries;
Chart1.LeftAxis.Items.Clear;
series1.StackGroup := 0;
Chart1.LeftAxis.Items.Clear;
Chart1.LeftAxis.Items.Count := 0;
Chart1.Pages.MaxPointsPerPage := 16;
SetLength(HSeries, 150);
for i := 0 to 150 do
begin
HSeries[i] := THorizBarSeries.Create(Chart1);
Hseries[i].MultiBar := mbNone;
// case RG1.ItemIndex of
// 0 : Hseries[i].MultiBar := mbNone;
// 1 : Hseries[i].MultiBar := mbStacked100;
// end;
HSeries[i].StackGroup := i;
HSeries[i].Marks.Visible := False;
HSeries[i].BarWidthPercent := 90;
MyColour := clGreen;
Rnd := Random(45);
Rnd := 45 + Rnd;
HSeries[i].AddX(Rnd, '', MyColour);
Hseries[i].MultiBar := mbSelfStack; {prepare for multi-stack}
Chart1.LeftAxis.Items.Add(i);
Chart1.LeftAxis.Items.Item[i].Text:= IntToStr(151-i)+' GT:'+IntToStr(Rnd);
{draw the yellow and red}
for j := 2 to 3 do
begin
if j = 2 then myColour := clYellow
else MyColour := clRed;
HSeries[i].AddX(j*2, '', MyColour);
end;
Chart1.AddSeries(HSeries[i]);
end; {for i}
end;
{________________________________________________________________________}
I have tried many ways to use mbStacked100 so that the image is shown as 100%, but none successfully.
The above code produces this:
Horizontal Stacked bars
I could not find any usable sample code including on the Steema web site and documentation.
Thanks for any assistance.

Related

How to create a Pentagonal Shaped Form on Delphi?

I´m trying to create a pentagonal shaped form in Delphi, but I can´t get the points drawed on the correct order, so the form keeps getting misshaped.
procedure TfrmPoligono.FormCreate(Sender: TObject);
var
_Region: hRgn;
_Tip,
_MostLeft,
_MostRight,
_BottomLeft,
_BottomRight: TPoint;
begin
// fRegionPoints: array[0..4] of TPoint declared on the private section
_Tip.X := 600;
_Tip.Y := 0;
_MostLeft.X := 100;
_MostLeft.Y := 0;
_MostRight.X := 1100;
_MostRight.Y := 300;
_BottomLeft.X := 200;
_BottomLeft.Y := 700;
_BottomRight.X := 1000;
_BottomRight.Y := 700;
fRegionPoints[0] := _Tip;
fRegionPoints[1] := _MostLeft;
fRegionPoints[2] := _MostRight;
fRegionPoints[3] := _BottomLeft;
fRegionPoints[4] := _BottomRight;
_Region := CreatePolygonRgn(fRegionPoints[0], Length(fRegionPoints), ALTERNATE);
SetWindowRgn(Handle, _Region, True);
end;
As you can see, I added the TPoints in the logical order that should be, top to bottom, left to rigth.
Bu I tryed other configurations without success.
What am I doing wrong?
When you specify a polygonal shape in a computer, you specify the vertices in the same order you would use to draw the polygon on paper using a pencil: either clockwise or anticlockwise. In your case, choosing the anticlockwise orientation,
fRegionPoints[0] := _Tip;
fRegionPoints[1] := _MostLeft;
fRegionPoints[2] := _BottomLeft;
fRegionPoints[3] := _BottomRight;
fRegionPoints[4] := _MostRight;

FASTREPORT Adding objects dynamically in report script

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;

Dynamically created buttons with equal alignment

I am a newbie to this Delphi. I have been given an assignment that to create buttons dynamically. But the problem is that all buttons have to be aligned in a manner that it should fit inside the whole screen. i.e, if 10 buttons created the whole screen should be filled. Or if 9 is given 9 should be present and filled in the screen. Is it possible to do that? I tried and searched everywhere. But was helpless.
Please help me if its possible. A good example is also appreciated since I mentioned earlier I am really new to this. The code I did follows here.
procedure TfrmMovieList.PnlMovieClick(Sender: TObject);
begin
for i := 0 to 9 do
begin
B := TButton.Create(Self);
B.Caption := Format('Button %d', [i]);
B.Parent := Panel1;
B.Height := 23;
B.Width := 100;
B.Left := 10;
B.Top := 10 + i * 25;
end;
end;
This looks workable to me:
procedure TForm1.CreateButtons(aButtonsCount, aColCount: Integer; aDestParent: TWinControl);
var
rowCount, row, col, itemWidth, itemHeight: Integer;
item: TButton;
begin
if aColCount>aButtonsCount then
aColCount := aButtonsCount;
rowCount := Ceil(aButtonsCount / aColCount);
itemHeight := aDestParent.Height div rowCount;
itemWidth := aDestParent.Width div aColCount;
for row := 0 to rowCount-1 do begin
for col := 0 to aColCount-1 do begin
item := TButton.Create(Self);
item.Caption := Format('Button %d', [(row*aColCount)+col+1]);
item.Left := itemWidth*col;
item.Top := itemHeight*row;
item.Width := itemWidth;
item.Height := itemHeight;
item.Parent := aDestParent;
Dec(aButtonsCount);
if aButtonsCount=0 then
Break;
end; // for cols
end; // for rows
end;
An example of usage is:
procedure TForm1.Button1Click(Sender: TObject);
begin
CreateButtons(10, 4, Panel1);
end;
The function Ceil requires the uses of unit Math.
The method receives the count of buttons and the numbers of columns to calculate the number of rows. It also receives the destination parent where the buttons will be located.

Animating the addition of a string to a ListBox in FireMonkey

The following code nicely animates adding a new string to the end of a ListBox
procedure TForm6.AddItem(s: string);
var
l : TListBoxItem;
OldHeight : Single;
begin
l := TListBoxItem.Create(Self);
l.Text := s;
OldHeight := l.Height;
l.Height := 0;
l.Parent := ListBox1;
l.Opacity := 0;
l.AnimateFloat('height', OldHeight, 0.5);
l.AnimateFloat('Opacity', 1, 0.5);
end;
The item expands and fades in. However I want to be able to add the string into an arbitrary location in the ListBox - actually at the current ItemIndex.
Does anyone know how to do this?
To work around the fact that ListBox1.InsertObject and ListBox1.Items.Insert don't work you can do the following
procedure TForm1.AddItem(s: string);
var
l : TListBoxItem;
OldHeight : Single;
I: Integer;
index : integer;
begin
l := TListBoxItem.Create(nil);
l.Text := s;
OldHeight := l.Height;
l.Height := 0;
l.Opacity := 0;
l.Index := 0;
l.Parent := ListBox1;
Index := Max(0, ListBox1.ItemIndex);
for I := ListBox1.Count - 1 downto Index + 1 do
begin
ListBox1.Exchange(ListBox1.ItemByIndex(i), ListBox1.ItemByIndex(i-1));
end;
ListBox1.ItemIndex := Index;
l.AnimateFloat('height', OldHeight, 0.5);
l.AnimateFloat('Opacity', 1, 0.5);
end;
but is a bit ridiculous. It (eventually) adds the string in position 0 if there is no item selected, otherwise adds it before the selected item. This solution reminds me too much of Bubble Sort. You will need to add the math unit to your uses clause for the max function to work.
This does indeed seem to be a bug in FireMonkey (check Quality Central #102122), However I suspect a future FireMonkey update will fix this. If anyone can see a better way of doing this....
I've also made a movie about this for those who are interested, which illustrates things more clearly.
This should work, but it does nothing:
l := TListBoxItem.Create(ListBox1);
ListBox1.InsertObject(Max(ListBox1.ItemIndex, 0), l);
If I then call the following, I get an access violation:
ListBox1.Realign;
In fact, even this gives me an AV:
ListBox1.Items.Insert(0, 'hello');
ListBox1.Realign;
But this adds one, of course:
ListBox1.Items.Add('hello');
A bug perhaps?
Instead of
l.Parent := ListBox1;
use
ListBox1.InsertObject(Index, l);
where Index is the insertion position.
(Untested but from reading the sources it should work).

how to read registry key for certain condition only?

i have create 5 dynamic buttons in 1 row and store the button info (caption, isActive, etc) in registry. It shows the button in form when the IsActive = TRUE from registry. The result is as below (each button indicate by a * symbol):
*****
When i set the IsActive = FALSE for button2 and button4, the button being remove and left the space as below:
* ** *
Any idea to solve this problem? The source code is as below:
procedure TfrmPOS.CreateDynamicBtn;
var
Reg : TRegIniFile;
lstKey : TStringList;
sKeyName : String;
bActive : boolean;
btn1 : TBitBtn;
i, k, iIcon : integer;
begin
lstKey := TStringList.Create;
Reg := TRegIniFile.Create;
try
//clear bitbtn
if ScrollBox2.ControlCount > 0 then begin
for k := ScrollBox2.ControlCount - 1 downto 0 do begin
with ScrollBox2.Controls[k] AS TBitBtn do begin
Free;
end;
end;
end;
sKeyName := Sysmem.RegKeyRoot+'\POSConfig\ItemSetting\';
Reg := TRegIniFile.Create(sKeyName);
Reg.GetKeyNames(lstKey); //button1, button2,...
for i := 0 to lstKey.Count - 1 do begin
Reg.OpenKeyReadOnly(sKeyName);
bActive := Reg.ReadBool(lstKey.Strings[i], 'IsActive', TRUE);
if bActive = TRUE then begin
//create dynamic bitbtn
btn1 := TBitBtn.Create(self);
btn1.Parent := ScrollBox2;
btn1.Height := 82;
btn1.Width := 82;
btn1.Left := ((i mod 5) * btn1.Width);
btn1.Top := (Trunc((i div 5)) * btn1.Height);
btn1.Caption := Reg.ReadString(lstKey.Strings[i], 'Caption', '');
iIcon := Reg.ReadInteger(lstKey.Strings[i], 'IconImage', 0);
imglstIcon.GetBitmap(iIcon, btn1.Glyph);
btn1.Layout := blGlyphTop;
btn1.Name := lstKey.Strings[i];
btn1.OnClick := OnButtonClick;
end;
Reg.CloseKey;
end;
finally
lstKey.Free;
Reg.Free;
end;
end;
I suspect you wonder why the space for the second button is still there, instead of the third button filling that area.
It's because you're setting the Left properties for the buttons as though all the buttons were there:
btn1.Left := ((i mod 5) * btn1.Width);
When i = 1, you skip over it because that button is invisible. But when i = 3, you calculate its position the same as you would have if button 2 had been visible. Keep a visible-button counter separate from your list iterator, and use it to position your buttons:
BtnIndex := 0;
Reg.OpenKeyReadOnly(sKeyName);
for i := 0 to lstKey.Count - 1 do begin
bActive := Reg.ReadBool(lstKey.Strings[i], 'IsActive', TRUE);
if bActive then begin
//create dynamic bitbtn
btn1 := TBitBtn.Create(self);
btn1.Parent := ScrollBox2;
btn1.SetBounds(BtnIndex mod 5 * 82, BtnIndex div 5 * 82, 82, 82);
Inc(BtnIndex);
There are better ways to do what you want. If you have a sufficiently recent version of Delphi, use a TFlowPanel or TGridPanel. They will arrange your buttons next to each other for you automatically. If your Delphi version didn't come with that control, then try a TToolBar instead and fill it with TToolButton controls.
Your question actually had nothing to do with the registry, but you can make better use of the registry anyway. There's no need to keep re-opening the same key every time. The value of sKeyName doesn't change inside the loop, so open the key once before you enter the loop (as shown above) and then just leave it open for as long as you need it.

Resources