Prevent series from using clWhite with Delphi TChart - delphi

I have a report that uses a TChart that I am maintaining. One of the TLineSeries that gets added automatically gets assigned the color clWhite, which is too close to the background (clBtnFace).
If I change it, then the next series that gets added takes clWhite. So short of going back and changing it after all the other series are created, is there some way to tell the TChart that I don't want any of my series to be clWhite?
When a series is added to the TChart the TChart assigns it a color. I want it to not assign clWhite.

OK not one to give up easily, I did some more searching. There is a unit variable called ColorPalette of type TColorArray in the TeeProcs unit. If I find and replace white with a different color that fixes it. There may be an instance copy of it. I'll keep looking since that would be preferred.
To revert the ColorPalette back just call the unit method SetDefaultColorPalette in the same unit.
SetDefaultColorPalette; // Make sure we start with the default
ColorPalette[4] := $007FFF; // Change White to Orange
try
// add series to the chart
finally
SetDefaultColorPalette; // Set it back to Default
end;
BTW, I can't accept as answer because I asked the question too, but I tested it and it works.

Near as I can tell from the TeeCharts module; no you can't specify a color that it should not be as it ships.
You can programatically walk through all the TLineSeries entries making sure at run-time that they don't use clWhite.
Say you have an array of acceptable colors clArray, you can use the following code to set the colors of each of the tLineSeries entries at run time.
procedure TForm1.setColors(aChart: TChart; aColorArray: array of TColor);
var
chi : Integer;
coi : Integer;
begin
coi := low(aColorArray);
for chi := 0 to aChart.SeriesList.Count - 1 do begin
aChart.SeriesList[chi].Color := aColorArray[coi];
inc(coi);
if coi > high(aColorArray) then
coi := low(aColorArray);
end;
end;
procedure TForm1.FormShow(Sender: TObject);
var
ca : array of TColor;
begin
setLength(ca, 3);
ca[0] := clRed;
ca[1] := clBlue;
ca[2] := clGreen;
setColors(Chart1, ca);
end;

You can use the series methods ClearPalette then AddPalette to create your custom palette.

Related

Dynamically assigning form size before maximize loses assigned values

I have an application which always starts initially maximized. This consists of putting Self.WindowState := wsMaximized; in the OnCreate of the main form.
Just before that, I'm assigning what should be the default dimensions of the main form, if the user were to change the window state to wsNormal.
So, in short, the main form's OnCreate handler looks something like:
procedure TfrmMain.FormCreate(Sender: TObject);
begin
Width:= 1300;
Height:= 800;
WindowState:= wsMaximized;
end;
Theoretically, I could assign these dimensions in design-time, and that does what I need. However, due to the size of my screen, and thus the IDE, the whole form is not visible at one glance without scrolling. In design, I keep the form size small, so I can see everything. But in runtime, I need to assign these default dimensions, and then maximize it by default. When the user changes the window state out of maximized, I expect it to go to those dimensions I dynamically assigned.
The issue is that it seems to lose those dimensions after maximizing the form, and it reverts back to whatever values were in design-time. If I comment out the line WindowState:= wsMaximized; then it shows the form in the desired default dimensions. However, maximizing it seems to overwrite and ignore these values I had just assigned before it.
How can I create and show my main form maximized by default, while at the same time dynamically assigning the default size, without my assigned values getting lost?
(Confirmed with 10.3.3.)
The exact origin of this problem I cannot pinpoint, but a reasonable cause would be that during the constructor the form component is being read and that previous sizes seem to be explicitly backed up:
procedure TControl.SetWidth(Value: Integer);
begin
SetBounds(FLeft, FTop, Value, FHeight);
Include(FScalingFlags, sfWidth);
if csReading in ComponentState then
FExplicitWidth := FWidth;
end;
A possible solution is to set the desired sizes in the OnCreate event, like you are doing now, but postpone setting the desired WindowsState until the OnShow event.
procedure TForm1.FormCreate(Sender: TObject);
begin
Width := 1300;
Height := 800;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
WindowState := wsMaximized;
end;
Of course, you probably should prevent consecutive calls by using a one-off mechanism.
Please take a look at wsMaximized forms do not appear maximized too.
Apparently, the VCL does not store the explicit intermediate size (in some Delphi versions anyway) but seems to merge the change with that of the maximization when the form is actually shown.
Like Sertac Akyuz quite correctly suggested, you can use SetWindowPlacement to bypass this VCL interference:
procedure TForm1.FormCreate(Sender: TObject);
var
WindowPlacement: TWindowPlacement;
begin
GetWindowPlacement(Handle, WindowPlacement);
WindowPlacement.rcNormalPosition := Bounds(Left, Top, 1300, 800);
WindowPlacement.showCmd := SW_SHOWMAXIMIZED;
SetWindowPlacement(Handle, WindowPlacement);
end;
You must set form size on FormActivate:
procedure TfrmMain.FormActivate(Sender: TObject);
begin
if Tag = 0 then
begin
// Top := 100;
// Left := 100;
Width:= 1300;
Height:= 800;
WindowState:= wsMaximized;
Tag := 1;
end;
end;

