I want to copy as efficient as possible the bitmap area behind a TRectangle (in example with red border). This is the boundsrect from the red rectangle in the parent control.
I have this in my Delphi Firemonkey app:
Getting the whole parent surface to a temp parent TBitmap:
(Parent as TControl).PaintTo(FParentBitmap.Canvas,
RectF(0, 0, ParentWidth, ParentHeight));
and then later on to copy the rectangle I want:
bmp.CopyFromBitmap(FParentBitmap, BoundsRect, 0, 0);
Of course this is not efficient. I want to copy the rectangle in 1 pass or at least I don't want to paint the whole parent into a temp TBitmap.
Do you know an efficient way? Please tell.
I created a TFrostGlass component which has the complete source in it. You can see/download it over here: https://github.com/Spelt/Frost-Glass
The copy bitmap code is in: FrostGlass.pas
Unfortunately, PaintTo does not allow painting only part of the control. However, as #Rob Kennedy mentioned, you can control where on your target Bitmap the content ends up by modifying the offsets.
In addition, when calling BeginScene before the call to PaintTo, you can set the ClipRects parameter, which means that only this part of the Canvas will be updated. This is necessary if your target Bitmap is larger than BoundsRect, because otherwise you would also paint the area around it.
procedure PaintPartToBitmap(Control: TControl; SourceRect, TargetRect: TRect; Bitmap: TBitmap);
var ClipRects: TClipRects;
X, Y: Single;
begin
ClipRects := [TRectF.Create(TargetRect)];
if (Bitmap.Canvas.BeginScene(#ClipRects)) then
try
X := TargetRect.Left - SourceRect.Left;
Y := TargetRect.Top - SourceRect.Top;
Control.PaintTo(Bitmap.Canvas, RectF(X, Y, X + Control.Width, Y + Control.Height));
finally
Bitmap.Canvas.EndScene;
end;
end;
Related
I want to take a screenshot of my page and put the result into a bitmap, Because there is a scrollbar on the page, i have to take several screenshots, and i want to merge those bitmaps.
if have used this code to make a screenshot and save it: Take a screenshot of a particular area in Delphi 7
i used the code to merge them from this page http://www.delphigroups.info/2/8/309463.html
if i copied it directly it would result in the first image being used, and i white rectangle for the second. so i tried to change it a little bit, and now i'm getting both images in one file.
This is the code i use to concatenate the bitmaps:
function ConcatenateBitmaps(const MainBitmap: TBitmap; const BitmapToAdd:
TBitmap): TBitmap;
begin
Result := MainBitmap;
If BitmapToAdd.Width > MainBitmap.Width then
Result.Width := BitmapToAdd.Width;
Result.Height := MainBitmap.Height + MainBitmap.Height;
Result.Canvas.CopyRect(
Rect(0,MainBitmap.Height,BitmapToAdd.Width,BitmapToAdd.Height),
BitmapToAdd.Canvas,
Rect(0,0,BitmapToAdd.Width,BitmapToAdd.Height)
);
end;
The problem is that te second image is being flipped, vertical and horizontal;
What am i doing wrong here?
EDIT:
An example of the result, the first image is good, the second image is flipped:
as i see now, my description was wrong, it's horizontaly mirrored, and verticaly flipped
Cause and quickfix:
The problem is in this part:
Rect(0,MainBitmap.Height,BitmapToAdd.Width,BitmapToAdd.Height)
You make a rectangle of which the top is the total height of the resulting image, and the bottom is the height of the bitmap to add. So this rectangle is basically inverted (its bottom is above its top).
And it's likely deformed as well, since the height of this rectangle is not the height of the bitmap to add.
The quickfix would be:
Rect(0,Result.Height- BitmapToAdd.Height,BitmapToAdd.Width,Result.Height)
Other issues and confusion:
But I think the cause of your confusion is because you think that Result and MainBitmap are two different bitmaps, while actually they are both references to the same bitmap. The assignment you do in the beginning just copies the reference, not the actual TBitmap object.
In addition, you mix up 'height' and 'bottom'. TRect expects you to set top and bottom coordinates, not top and height. This, together with the previous issue, causes not only that the bitmap is upside down, but also that it will be stretched, and partially covering the previous images. The more images you add, the more clear that effect will be.
Personally I think it's way more efficient to modify the existing bitmap in this scenario, mainly because you would otherwise have to clean up your old bitmap all the time, plus that you have a function that magically creates bitmaps. You get the question of ownership of the bitmap objects, and with that, the risk of memory leaks, which is not good, especially when dealing with large bitmaps.
My suggested version:
So, I would just make it a procedure, where the first bitmap is modified by adding the second bitmap to it.
In the version below, I also used Canvas.ClipRect, which is for a bitmap essentially the bounding rectangle of the bitmap. And then I used OffsetRect to 'move' this rectangle(increasing its top Y and bottom Y).
By doing this in a separate variable, you can have a relatively clean version compared to the quick fix I presented above, because you can use the dimensions of MainBitmap before actually modifying it.
procedure AppendBitmap(const MainBitmap: TBitmap; const BitmapToAdd:
TBitmap);
var
TargetRect: TRect;
begin
// Widen the main bitmap if needed
if BitmapToAdd.Width > MainBitmap.Width then
MainBitmap.Width := BitmapToAdd.Width;
// Set TargetRect to the right size
TargetRect := BitmapToAdd.Canvas.ClipRect;
// And then to the right position
OffsetRect(TargetRect, 0, MainBitmap.Height);
// Make room for the bitmap to add
MainBitmap.Height := MainBitmap.Height + BitmapToAdd.Height;
// Draw it in the created space
MainBitmap.Canvas.CopyRect(
TargetRect,
BitmapToAdd.Canvas,
BitmapToAdd.Canvas.ClipRect
);
end;
And if you like, you can make a wrapper function with the signature of the original, that creates a copy of the main image and returns that. Note though, that MainBitmap and the result of this function are no longer the same bitmap, and you have to make sure to properly free both of them when you're done.
function ConcatenateBitmaps(const MainBitmap: TBitmap; const BitmapToAdd:
TBitmap): TBitmap;
begin
Result := TBitmap.Create;
Result.Assign(MainBitmap);
AppendBitmap(Result, BitmapToAdd);
end;
PS: I like questions like this from which I learn something. I never realized you could flip an image by flipping the rect passed to CopyRect. :D
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.
I use Delphi7, PageControl with owner-draw. I can't get so plain and nice look of tabs, as I see on not-owner-drawn PageControls. What's bad:
when using owner-draw, I can't draw on "entire" tab header area, small 1-2px frame around tab header is painted by OS.
1) Delphi not owner-draw, look is OK too (XPMan used):
2) Delphi owner-draw, you see not entire tab header can be colored (XPMan used):
I draw current tab with blue and others with white, here. Only example.
Code:
procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl;
TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
c: TCanvas;
begin
c:= (Control as TPageControl).Canvas;
if Active then
c.Brush.Color:= clBlue
else
c.Brush.Color:= clWhite;
c.FillRect(Rect);
end;
2b) Delphi owner-draw in real app (XPMan used):
Why do i need to use owner-draw? Simple. To draw X button on tab headers, to paint upper-line with custom color, to paint icons from imagelists.
I'm looking for a way to paint ENTIRE rect of tab headers, not decreased rect which is given to PageControl owner-draw events. I tried to increase the rect given by owner-draw events, but this doesn't help, OS repaints this thin 1-2px frame around tab headers anyway.
The tabs of an owner drawn native "tab control" (TPageControl in VCL, although its ascendant is appropriately named TCustomTabControl - it is anyone's guess why the creative naming..), is expected to be painted by its parent control while processing WM_DRAWITEM messages, as documented here.
The VCL takes the burden from the parent by mutating the message to a CN_DRAWITEM message and sending it to the control itself. In this process the VCL has no further intervention. It just calls the OnDrawTab message handler if it is assigned by user code, passing appropriate parameters.
So, it's not the VCL that draws the borders around tabs, but the OS itself. Also, evidently, it doesn't do this during processing of WM_DRAWITEM messages but later in the painting process. You can verify this by putting an empty WM_DRAWITEM handler on the parent of a page control. Result is, whatever we paint in the event handler, it will later get borders by the OS.
What we might try is to try to prevent what the OS draws take effect, we have the device context (as Canvas.Handle) after all. Unfortunately this route also is a dead end because the VCL, after the event handler returns, restores the device context's state.
The only way, then, we have is to completely abandon handling an OnDrawTab event, and acting upon CN_DRAWITEM message. Below sample code use an interposer class, but you can subclass the control any way you like. Make sure that OwnerDrawn is set.
type
TPageControl = class(comctrls.TPageControl)
protected
procedure CNDrawitem(var Message: TWMDrawItem); message CN_DRAWITEM;
end;
TForm1 = class(TForm)
..
..
procedure TPageControl.CNDrawitem(var Message: TWMDrawItem);
var
Color: TColor;
Rect: TRect;
Rgn: HRGN;
begin
Color := 0;
// draw in different colors so we see where we've drawn
case Message.DrawItemStruct.itemID of
0: Color := $D0C0BF;
1: Color := $D0C0DF;
2: Color := $D0C0FF;
end;
SetDCBrushColor(Message.DrawItemStruct.hDC, Color);
// we don't want to get clipped in the passed rectangle
SelectClipRgn(Message.DrawItemStruct.hDC, 0);
// magic numbers corresponding to where the OS draw the borders
Rect := Message.DrawItemStruct.rcItem;
if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then begin
Inc(Rect.Left, 2);
// Inc(Rect.Top, 1);
Dec(Rect.Right, 2);
Dec(Rect.Bottom, 3);
end else begin
Dec(Rect.Left, 2);
Dec(Rect.Top, 2);
Inc(Rect.Right, 2);
Inc(Rect.Bottom);
end;
FillRect(Message.DrawItemStruct.hDC, Rect,
GetStockObject(DC_BRUSH));
// just some indication for the active tab
SetROP2(Message.DrawItemStruct.hDC, R2_NOTXORPEN);
if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then
Ellipse(Message.DrawItemStruct.hDC, Rect.Left + 4, Rect.Top + 4,
Rect.Left + 12, Rect.Top + 12);
// we want to clip the DC so that the borders to be drawn are out of region
Rgn := CreateRectRgn(0, 0, 0, 0);
SelectClipRgn(Message.DrawItemStruct.hDC, Rgn);
DeleteObject(Rgn);
Message.Result := 1;
inherited;
end;
Here is how the above looks here:
From what I can tell, you are simply looking to have themed painting of your application. In Delphi 7, all you need to do to achieve that is to add an application manifest that specifies the use of comctl32 version 6. The simple way to do so is to add a TXPManifest component to one of your forms or data modules, or just to reference the XPMan unit in your project.
Since you want the system to paint your page control, you must not do any owner drawing.
I'm writing my Delphi TGraphicControl paint procedure.
I create a canvas and I stretchdraw it onto the graphic area. It works well.
Then I repeat this with another Stretchdraw onto the graphic area but it is drawn in the area of the first Stretchdraw and not onto the graphic area as I direct it.
Is there a way that can place both stretchdraws beside each other in the TGraphicControl's canvas?
TCanvas.StretchDraw paints a graphic onto a canvas in a given rectangular area. The rectangle should, but does not need to be, within the bounds of the canvas. The owner of the canvas determines those bounds. In your case, it sounds like the canvas owner is the TGraphicControl object.
If you want two graphics to be painted beside each other, then the TRect you use to draw the first graphic should represent a rectangle that is adjacent to the TRect you use for the second graphic. You haven't shown any code yet, so it's hard to tell what's going wrong.
If you use the same TRect variable for both calls to StretchDraw, then you need to make sure you modify the rectangle's position between the calls — change the Left property, for starters.
For example:
var
r: TRect;
begin
r := ClientRect;
// First rectangle takes up left half of control
r.Right := r.Right div 2;
Canvas.StretchDraw(r, graphic1);
// Shift the rectangle to the right half
r.Left := r.Right;
r.Right := ClientRect.Right;
Canvas.StretchDraw(r, graphic2);
end;