I'm trying to port some code from Delphi to Firemonkey (XE6).
I've run into a problem with a function which draws to a TCanvas supplied by the caller. The Canvas could be from a TPaintBox, a TPanel, a TForm or a TBitmap. The function reads the TCanvas.ClipRect property to avoid doing cpu-intensive drawing outside of it. (The cliprect represents invalidated areas of the TForm, TPaintBox etc.)
Unfortunately the TCanvas ClipRect property no longer seems to exist. Does anyone know how I can access the TCanvas.ClipRect in Firemonkey? I did notice that TPaintBox and TPanel now have a ClipRect property, so I could maybe use those, but the TForm and TBitmap don't.
Please note, I'm not trying to create or change a cliprect in a Canvas, I'm trying to read it.
You use the Scene property of TControl. It has a list of clip rects to be painted. Use GetUpdateRectsCount and GetUpdateRect to read them.
For example this code read out the rects that needs repainting:
lStr := '';
for i := 0 to MyControl.Scene.GetUpdateRectsCount-1 do
with MyControl.Scene.GetUpdateRect(i) do
lStr := lStr + Format('(%g,%g,%g,%g)', [Left,Top,Right,Bottom]);
The DoBeginScene has a parameter for the cliprects. But there doesn't seem to be a way to actually retrieve that value. In addition to that there might be additional clipping on the canvas.
In order to get the clip rects, you need the dc or cgcontext of the canvas. You could get it using RTTI. Here's an example for OSX:
function TCanvasCHelper.GetCGContext: CGContextRef;
var
Context: TRttiContext;
Field: TRttiField;
begin
// needs about 1ms
Field := Context.GetType(TCanvasQuartz).GetField('FContext'); // get private field using RTTI
Assert(Field <> nil);
Result := PPointer(Field.GetValue(Self).GetReferenceToRawData)^;
end;
Unfortunately using RTTI for this might not be as fast as required. I ended up with having to create a copy of the FMX.Canvas.* classes that expose the CGContext or DC. You'll need this anyway if you want to do more advanced things with the canvas that FMX does not implement.
When you have the CGContext or DC, you can use the functions of the OS like CGContextGetClipBoundingBox or GetClipBox to retrieve the cliprects if the canvas supports them.
Related
Using Delphi Tokyo 10.2, with Stylized Themes. I am trying to highlight components on the form, e.g., ComboBoxes, EditTexts, etc. For example, if a user entered invalid data, I would like to highlight the component.
In the past, we just colored components Red, and the color persisted through resizes/movement/repaints in general. Now with theming, we need to do a bit more to get the color to show and persist.
I have tried disabling each component's StyleElements [seFont, seClient, seBorder] properties to force show the color. This works but seems kludgy, particularly when there are many components being validated. Also, simply coloring a component red might not look right with some of the themes.
I have also tried simply drawing a red rectangle around the components using WinAPI SetRop2(..). E.g., here is some clever code, I tweaked to take a TWinControl and Draw a redbox around it; I can also remove the redbox using a similar call. This works:
…but doesn't persist through repaints, obviously. It seems like adding custom paint methods might be an overkill here. Unless, there is some better way?
Other things I have considered:
All of the components sit on panels, and I have considered using a protected hack to draw red rects on the panel's canvas around the components, but again, more custom paint routines…
I am also considering drawing TShapes dynamically as needed, but this strikes me as silly.
There must be others in the same situation, e.g., data entry validation that worked neatly in older versions of Delphi, but doesn't look so good when themed. What is the best approach when using themes? The SetRop2(..) approach seems to be the cleanest, but can someone suggest a simple way to make the color persist? I would welcome other ideas, too. Thank you.
EDIT
So maybe, just dynamically drawing TShapes around the invalid responses isn't so bad. They persist through repaints and don't descend from TWinControl, meaning they automatically show up behind the control they are highlighting.
This works quite well for me and I hope it's helpful to others.
// assuming owning control will be free'd properly and
// will in turn free HI_LITE Box.
//
// tantamount to adding an instance variable, TShape, to existing Control,
// since class helpers don't allow. And I don't want to descend
// new controls just to have a hiLiteBox Instance Variable.
procedure HiLiteMe(aControl : TWinControl; HILITE_FLAG : Boolean = TRUE; aColor : TColor = clRed);
const OFFSET = 4; // specify the offset of the border size of the box.
const BOX_NAME_PREFIX = 'HI_LITE_BOX_';
var
hiLiteBox : TShape; // reference created on stack, but object created on the heap,
uniqueBoxName : String; // so use the persistent aControl's owned component list to maintain the reference.
begin
uniqueBoxName := BOX_NAME_PREFIX + aControl.Name; // uniquename for each associated HiLiteBox.
HiLiteBox := aControl.FindComponent(uniqueBoxName) as TShape; // phishing for the HiLiteBox if it was previously created.
if NOT Assigned(hiLiteBox) then // create HiLiteBox and make persist outside this proc.
begin
if NOT HILITE_FLAG then exit; // don't create a box if we're just going to hide it anyway.
hiLiteBox := TShape.Create(aControl); // Create HiLiteBox, setting aControl as owner, quicker retrieval using aControl.findComponent
hiLiteBox.Parent := aControl.Parent; // Render the box on the control's parent, e.g., panel, form, etc.
hiLiteBox.Name := uniqueBoxName;
hiLiteBox.Pen.Color := aColor; // Color the Pen
hiLiteBox.Pen.Width := offset-1; // Make the Pen just slightly smaller than the offset.
hiLiteBox.Brush.Color := clWindow; // Choose a brush color, to fill the space between the pen and the Control
hiLiteBox.Left := aControl.Left - offset;
hiLiteBox.Width := aControl.Width + offset*2;
hiLiteBox.Top := aControl.Top - offset;
hiLiteBox.Height := aControl.Height + offset*2;
end;
hiLiteBox.Visible := HILITE_FLAG; // Show/Hide HiLite as appropriate.
end;
Called like this to HiLite with a red and blue box...
begin
HiLiteMe(checkListBox1, TRUE, clRed); // Draw a RedBox around the CheckListBox, e.g., Invalid.
HiLiteMe(bitBtn3, TRUE, clBlue); // Draw a Blue Box around the Button, e.g., Required.
end;
Called like this to remove HiLites…
begin
HiLiteMe(checkListBox1, FALSE); // Draw a RedBox around the CheckListBox, e.g., Invalid.
HiLiteMe(bitBtn3, FALSE); // Draw a Blue Box around the Button, e.g., Required.
end;
I suggest having a red TShape on only one side of the control (e.g. just the left or bottom) that you show or hide.
Hi i have the following code to add an image from a Timage that for now is populated from a blob. My issue is this code does not add the image to the paintbox but rather to the form.
var
RectangleCanvas, RectanglePicture: TRectF;
BlobStream: TStream;
begin
BlobStream := qrypunchsheetitemphoto.CreateBlobStream(qrypunchsheetitemphoto.FieldByName('Photo'),TBlobStreamMode.bmRead);
imgviewimage.Bitmap.LoadFromStream(BlobStream);
fdrawbox:= TMyPaintBox.Create(panel1);
fdrawbox.Canvas.BeginScene;
fdrawbox.BitmapStamp := imgviewimage.Bitmap;
fdrawbox.Height := imgviewimage.Bitmap.Height;
fdrawbox.Width := imgviewimage.Bitmap.Width;
RectangleCanvas := RectF(10, 10, imgviewimage.Bitmap.Width, imgviewimage.Bitmap.Height);
RectanglePicture := RectF(10, 10, imgviewimage.Bitmap.Width, imgviewimage.Bitmap.Height);
fdrawbox.Canvas.DrawBitmap(imgviewimage.Bitmap, RectangleCanvas , RectanglePicture, 1);
fdrawbox.Canvas.EndScene;
fdrawbox.BringToFront;
BlobStream.Free;
TabControl1.ActiveTab := tabViewImage;
end;
end;
The FMX Paintbox is different to older Delphi Paintboxes. Previously you could put a Paintbox anywhere on your form and start drawing. The results would be within the confines of the Paintbox where you placed it.
The FMX Paintbox isn't like that and I don't understand their reasoning. I've been told it has a something to do with cross-platform compatibility and how devices handle canvas operations.
You can verify canvas width for yourself easily enough.
If you have a form width of 640 pixels and place a 50 x 50 Paintbox in the middle you'd expect drawing to occur in the middle.
Check it yourself;
ShowMessage(FloatToStr(Paintbox1.Width)); // Result will be 50
Now check Paintbox1.Canvas.Width and you'll get a different result.
ShowMessage(IntToStr(Paintbox1.Canvas.Width)); // Result is 640
When you pass parameters to drawing functions you need to take this into account and offset accordingly. I have read something about parental clipping having some effect, but I've not seen it work.
Another potential solution is to use a TPanel and draw on it's canvas.
If you place a normal TImage component on a form or panel over other components >> it is invisible at runtime as long no picture is loaded. So other things under it are visible.
But TImage32 is painting a gray box by default.
How do I make the it invisible while leaving the setting: .Visible:=True; if no picture is loaded?
(I still need events working on the component, like OnClick...)
Yes, this is a duplicate question, BUT the solution-link from the previous topic is dead. :(
While I still have access to the newsgroup posts, I don't know how the topic ID relates to the topic title (which is all I have). However, based an a search in the newsgroup I found several places where TImage32Ex was mentioned. I guess that this component (which is not part of the core library) was part of the solution in some way.
So, while the extension pack where this component comes from is no longer maintained, let's dig deeper in what it did.
First, I must say that TImage32 will always paint (copy) the content of its buffer to the display. This means whatever graphic is behind this component will get overwritten by default.
The trick TImage32Ex does is to get the parents content and draws it into the buffer.
With adaptions the code looks like this
var
P: TPoint;
SaveIndex: Integer;
begin
SaveIndex := SaveDC(Buffer.Handle);
try
GetViewportOrgEx(Buffer.Handle, P);
SetViewportOrgEx(Buffer.Handle, P.X - Left, P.Y - Top, nil);
IntersectClipRect(Buffer.Handle, 0, 0, Parent.ClientWidth, Parent.ClientHeight);
Parent.Perform(WM_ERASEBKGND, Buffer.Handle, 0);
Parent.Perform(WM_PAINT, Buffer.Handle, 0);
finally
RestoreDC(Buffer.Handle, SaveIndex);
end;
end;
The above code draws (WM_PAINT) the parent's content onto the buffer.
For example if you want to make the TPaintBox32 instance called PaintBox32 to be transparent just add the following code to the 'PaintBuffer' handler:
procedure TForm3.PaintBox32PaintBuffer(Sender: TObject);
var
P: TPoint;
SaveIndex: Integer;
begin
SaveIndex := SaveDC(PaintBox32.Buffer.Handle);
try
GetViewportOrgEx(PaintBox32.Buffer.Handle, P);
SetViewportOrgEx(PaintBox32.Buffer.Handle, P.X - PaintBox32.Left, P.Y - PaintBox32.Top, nil);
IntersectClipRect(PaintBox32.Buffer.Handle, 0, 0, PaintBox32.Parent.ClientWidth, PaintBox32.Parent.ClientHeight);
PaintBox32.Parent.Perform(WM_ERASEBKGND, PaintBox32.Buffer.Handle, 0);
PaintBox32.Parent.Perform(WM_PAINT, PaintBox32.Buffer.Handle, 0);
finally
RestoreDC(PaintBox32.Buffer.Handle, SaveIndex);
end;
end;
Note: While this works basically, it might not capture the parent's sub controls properly. This is especially true for TWinControl descendants. While there are solutions around to cover this scenario as well, it's far more complicated to cover this in every detail (e.g. the blinking cursor of an underlying TEdit instance)
I use a timage to mask a progress bar and give it a shape.
What I do is load a png with parts that are transparent and then place it over my progress bar.
I think this should achieve your goal. Place a transparent png in your timage.
Cheers,
E.
My Application has several TSpeedButtons with which to choose a color and I want each choice to be shown by the color of the TSpeedButton.
I found this answer on Stackoverflow on how to change the color of a TButton. The second answer (change colors dynamically) appears to be the solution I am looking for. It reads as follows:
var r: TRectangle;
begin
// Find the background TRectangle style element for the button
r := (Button1.FindStyleResource('background') as TRectangle);
if Assigned(r) then
begin
r.Fill.Color := claBlue;
end;
end;
This does not work anymore (i use XE5, this is XE2?). It generates an exception at the r := ... statement with:
"illegal cast".
The FindStyleResource returns a FMXObject.
TRectangle is a TShape->TControl->TFMXObject.
I can cast to TControl but not to TShape. In case you wonder, Button1 is a TButton.
Does anyone know how I do change the color of a TSpeedButton?
As an aside: is there a way to determine which type of object exactly is beging returned? I couldn't find out in the debugger.
The answer to the question you linked to relates to vector styles, where the style constructed entirely from shapes etc (such as the TRectangle).
In newer versions of FireMonkey the 'system' styles (which mimic the OS look) and some other styles use bitmaps.
If you want to edit a bitmap style, you'll need to find the bitmap image in the style, edit it, and then redo/edit the button's style to use the new image. (If you're on mobile this will probably be hard enough that you shouldn't even try it).
Another route would be be to change to one of the bitmap styles supplied with Delphi. You will find them under the redist/styles/fmx folder of your Delphi installation.
As for the class of the object, and as per other comments, examine the ClassName property of the object returned.
But bear in mind that not every style will have an object called 'background'. Both the name of the object and it's class can easily vary between styles. You really ought to look at the style you want to pluck objects from to see what's there. (Note that the objects name ('background') will be in the StyleName property).
It would be much easier to use a TColorButton instead, which directly exposes the Color property. You can find it on the Colors page of the component palette. Here are two on a new FMX form in the IDE's form designer:
As far as "which type of object is being returned", you can use the debugger or a ShowMessage for the TFMXObject.ClassName of the return value:
var
Obj: TFmxObject;
begin
Obj := Button1.FindResource('background');
if Assigned(Obj) then
ShowMessage(Obj.ClassName);
end;
I'm working in a custom control which mix two windows controls (listview and treeview). In some point, I need to draw the image which uses windows 7 (with themes enabled) to identify the parent nodes, I'm using the DrawThemeBackground function with the TVP_GLYPH part and the GLPS_CLOSED state (I tried with all the parts and states related to the TREEVIEW class without luck), but the result image always is the old (+) or (-).
This image show the issue
I want to draw the Arrow image (inside of black circle) instead of the (+) sign (inside of orange circle).
This is the sample code which I use to draw the image.
uses
UxTheme;
procedure TForm40.Button1Click(Sender: TObject);
var
iPartId : integer;
iStateId: integer;
hTheme : THandle;
begin
hTheme := OpenThemeData(Handle, VSCLASS_TREEVIEW);
iPartId := TVP_GLYPH;
iStateId:= GLPS_CLOSED;
//iPartId := TVP_TREEITEM;
//iStateId:= TREIS_NORMAL;
if hTheme <> 0 then
try
//if (IsThemeBackgroundPartiallyTransparent(hTheme, iPartId, iStateId)) then
// DrawThemeParentBackground(Handle, PaintBox1.Canvas.Handle, nil);
DrawThemeBackground(hTheme, PaintBox1.Canvas.Handle, iPartId, iStateId, Rect(0, 0, 31, 31), nil);
finally
CloseThemeData(hTheme);
end;
end;
I check a couple of tools like the application made by Andreas Rejbrand and this too, but I can't find the image which I want.
My question is : how I can obtain the arrow image?
UPDATE
Thanks to the answer posted for Stigma I found additional resources to the values of the parts and states of the Explorer::Treeview class.
VisualStyleRenderer and themes
CodeProject
First of all, in the case of an ordinary ListView or TreeView, one can simply call SetWindowTheme on its handle to apply the proper sort of styling. The example from its MSDN page is as follows:
SetWindowTheme(hwndList, L"Explorer", NULL);
Since we are talking about a custom control, I am not so sure that applies here however. But since SetWindowTheme causes the WM_THEMECHANGED message to be sent to the proper window, it implies that you will just need to use the proper OpenThemeData call for the specific sub theme.
I think Luke's comment is correct. You probably just need to pass 'Explorer::Treeview' rather than the plain style. So, barring years of not having touched Delphi/Pascal:
hTheme := OpenThemeData(Handle, 'Explorer::Treeview');
You must set SetWindowTheme(Handle, 'explorer', nil); before painting to ensure that OpenThemeData will use new explorer style theme. Of course, window handle must be the same for both functions.