I have a form with a background image (painted on the form in Form1.Repaint).
What I am a looking for: A transparent image control, that can smoothly resize (resample) the loaded image.
(I need it to be transparent because the forms background image should be visible through)
What I've tried:
Standard TImage: It's transparent, but it does not resample.
Graphics32 / Image32: Resamples beautifully, but it's not transparent.
I have googled for several hours now for fixes or work-arounds, but without much of a solution. This has nothing to do with the image loaded into Image32 being transparent, but instead the background color of the control still being white (white = the color-property of the Image32 control, and setting it to clNone does not work). This is apparently as designed
GR32ex (The GR32 Extension Components Pack), which supposedly adds a Transparent-property, however it has not been updated in many years, and I can not install it. It throws a gazillion errors on Delphi 2010 and Graphics32 v. 1.9.
Can anybody think of a solution or workaround? All I want is a control with transparency and resampling.
Thanks!
I'm surprised that TImage32 doesn't do transparency. Are you really sure that is the case?
Anyway, if that is so, I would combine the transparency support of TImage with the re-sampling ability of TBitmap32 to build a solution that way. Keep the original image in a TBitmap32 instance. Whenever you need to load it into the TImage component, for example when re-sizing, use TBitmap32 to perform an in-memory re-size and load that re-sized image.
In fact, if you are already painting the form's background yourself, why not paint the image yourself and simply do away with the image control?
Update 1: Websearch reveals a simple way to make TImage32 transparent: http://graphics32.org/news/newsgroups.php?art_group=graphics32.general&article_id=9505
Update 2: The link above is now dead, and the newsgroups can only be accessed via NNTP. I can't be 100% certain, but I think that the linked post was by Michael Haralabos and contained the following file:
unit GR32_ImageEx;
// Transparent TImage32 by Michael Haralabos
interface
uses
Windows, Messages, Classes, GR32_Image, GR32;
type
TImage32Ex = class(TImage32)
private
FTransparent: Boolean;
procedure SetTransparent(const Value: Boolean);
public
procedure ExecClearBackgnd(Dest: TBitmap32; StageNum: Integer); override;
published
property Enabled;
property Transparent: Boolean read FTransparent write SetTransparent;
end;
procedure Register;
implementation
procedure TImage32Ex.ExecClearBackgnd(Dest: TBitmap32; StageNum: Integer);
var
P: TPoint;
SaveIndex: Integer;
begin
if FTransparent and Assigned(Parent) and
not (Assigned(Bitmap) and (BitmapAlign = baTile)) then
begin
SaveIndex := SaveDC(Dest.Handle);
GetViewportOrgEx(Dest.Handle, P);
SetViewportOrgEx(Dest.Handle, P.X - Left, P.Y - Top, nil);
IntersectClipRect(Dest.Handle, 0, 0, Parent.ClientWidth, Parent.ClientHeight);
Parent.Perform(WM_ERASEBKGND, Dest.Handle, 0);
Parent.Perform(WM_PAINT, Dest.Handle, 0);
RestoreDC(Dest.Handle, SaveIndex);
end
else
inherited;
end;
procedure TImage32Ex.SetTransparent(const Value: Boolean);
begin
if FTransparent <> Value then
begin
FTransparent := Value;
Invalidate;
end;
end;
procedure Register;
begin
RegisterComponents('Graphics32', [TImage32Ex]);
end;
end.
Another topic here suggests that this may be what the now dead link referred to: Delphi TImage32 - how to make the component invisible if no picture is loaded?
Related
I am trying to simple thing. But i couldn' t :(
I have an TImage, which name is overview.
I want to draw a rectangle which is on the overview but independent from overview. So i added a TImage front of the overview and drawed a rectangle. Rectangle works but i just can see the TImage or overview. I tried to giving a transparency to rectImg but rectImg completely disappear.
with rectImg.Canvas do
begin
Pen.Color:= clRed;
Rectangle(0, 0, rectImg.Width, rectImg.Height);
end;
I draw on a paint, what i want to make.
That rect can be resizable indepented from img.
Thanks in advice.
If I understand your question correctly, you effectively want to visually frame the image without drawing the frame on the original graphic itself, i.e. rectImg.Picture should not return a framed graphic. Two ways immediately come to mind:
a) Dump TImage and use TPaintBox, manually maintaining the core graphic and doing any stretching or whatever via method calls rather than property settings on the component.
b) Extend TImage to have an OnPaint event that gets raised after TImage has done its standard painting.
With respect to (b), you can do it either as an interposer class or a custom component. As an interposer class you could do this:
1) Re-declare TImage immediately above your form class:
type
TPaintEvent = procedure (Sender: TObject; Canvas: TCanvas) of object;
TImage = class(Vcl.ExtCtrls.TImage) //use class(ExtCtrls.TImage) if pre-XE2
strict private
FOnPaint: TPaintEvent;
protected
procedure Paint; override;
published
property OnPaint: TPaintEvent read FOnPaint write FOnPaint;
end;
TMyForm = class(TForm)
//...
2) Implement the Paint override as so (slightly fiddly as TImage redefines the Canvas property of the base class):
type
TGraphicControlAccess = class(TGraphicControl);
procedure TImage.Paint;
begin
inherited;
if Assigned(FOnPaint) then
FOnPaint(Self, TGraphicControlAccess(Self).Canvas);
end;
3) Declare a suitable event handler in the form class:
procedure rectImgPaint(Sender: TObject; Canvas: TCanvas);
4) Implement the handler like so - note you need to set Brush.Style to bsClear to not create a filled rectangle:
procedure TMyForm.rectImgPaint(Sender: TObject; Canvas: TCanvas);
begin
Canvas.Brush.Style := bsClear;
Canvas.Pen.Color := clRed;
Canvas.Rectangle(0, 0, rectImg.Width, rectImg.Height);
end;
5) Assign the event handler in the form's OnCreate event:
procedure TMyForm.ImagePaint.FormCreate(Sender: TObject);
begin
rectImg.OnPaint := rectImgPaint;
end;
I leave converting the interposer class to a custom component as an exercise for the reader...
Postscript
Two other thoughts now I think of them:
Oddly enough, FMX is actually nicer here because its TImage provides a OnPaint event as standard.
If it is literally just a frame you want, a codeless alternative would be to overlay the TImage with a TShape, setting the shape's Brush.Style property to bsClear as we did in the coding solution. In that situation, set the shape's Enabled property to False if you have any OnClick or OnMouseXXX handlers assigned to the image.
How to set Groupbox to transparent? I found this
Transparent,
But in my case, I put TImage and put a background image, then the Groupbox, I don't know how can I make the groupbox transparent, and show the image as a background.
I tried searching this on google, but can't find the answer, and as much as possible, i want to use VCL Application.
I think you'll need to take over painting the group box. Here's a simple example using an interposer class. Place this class in the same unit as your form, before your form is declared:
type
TGroupBox = class(StdCtrls.TGroupBox)
protected
procedure Paint; override;
end;
TForm1 = class(TForm)
GroupBox1: TGroupBox;
....
end;
....
procedure TGroupBox.Paint;
begin
Canvas.Draw(0, 0, SomeGraphicObjectContainingYourBackground);
inherited;
end;
The output looks like this:
You may want to customise the rest of the painting. Perhaps it's enough to draw the background inside the group box so that the caption and frame appear as normal. Specify different coordinates in the call to Canvas.Draw if you want that. If you need the background to cover the entire parent canvas then your call to Draw needs to pass -Left and -Top for the coordinates.
Or perhaps you want to take over the drawing of the frame. Do that by not calling the inherited Paint method and doing your own work.
To avoid flicker, you are actually best off moving this painting code into WM_ERASEBKGND. That makes things a little more complex, but not much. The code would look like this:
type
TGroupBox = class(StdCtrls.TGroupBox)
protected
procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
end;
procedure TGroupBox.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
Canvas.Handle := Message.DC;
try
Canvas.Draw(-Left, -Top, SomeGraphicObjectContainingYourBackground);
finally
Canvas.Handle := 0;
end;
Message.Result := 1;
end;
If you were going to do this properly, you'd want to make a proper component rather than hacking around with an interposer.
I can't adjust a TTrackBar thumb size to a higher size. See the image:
I got a small thumb on the left, and I can't make it bigger (but not the TrackBar itself).
Desired thumb size is shown on an image with a red area.
Maybe I can use WINAPI somehow?
C++ apps have bigger thumb often.
This is what I'm actually hopping for:
It would seem like this cannot be done with the standard trackbar control. Indeed, I cannot see any trackbar style or trackbar message related to this. There is only the TBM_SETTHUMBLENGTH, which you also can access from VCL's TTrackBar.ThumbLength, but this also affects the height of the background sunken rectangle.
A corollory is that I doubt the observation that "C++ apps have bigger thumb often".
Of course, you can always make your own trackbar-like control.
Or do you only want to shrink the sunken rectangle? Then just set ShowSelRange to False in the Object Inspector. But if themes are on, you still cannot make the thumb bigger than about 24.
If you are on an old version of Delphi with no TrackBar.ShowSelRange, you need to remove the window style TBS_ENABLESELRANGE manually. You can do this at any time using SetWindowLong, or you can do it in CreateParams of a subclassed trackbar control. The simplest way might be to use an 'interposer class':
type
TTrackBar = class(ComCtrls.TTrackBar)
protected
procedure CreateParams(var Params: TCreateParams); override;
end;
...
implementation
{ TTrackBar }
procedure TTrackBar.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := Params.Style and not TBS_ENABLESELRANGE;
end;
To get the appearance in the Notepad++ screenshot, you should also set TickMarks to tmBoth and TickStyle to tsNone.
This doesn't answer your question, though, which was about making the thumb larger. This will make the sunken rectangle smaller... From your screenshots, however, I would guess this is what you want.
Trackbar is one of the native controls that support custom draw. Basically, when themes are enabled, you can control various aspects of drawing the control, or you can tell the OS that you're overtaking drawing parts yourself. See more about custom draw here.
We don't have to overtake any drawing to play with the sizes of some parts a little bit. It is the VCL that draws the channel (the recessed tracking background), and the ticks. For ticks, there are already properties we can use. For the channel, we can deflate the rectangle a bit, and the VCL will take over from there. The thumb is drawn by the default window procedure, but it doesn't matter, the OS will draw the thumb to the modified rectangle.
The below example (for a horizontal trackbar) intercepts WM_NOTIFY notification sent to the form to carry out these modifications. This will only work if the trackbar is placed directly on the form. If this is not the case, you can derive a new control that descends from TTrackBar to handle CN_NOTIFY, or subclass the control, or its parent for WM_NOTIFY. All that matters is to handle the notification before the actual drawing is performed.
This is how the example looks:
type
TForm1 = class(TForm)
Button1: TButton;
TrackBar1: TTrackBar;
procedure FormCreate(Sender: TObject);
protected
procedure WMNotify(var Msg: TWMNotify); message WM_NOTIFY;
end;
...
uses
themes, commctrl, xpman;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
if ThemeServices.ThemesEnabled and
(TrackBar1.Orientation = trHorizontal) then begin
TrackBar1.TickMarks := tmBoth;
TrackBar1.TickStyle := tsNone;
TrackBar1.ThumbLength := 38;
end;
end;
procedure TForm1.WMNotify(var Msg: TWMNotify);
begin
if ThemeServices.ThemesEnabled and
(TrackBar1.Orientation = trHorizontal) then begin
if (Msg.IDCtrl = Longint(TrackBar1.Handle)) and
(Msg.NMHdr.code = NM_CUSTOMDRAW) and
(PNMCustomDraw(Msg.NMHdr).dwDrawStage = CDDS_ITEMPREPAINT) then begin
case PNMCustomDraw(Msg.NMHdr).dwItemSpec of
TBCD_THUMB: InflateRect(PNMCustomDraw(Msg.NMHdr).rc, -4, 0);
TBCD_CHANNEL:
with PNMCustomDraw(Msg.NMHdr).rc do begin
Top := Bottom div 2 + 2;
Bottom := Top + 5;
Inc(Left, 4);
Dec(Right, 4);
end;
end;
end;
end;
inherited;
end;
I've spended hours for this (simple) one and don't find a solution :/
I'm using D7 and the TImageList. The ImageList is assigned to a toolbar.
When I populate the ImageList at designtime, the icons (with partial transparency) are looking fine.
But I need to populate it at runtime, and when I do this the icons are looking pretty shitty - complete loose of the partial transparency.
I just tried to load the icons from a .res file - with the same result.
I've tried third party image lists also without success.
I have no clue what I could do :/
Thanks 2 all ;)
edit:
To be honest I dont know exactly whats going on. Alpha blending is the correkt term...
Here are 2 screenies:
Icon added at designtime:
(source: shs-it.de)
Icon added at runtime:
(source: shs-it.de)
Your comment that alpha blending is not supported just brought the solution:
I've edited the image in an editor and removed the "alpha blended" pixels - and now it looks fine.
But its still strange that the icons look other when added at runtime instead of designtime. If you (or somebody else ;) can explain it, I would be happy ;)
thanks for you support!
To support alpha transparency, you need to create the image list and populate it at runtime:
function AddIconFromResource(ImageList: TImageList; ResID: Integer): Integer;
var
Icon: TIcon;
begin
Icon := TIcon.Create;
try
Icon.LoadFromResourceID(HInstance, ResID);
Result := ImageList.AddIcon(Icon);
finally
Icon.Free;
end;
end;
function AddPngFromResource(ImageList: TImageList; ResID: Integer): Integer;
var
Png: TPngGraphic;
ResStream: TStream;
Bitmap: TBitmap;
begin
ResStream := nil;
Png := nil;
Bitmap := nil;
try
ResStream := TResourceStream.CreateFromID(HInstance, ResID, RT_RCDATA);
Png := TPNGGraphic.Create;
Png.LoadFromStream(ResStream);
FreeAndNil(ResStream);
Bitmap := TBitmap.Create;
Bitmap.Assign(Png);
FreeAndNil(Png);
Result := ImageList.Add(Bitmap, nil);
finally
Bitmap.Free;
ResStream.Free;
Png.Free;
end;
end;
// this could be e.g. in the form's or datamodule's OnCreate event
begin
// create the imagelist
ImageList := TImageList.Create(Self);
ImageList.Name := 'ImageList';
ImageList.DrawingStyle := dsTransparent;
ImageList.Handle := ImageList_Create(ImageList.Width, ImageList.Height, ILC_COLOR32 or ILC_MASK, 0, ImageList.AllocBy);
// populate the imagelist with png images from resources
AddPngFromResource(ImageList, ...);
// or icons
AddIconFromResource(ImageList, ...);
end;
I had the exact same problems a couple of years ago. It's a Delphi problem. I ended up putting the images in the list at design time, even though I really didn't want to. I also had to use a DevExpress image list to get the best results and to use 32 bit color images.
As Jeremy said this is indeed a Delphi limitation.
One work around I've used for images that I was putting onto buttons (PNGs with alpha transparency in my case) is to store the PNGs as resources, and at run time paint them onto a button sized bitmap filled with clBtnFace. The bitmap was then used as the control's glyph.
Delphi's built in support for icons with alpha masks is very limited, however there's an excellent icon library kicon which may help.
I have component (descendat of TPanel) where I implemented Transparency and BrushStyle (using TImage) properties.
All it's ok when I have one component of this type on the form. Bun when I pun on the form more components of this type only first visible component is painted. When form is moved and first component is under other window or outside desktop next component is painted.
unit TransparentPanel;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, stdctrls;
type
TTransparentPanel = class(TPanel)
private
FTransparent: Boolean;
FBrushStyle: TBrushStyle;
FImage: TImage;
procedure SetTransparent(const Value: Boolean);
procedure SetBrushStyle(const Value: TBrushStyle);
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Transparent: Boolean read FTransparent write SetTransparent default
True;
property BrushStyle: TBrushStyle read FBrushStyle write SetBrushStyle default
bsBDiagonal;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('TransparentPanel', [TTransparentPanel]);
end;
constructor TTransparentPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FTransparent := True;
FBrushStyle := bsBDiagonal;
FImage := TImage.Create(Self);
FImage.Align := alClient;
FImage.Parent := Self;
FImage.Transparent := FTransparent;
end;
procedure TTransparentPanel.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
if ((not (csDesigning in ComponentState)) and FTransparent) then
Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;
destructor TTransparentPanel.Destroy;
begin
if Assigned(FImage) then
FreeAndNil(FImage);
inherited Destroy;
end;
procedure TTransparentPanel.Paint;
var
XBitMap,
BitmapBrush: TBitmap;
XOldDC: HDC;
XRect: TRect;
ParentCanvas: TCanvas;
begin
{This panel will be transparent only in Run Time}
if (csDesigning in ComponentState) or (not FTransparent) or (FBrushStyle in [bsClear, bsSolid]) then
inherited Paint
else
begin
XRect := ClientRect;
XOldDC := Canvas.Handle;
XBitMap := TBitmap.Create;
BitmapBrush := TBitmap.Create;
try
XBitMap.Height := Height;
XBitMap.Width := Width;
Canvas.Handle := XBitMap.Canvas.Handle;
inherited Paint;
RedrawWindow(Parent.Handle, #XRect, 0,
RDW_ERASE or RDW_INVALIDATE or
RDW_NOCHILDREN or RDW_UPDATENOW);
BitmapBrush.Width := FImage.Width;
BitmapBrush.Height := FImage.Height;
BitmapBrush.Canvas.Brush.Color := clBlack;
BitmapBrush.Canvas.Brush.Style := FBrushStyle;
SetBkColor(BitmapBrush.Canvas.Handle, clWhite);
BitmapBrush.Canvas.FillRect(BitmapBrush.Canvas.ClipRect);
FImage.Canvas.Draw(0, 0, BitmapBrush);
finally
Canvas.Handle := XOldDC;
Canvas.BrushCopy(XRect, XBitMap, XRect, Color);
XBitMap.Free;
BitmapBrush.Free;
end;
end;
end;
procedure TTransparentPanel.SetBrushStyle(const Value: TBrushStyle);
begin
if (FBrushStyle <> Value) then
begin
FBrushStyle := Value;
Invalidate;
end
end;
procedure TTransparentPanel.SetTransparent(const Value: Boolean);
begin
if (FTransparent <> Value) then
begin
FTransparent := Value;
FImage.Transparent := Value;
Invalidate;
end;
end;
end.
What is wrong?
OK, a few tips:
Only one component is drawn, because during painting the client area of the control is invalidated again, so you create an infinite stream of WM_PAINT messages, and the second component never gets drawn. Until the first one is made invisible, as you describe. You can see this from the CPU load, having one of your components on a form uses 100% of one core on my system (Delphi 2007, component created at runtime).
You should try to remove the bitmap you draw into, and make use of the DoubleBuffered property instead.
What is FImage actually used for?
If you modify the create parameters depending on the value of the Transparent property, then you need to recreate the window handle when the property changes.
Maybe you can get rid of the component completely, and use a TPaintBox instead? It is transparent as long as you don't paint the background yourself. But I can't tell from your code what you actually want to achieve, so it's hard to say.
I think you want a control that can contain other controls — like TPanel can do — and a control that can display the contents of the window underneath it — like TImage can do when its Transparent property is set. It appears you are under the mistaken impression that if you put one control on top of another, you'll get the behavior of both combined. That's what's wrong.
First thing you should do is get rid of the TImage control. That's just making things more complicated than they need to be. When you need to draw a brush pattern on the panel, draw it directly onto the panel.
Next, realize that the ws_ex_Transparent window style controls whether siblings of the window are painted first. That says nothing about whether the parent of the window gets repainted. If the parent of your panel has the ws_ClipChildren style set, then it will not paint itself underneath where your panel supposedly is. It looks like it would help you if the parent of your panel control had the ws_ex_Composited style set, but as a component writer, you don't get control over your controls' parents.
TImage is able to appear transparent because it is not a windowed control. It has no window handle, so the OS rules about painting and clipping don't apply to it. From Windows' point of view, TImage doesn't exist at all. What we in the Delphi world perceive as the TImage painting itself is really the parent window deferring to a separate subroutine to paint a certain region of the parent window. Because of that, the TImage painting code can simply not paint over some of the parent's area.
If I were doing this, I'd ask myself whether the control with the brush pattern really needed to be a container control. Could I instead just use an ordinary TImage with a repeating brush pattern drawn on it? Other controls can still go on top of it, but they won't be considered children of the pattern control.
Try to look at the Graphics32 library : it's very good at drawing things and works great with Bitmaps and Transparency
If you want the panel to be transparent, all you need to do is override Paint and do nothing (or paint a transparent image, for example), and also catch the WM_ERASEBKGND message and do nothing here as well. This ensures the panel doesn't paint itself at all.
Make sure also to exclude the csOpaque flag from ControlStyle, so the parent knows it should paint itself underneath the panel.
The stuff you have in Paint is absolutely horrible, by the way (I mean the RedrawWindow thing). Get rid of it. And WS_EX_TRANSPARENT is meant for toplevel windows only, not for controls.