Custom drawing of TCustomListbox items

I'm rewriting a VCL component showing a customized TCustomListbox to Firemonkey in Delphi 10.2. The customization used an overridden DrawItem, basically adding some indentation and setting the text color depending on the item text and index.
DrawItem made it rather easy, but there seem to be nothing like that in FMX. I can override PaintChildren and draw every item myself, but then it looks differently and I have to deal with scrolling and everything myself. I'm just starting with FMX and don't have the sources yet.
Is there a DrawItem replacement in FMX? I may have missed it.
If not, how do it get the needed information? Basically, the rectangle to draw in and ideally the style used.
Problems
The solution by Hans works, but has some major problems:
Color
Setting the color doesn't work, the text is always black. I tried various possibilities including this one:
PROCEDURE TMyItem.Paint;
BEGIN
TextSettings.FontColor := TAlphaColorRec.Red;
INHERITED;
END;
Speed
Opening a box with 180 Items takes maybe two seconds. We need that many items and their count is actually the reason why we need a customized box (we provide filtering using the TEdit part of our component). A version using strings without TMyItem was faster (though probably slower than the VCL version), but using these items seems to slow it down even more (it's slower than filling an HTML list styled similarly).
Or something else? Having no sources and practically no documentation I can't tell.
I tried to cache the items for reuse, but this didn't help.
It looks like using custom items is actually faster than using strings, (timing in milliseconds):
nItems String TMyItem
200 672 12
2000 5604 267
20000 97322 18700
The speed problem seems to accumulate when the content changes multiple times. I was using FListBox.Items.Clear;, then I tried
n := FListBox.Items.Count;
FOR i := 0 TO n-1 DO FListBox.ListItems[n-1-i].Free;
and finally FListBox.Clear;, which makes most sense (and which I found last). Still, in the end it seems to need 2 ms per item.
Here is an example of how it can be done. The key is to set the Parent of the (custom) ListBoxItem to the ListBox. This will append it to its list of items. I set the parent in the constructor, so I don't have to do it (and remember it) each time I add something to a listbox.
type
tMyListBoxItem = class(TListBoxItem)
strict private
fTextLabel: TLabel;
public
constructor Create(aOwner: TComponent);
property TextLabel: TLabel read fTextLabel;
end;
implementation
constructor tMyListBoxItem.Create(aOwner: TComponent);
begin
inherited;
fTextLabel := TLabel.Create(self);
fTextLabel.Parent := self;
Assert(aOwner is TFMXObject, 'tMyListBoxItem.Create');
Parent := TFMXObject(aOwner);
end;
procedure tMyForm.FillListBox(aListBox: TListBox; aStringList: TStringList);
var
lItem: tMyListBoxItem;
i: integer;
begin
aListBox.BeginUpdate; //to avoid repainting for every item added
aListBox.Clear;
for i := 0 to aStringList.Count-1 do
begin
lItem := tMyListBoxItem.Create(aListBox);
lItem.TextLabel.Text := aStringList[i];
lItem.Margins.Left := 20;
end;
aListBox.EndUpdate;
end;
I use custom ListBoxItems in many places now because you can have ComboBoxes, EditBoxes, and all other controls in a ListboxItem. This opens for a very dynamic (list based) screen layout that easily adapts to all platforms and screen sizes.

(Delphi FMX) How do I use Canvas.FillText to show up in the middle of an Ellipse?

I want to show numbers in the middle of an Ellipse as text drawn on a canvas. The coordinates will be stored (for the ellipse) inside of a database, as well as the text value will be stored in another part of a database.
What I have done so far is I have been working w/ a demonstration project (DrawApp) from FMXExpress (Github) where I have changed a few procedures from being Private to Public. These procedures include StartDrawing(startP:TPointF), EndDrawing(startP:TPointF), DoDraw() that way I can use these functions from the external Unit/Object. The object uses these functions in coordination with MouseUp/MouseDown, as well as few properties including fDrawing to distinguish whether or not drawing is in progress, and just what tool is being used (fdEllipse).
My Main form uses the following code inside the FormCreate to initially create the fdrawbox := TMyPaintBox.Create(Rectangle1); The Rectangle1 sits on top of an image, which represents a grid to show a body part, and will be able to draw circles on top of the image. What I have found is that it is not hard to create either the text or the ellipse, but for the purpose of creating multiple circles with an identifier to distinguish circles, as I have mentioned, I want to have a number to show up which circle is which. And even in the future, I may want to change the colour to show which circle to concentrate on.
demonstration for mypaintbox http://www.abatepain.com/abate/OHlbF.jpg
So the following code (Delphi FMX) shows creating a drawapp by utilising a TRectangle as its parent.
with fdrawbox do begin
Parent := Rectangle1;
Visible := True;
ForegroundColor := TAlphaColor($FF000000); //
BackgroundColor := TAlphaColor($00000000); //
FuncDraw := TFunctionDraw.fdEllipse; //fdrawbox.fDrawing := True;
StartDrawing(PointF(100, 100));
EndDrawing(PointF(200, 200));
FuncDraw := TFunctionDraw.fdNone;
OnPaint := PaintBox1Paint;
end;
The circle is created using the last few lines, but in order to utilise FillText, I need to use a OnPaint Function, which I created and the code looks something like this. I believe that DrawApp handles OnPaint function internally, but just how it handles it is still unknown. But it is never the less a necessity in order to print "Hello Text!!"
procedure TMainForm.PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
begin
with Canvas do begin
BeginScene();
//Clear(cbbg.Color);
Font.Style := [];
Font.Size := 12;
Fill.Color := TAlphaColors.Red;
FillText(TRectF.Create(0, 0, 300, 295), 'Hello Text!!', false, 100, [], TTextAlign.Center, TTextAlign.Center); //TFillTextFlag.RightToLeft
EndScene;
end;
Application.ProcessMessages;
end;
Can someone give an example of how to handle this (possibly inside a single function) where I can print multiple circles and have the associated text follow with it? I believe with the previous example, I could do it on my own, but that I would have to manually enter the PointF (for the circle) and TRectF for the Text, and they both use different values as coordinates.
As you have noted, the TMyPaintBox class doesn't support text rendering, nor properties often used with text output like font or color etc. But you can add those yourself by defining fields in the private section and the properties to get/set the values in the public section.
In the following I assume addition of fields ftextout, ffontsize and ffontcolor with corresponding properties TextOut FontSize and FontColor.
To add functionality for rendering text in the similar way other element types are drawn, add fdText as a new enum to TFunctionDraw.
TFunctionDraw=(fdNone,fdPen,fdLine,fdRectangle,fdEllipse,fdFillBgr,fdBitmapStamp,fdPolyLine, fdText);
Then in TMyPaintBox.DoDraw add a new case option to case ffdraw of like for example:
with vCanvas do
begin
BeginScene();
case ffdraw of
//
// other TFunctionDraw enums
//
TFunctionDraw.fdText: begin
{Canvas.}Font.Size := ffonsize; // new field
{Canvas.}Fill.Color := ffontcolor; // new field
{Canvas.}FillText(r, TextOut, False, 1, [],
TTextAlign.Center, TTextAlign.Center);
end;
end;
Edit:
The references to Canvas in the TFunctionDraw.fdText are superfluous. Remove the outcommented references. The canvas to use is already defined in a with statement (added to the code to show). Oh, I hate those withs!
It is also worth to notice, that if you only want to display circles with text, and not let the user draw on the canvas, you could achieve it much simpler with a component of your own make.
Also, do not call DoDraw directly. It is called by Paint which is fired whenever the fdrawbox is invalidated. So, call invalidate instead when you want to force an update.
End of edit
Then you can achieve text rendering just as any other drawing of elements (using your code template):
with fdrawbox do begin
Parent := Rectangle1;
Visible := True;
ForegroundColor := TAlphaColor($FF000000); //
BackgroundColor := TAlphaColor($00000000); //
FuncDraw := TFunctionDraw.fdEllipse; //fdrawbox.fDrawing := True;
StartDrawing(PointF(100, 100));
EndDrawing(PointF(200, 200));
FuncDraw := TFunctionDraw.fdText;
FontSize := 12; // set new property
FontColor := TAlphaColorRec.Red; // set new property
TextOut := 'Hello text!';
StartDrawing(PointF(100, 100));
EndDrawing(PointF(200, 200));
FuncDraw := TFunctionDraw.fdNone;
invalidate;
// OnPaint := PaintBox1Paint; // no need for this
end;

Change gradient in ApplyStyleLookup

Im trying to change the gradient color of TSpeedbutton at runtime using ApplyStyleLookup, but for some reason only the top twothird of the button changes color. When I change it at design time I see three points for the gradient. I'm using the buttonstyle in the TSpeedbuttons StyleLookup. Using Delphi XE6 Rad Studio.
Thanks.
Added 8/29/14 I found the way to change the gradient see below. But my problem is on the buttonstyle have three rectangles and the one I need to access is the rectangle2 under background. What do I need to access it.
procedure TForm1.SpeedButton1ApplyStyleLookup(Sender: TObject);
var
BckObject: TFmxObject;
begin
BckObject := SpeedButton1.FindStyleResource('background');
if Assigned(BckObject) and (BckObject is TRectAngle) then
begin
TRectAngle(BckObject).Fill.Gradient.Style := TGradientStyle.Linear;
TRectAngle(BckObject).Fill.Gradient.Points.Points[0].Color := $FF0097A5;
TRectAngle(BckObject).Fill.Gradient.Points.Points[0].Offset := 0.25;
TRectAngle(BckObject).Fill.Gradient.Points.Points[1].Color := $FF0097F5;
TRectAngle(BckObject).Fill.Gradient.Points.Points[1].Offset := 1.00;
end;
end;
The rectangle2 (TRectAngle) under background has the StyleName property blank, by enter a name in the StyleName and save it I can access the rectangle2 by using the same method:
BckObject := SpeedButton1.FindStyleResource('myname');

How do I display opaque text on a translucent window?

Can you give me the names of the functions needed for this purpose? I'm using Delphi XE 5. I want to get this effect:
Window: half transparent
Font: fully visible.
I will use "System" font (zero problems with AA)
What do I look on MSDN? What functions (name) do I need to use?
This is basically the same idea as in Marcus' answer, but with some enhancements. You might have to adjust this to your needs, but the principle is the following:
Create form1 with the following properties:
AlphaBlend := True;
AlphaBlendValue := 128;
BorderStyle := bsNone;
Create form2 with the controls as desired and the following properties:
Color := clFuchsia; // or whatever color is not used
TransparentColor := true;
TransparentColorValue := Color;
Declare a Boolean field in form1 named AllowMove.
In TForm1.FormShow call the following code:
begin
form2.BorderStyle := bsNone;
form2.SetBounds(0, 0, ClientWidth, ClientHeight);
form2.Show;
AllowMove := true;
end;
Declare a Boolean field in form1 named AllowMove and a message handler for WM_MOVE:
procedure WMMOVE(var Message: TMessage); message WM_MOVE;
procedure TForm1.WMMOVE(var Message: TMessage);
begin
inherited;
if AllowMove then begin
Form2.Left := Message.LParamLo;
Form2.Top := Message.LParamHi;
end;
Message.Result := 0;
end;
The only way that I know to get that kind of effect is to render the window contents to an in-memory bitmap, then apply the desired alpha values to the non-font pixels, and then use UpdateLayeredWindow() to display the bitmap on a window. You cannot achieve that affect with a TForm as it relies on SetLayeredWindowAttributes() instead.
Create a 32bit bitmap and draw the desired background on it with alpha values, using a separate array to keep track of the current pixel values in the spots you are going to draw text on, then draw the actual text and use the array to detect which pixels were changed so you can clear the alpha values from just those pixels. Then display the bitmap.
You can get something close by layering two forms over each other. Set the bottom form's color to blue, enable AlphaBlend, and set AlphaBlend to something like 100. That just provides the blue background.
On second form, set TransparentColor to clBtnFace, and put your label there. Set the label font's quality to fqAntialiased.
Set both form's BorderStyle to bsNone.
Lay the second form over the first form, and there you go.
This might be workable if you don't plan on letting the user move the forms, or you move them together.

Resources