I have a control in Delphi 5 like this (following this post: https://tips.delphidabbler.com/tips/74.html):
type
TTransparentGroupbox = class(TGroupBox)
protected
procedure CreateParams(var params: TCreateParams); override;
procedure WMEraseBkGnd(var msg: TWMEraseBkGnd); message WM_ERASEBKGND;
end;
.....
procedure TTransparentGroupbox.CreateParams(var params: TCreateParams);
begin
inherited CreateParams(params);
params.ExStyle := params.ExStyle or WS_EX_TRANSPARENT;
end;
procedure TTransparentGroupbox.WMEraseBkGnd(var msg: TWMEraseBkGnd);
begin
SetBkMode(msg.DC, TRANSPARENT);
msg.result := 1;
end;
But I have trouble when it is redrawn. The portion not blurred should be listbox on such a TTransparentGroupbox, but it is not entirely redrawn, as if the background mode would have been propagated to the children but they are repainted on the TWinControl level. I have tried to set it back to OPAQUE at the only point I could override, but with no success:
procedure TTransparentGroupbox.PaintWindow(DC: HDC);
begin
SetBkMode(DC, OPAQUE);
inherited;
end;
The annoying part is, that I have other TTransparentGroupbox instances, with other TListBox instances that do not behave in this way.
The second problem I have is that whenever the visibility of a child control is changed to false, it is not "erased".
Related
I'm writing a custom control which is simply a container with a non-client area. Within that non-client area, there's one small area which is a button, and the rest of it is transparent. The drawing isn't an exact rectangle.
So far, I have it half-way working. The problem is that it doesn't calculate the non-client area up front, unless I make a minor tweak, such as re-sizing it.
I've followed many resources describing how to accomplish this. My implementation of handling WM_NCCALCSIZE is more or less identical to "working" examples I've found. But when the control is first created, it does not calculate this at all. When I drop a breakpoint inside the message handler of mine (WMNCCalcSize), based on the examples I've found, I'm supposed to first check Msg.CalcValidRects, and only do my calculation if it's True. But when debugging run-time, it's False, thus the calculation isn't done.
In design-time, if I re-size the control, THEN it decides to calculate properly. It's still not perfect (this code is still in the works), but it doesn't seem to set the non-client area until after I tweak it. Further, in run-time, if I tweak the size in the code, it still doesn't calculate.
The image on the top is when the form is initially created/shown. The second one is after I re-size it a little bit. Notice the test button, which is aligned alLeft. So initially, it consumes the area which is supposed to be non-client.
If I comment out the check if Msg.CalcValidRects then begin, then it calculates properly. But I see every example doing this check, and I'm pretty sure it's needed.
What am I doing wrong and how to make it calculate the non-client area at all times?
unit FloatBar;
interface
uses
System.Classes, System.SysUtils, System.Types,
Vcl.Controls, Vcl.Graphics, Vcl.Forms,
Winapi.Windows, Winapi.Messages;
type
TFloatBar = class(TCustomControl)
private
FCollapsed: Boolean;
FBtnHeight: Integer;
FBtnWidth: Integer;
procedure RepaintBorder;
procedure PaintBorder;
procedure SetCollapsed(const Value: Boolean);
function BtnRect: TRect;
procedure SetBtnHeight(const Value: Integer);
procedure SetBtnWidth(const Value: Integer);
function TransRect: TRect;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
procedure WMNCCalcSize(var Msg: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Repaint; override;
procedure Invalidate; override;
published
property BtnWidth: Integer read FBtnWidth write SetBtnWidth;
property BtnHeight: Integer read FBtnHeight write SetBtnHeight;
property Collapsed: Boolean read FCollapsed write SetCollapsed;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Float Bar', [TFloatBar]);
end;
{ TFloatBar }
constructor TFloatBar.Create(AOwner: TComponent);
begin
inherited;
ControlStyle:= [csAcceptsControls,
csCaptureMouse,
csDesignInteractive,
csClickEvents,
csReplicatable,
csNoStdEvents
];
Width:= 400;
Height:= 60;
FBtnWidth:= 50;
FBtnHeight:= 20;
FCollapsed:= False;
end;
procedure TFloatBar.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params.WindowClass do
Style := Style and not (CS_HREDRAW or CS_VREDRAW);
end;
destructor TFloatBar.Destroy;
begin
inherited;
end;
procedure TFloatBar.Invalidate;
begin
inherited;
RepaintBorder;
end;
procedure TFloatBar.Repaint;
begin
inherited Repaint;
RepaintBorder;
end;
procedure TFloatBar.RepaintBorder;
begin
if Visible and HandleAllocated then
Perform(WM_NCPAINT, 0, 0);
end;
procedure TFloatBar.SetBtnHeight(const Value: Integer);
begin
FBtnHeight := Value;
Invalidate;
end;
procedure TFloatBar.SetBtnWidth(const Value: Integer);
begin
FBtnWidth := Value;
Invalidate;
end;
procedure TFloatBar.SetCollapsed(const Value: Boolean);
begin
FCollapsed := Value;
Invalidate;
end;
procedure TFloatBar.WMNCPaint(var Message: TWMNCPaint);
begin
inherited;
PaintBorder;
end;
procedure TFloatBar.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
Message.Result := 1;
end;
procedure TFloatBar.WMNCCalcSize(var Msg: TWMNCCalcSize);
var
lpncsp: PNCCalcSizeParams;
begin
if Msg.CalcValidRects then begin //<------ HERE --------
lpncsp := Msg.CalcSize_Params;
if lpncsp = nil then Exit;
lpncsp.rgrc[0].Bottom:= lpncsp.rgrc[0].Bottom-FBtnHeight;
Msg.Result := 0;
end;
inherited;
end;
function TFloatBar.BtnRect: TRect;
begin
//Return a rect where the non-client collapse button is to be...
Result:= Rect(ClientWidth-FBtnWidth, ClientHeight, ClientWidth, ClientHeight+FBtnHeight);
end;
function TFloatBar.TransRect: TRect;
begin
//Return a rect where the non-client transparent area is to be...
Result:= Rect(0, ClientHeight, ClientWidth, ClientHeight+FBtnHeight);
end;
procedure TFloatBar.WMNCHitTest(var Message: TWMNCHitTest);
var
P: TPoint;
C: TCursor;
begin
C:= crDefault; //TODO: Find a way to change cursor elsewhere...
P:= Point(Message.XPos, Message.YPos);
if PtInRect(BtnRect, P) then begin
Message.Result:= HTCLIENT;
C:= crHandPoint;
end else
if PtInRect(TransRect, P) then
Message.Result:= HTTRANSPARENT
else
inherited;
Screen.Cursor:= C;
end;
procedure TFloatBar.Paint;
begin
inherited;
//Paint Background
Canvas.Brush.Style:= bsSolid;
Canvas.Pen.Style:= psClear;
Canvas.Brush.Color:= Color;
Canvas.FillRect(Canvas.ClipRect);
Canvas.Pen.Style:= psSolid;
Canvas.Pen.Width:= 3;
Canvas.Brush.Style:= bsClear;
Canvas.Pen.Color:= clBlue;
Canvas.MoveTo(0, 0);
Canvas.LineTo(ClientWidth, 0); //Top
Canvas.LineTo(ClientWidth, ClientHeight+FBtnHeight); //Right
Canvas.LineTo(ClientWidth-FBtnWidth, ClientHeight+FBtnHeight); //Bottom of Button
Canvas.LineTo(ClientWidth-FBtnWidth, ClientHeight); //Left of Button
Canvas.LineTo(0, ClientHeight); //Bottom
Canvas.LineTo(0, 0);
end;
procedure TFloatBar.PaintBorder;
begin
Canvas.Handle:= GetWindowDC(Handle);
try
//TODO: Paint "transparent" area by painting parent...
//Paint NC button background
Canvas.Brush.Style:= bsSolid;
Canvas.Pen.Style:= psClear;
Canvas.Brush.Color:= Color;
Canvas.Rectangle(ClientWidth-FBtnWidth, ClientHeight, ClientWidth, ClientHeight+FBtnHeight);
//Paint NC button border
Canvas.Pen.Style:= psSolid;
Canvas.Pen.Width:= 3;
Canvas.Brush.Style:= bsClear;
Canvas.Pen.Color:= clBlue;
Canvas.MoveTo(ClientWidth, ClientHeight);
Canvas.LineTo(ClientWidth, ClientHeight+FBtnHeight);
Canvas.LineTo(ClientWidth-FBtnWidth, ClientHeight+FBtnHeight);
Canvas.LineTo(ClientWidth-FBtnWidth, ClientHeight);
//Paint NC Button Chevron //TODO: Calculate chevron size/position
if FCollapsed then begin
Canvas.MoveTo(ClientWidth-30, ClientHeight+7);
Canvas.LineTo(ClientWidth-25, ClientHeight+13);
Canvas.LineTo(ClientWidth-20, ClientHeight+7);
end else begin
Canvas.MoveTo(ClientWidth-30, ClientHeight+13);
Canvas.LineTo(ClientWidth-25, ClientHeight+7);
Canvas.LineTo(ClientWidth-20, ClientHeight+13);
end;
finally
ReleaseDC(Handle, Canvas.Handle);
end;
end;
end.
... I'm supposed to first check Msg.CalcValidRects, and only do my
calculation if it's True.
You've got that wrong. The message has a somewhat complicated mechanism and the documentation might be slightly confusing trying to explain two distinct mode the message operates (wParam true or false). The part that relates to your case is the second paragraph of lParam:
If wParam is FALSE, lParam points to a RECT structure. On entry, the
structure contains the proposed window rectangle for the window. On
exit, the structure should contain the screen coordinates of the
corresponding window client area.
You'll find numerous usage examples of this simple form in the VCL where wParam is not checked at all, like in TToolWindow.WMNCCalcSize, TCustomCategoryPanel.WMNCCalcSize etc..
(Note that NCCALCSIZE_PARAMS.rgrc is not even a rectangle array when wParam is false, but since you're operating on the supposed first rectangle, you're fine.)
I have a simple form that only contains a TTouchKeyboard. The forms BorderStyle is set to bsToolWindow. To avoid the form getting focus when clicking the touch keyboard I handle the WM_MOUSEACTIVATE message with this implementation:
procedure TKeyboardForm.WMMouseActivate(var Message: TWMMouseActivate);
begin
Message.Result := MA_NOACTIVATE;
end;
The BorderStyle setting allows the form to be dragged with the title bar, but in that case the form still gets the focus. Is there a way to avoid this?
Update: I tried adding WS_EX_NOACTIVATE to ExStyle in CreateParams, but unfortunately that doesn't hinder the form to receive focus when dragged.
procedure TKeyboardForm.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.ExStyle := Params.ExStyle or WS_EX_NOACTIVATE;
end;
Because I was not very pleased with the approach that requires me to manually update the focused form variable in the keyboard form, I searched for a more transparent solution and came up with this approach.
Update: The previous approach had some issues with VCL styles. In addition not all of the message handlers were really necessary, though others turned out to be helpful, too. This version works well with VCL styles avoiding any flicker as far as possible:
type
TKeyboardForm = class(TForm)
TouchKeyboard1: TTouchKeyboard;
private
FLastFocusedForm: TCustomForm;
procedure SetLastFocusedForm(const Value: TCustomForm);
protected
procedure WMActivate(var Message: TWMActivate); message WM_ACTIVATE;
procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE;
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
property LastFocusedForm: TCustomForm read FLastFocusedForm write SetLastFocusedForm;
public
class constructor Create;
destructor Destroy; override;
function SetFocusedControl(Control: TWinControl): Boolean; override;
end;
type
TKeyboardFormStyleHook = class(TFormStyleHook)
protected
procedure WMNCActivate(var Message: TWMNCActivate); message WM_NCACTIVATE;
end;
procedure TKeyboardFormStyleHook.WMNCActivate(var Message: TWMNCActivate);
begin
{ avoids the title bar being drawn active for blink }
Message.Active := False;
inherited;
end;
class constructor TKeyboardForm.Create;
begin
TCustomStyleEngine.RegisterStyleHook(TKeyboardForm, TKeyboardFormStyleHook);
end;
destructor TKeyboardForm.Destroy;
begin
LastFocusedForm := nil;
inherited;
end;
procedure TKeyboardForm.Notification(AComponent: TComponent; Operation: TOperation);
begin
if (Operation = opRemove) and (AComponent = FLastFocusedForm) then begin
FLastFocusedForm := nil;
end;
inherited;
end;
function TKeyboardForm.SetFocusedControl(Control: TWinControl): Boolean;
begin
LastFocusedForm := Screen.FocusedForm;
result := inherited;
end;
procedure TKeyboardForm.SetLastFocusedForm(const Value: TCustomForm);
begin
if FLastFocusedForm <> Value then
begin
if FLastFocusedForm <> nil then begin
FLastFocusedForm.RemoveFreeNotification(Self);
end;
FLastFocusedForm := Value;
if FLastFocusedForm <> nil then begin
FLastFocusedForm.FreeNotification(Self);
end;
end;
end;
procedure TKeyboardForm.WMActivate(var Message: TWMActivate);
begin
Message.Active := WA_INACTIVE;
inherited;
end;
procedure TKeyboardForm.WMMouseActivate(var Message: TWMMouseActivate);
begin
inherited;
Message.Result := MA_NOACTIVATE;
end;
procedure TKeyboardForm.WMSetFocus(var Message: TWMSetFocus);
begin
inherited;
if (FLastFocusedForm <> nil) and (message.FocusedWnd <> FLastFocusedForm.Handle) then begin
SendMessage(FLastFocusedForm.Handle, WM_SETFOCUS, 0, 0);
Message.FocusedWnd := FLastFocusedForm.Handle;
end;
end;
The following combination of WMMouseActivate(), WMNCActivate() and reseting focus seems to fulfill your wishes:
The keyboard form (with BorderStyle = bsToolWindow) has message handlers for WM_MOUSEACTIVATE (as you already have) and WM_NCACTIVATE. The latter for having a point where to reset focus to the window with the edit control.
In addition the keyboardform will keep track of which form holds the edit (or other) control that has focus, and does that by introducing a new method for showing, which I called ShowUnfocused() and a field called FocusedForm: THandle.
procedure TKbdForm.ShowUnfocused(FocusedWindow: THandle);
begin
FocusedForm := FocusedWindow;
Show;
end;
procedure TKbdForm.FormShow(Sender: TObject);
begin
SetForegroundWindow(FocusedForm);
end;
procedure TKbdForm.WMMouseActivate(var Message: TWMMouseActivate);
begin
Message.Result := MA_NOACTIVATE;
end;
procedure TKbdForm.WMNCActivate(var Message: TWMNCActivate);
begin
Message.Result := 1; // important
SetForegroundWindow(FocusedForm);
end;
The keyboardform is invoked by the following common code of the edit controls:
procedure TForm17.EditClick(Sender: TObject);
begin
KbdForm.ShowUnfocused(self.Handle);
(Sender as TWinControl).SetFocus;
end;
An alternative to what is said above, could be to set the BorderStyle = bsNone and arrange the dragging of the form with the Mouse Down, Move, Up events directly from the forms surface (or maybe a panel to mimic a top frame), and adding a close button. The challenge would be to get it visually acceptable.
I am trying to do simple thing: Add a Canvas property on the TScrollBox descendant. I have read this article
but my ScrollBox descendant simply does not draw on the canvas. May anybody tell me, what is wrong?
TfrmScrollContainer = class (TScrollBox)
private
FCanvas: TCanvas;
FControlState:TControlState;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
protected
procedure Paint;
procedure PaintWindow(DC: HDC); override;
property Canvas: TCanvas read FCanvas;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
... this is exact copy, how TWincontrol turns to TCustomControl (but it fails somewhere)
constructor TfrmScrollContainer.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;
end;
destructor TfrmScrollContainer.Destroy;
begin
FCanvas.Free;
inherited Destroy;
end;
procedure TfrmScrollContainer.WMPaint(var Message: TWMPaint);
begin
Include(FControlState, csCustomPaint);
inherited;
Exclude(FControlState, csCustomPaint);
end;
procedure TfrmScrollContainer.PaintWindow(DC: HDC);
begin
FCanvas.Lock;
try
FCanvas.Handle := DC;
try
TControlCanvas(FCanvas).UpdateTextFlags;
Paint;
finally
FCanvas.Handle := 0;
end;
finally
FCanvas.Unlock;
end;
end;
procedure TfrmScrollContainer.Paint; // this is not executed (I do not see any ellipse)
begin
Canvas.Brush.Color:=clRed;
Canvas.Ellipse(ClientRect);
end;
Thanx
You are not including csCustomPaint to ControlState, you're including it to the similarly named field you declared. Your field is not checked, the ascendant control does not know anything about it. To solve, replace
procedure TfrmScrollContainer.WMPaint(var Message: TWMPaint);
begin
Include(FControlState, csCustomPaint);
inherited;
Exclude(FControlState, csCustomPaint);
end;
with
procedure TfrmScrollContainer.WMPaint(var Message: TWMPaint);
begin
ControlState := ControlState + [csCustomPaint];
inherited;
ControlState := ControlState - [csCustomPaint];
end;
Alternatively your scroll box may parent any control for your custom painting to work. The inherited WM_PAINT handler checks to see the control count and if it's not 0 it calls the paint handler instead of delivering the message to the default handler.
I was hoping for some help with regards to a transparent TMemo control in Delphi 7. I found some code online that works well, to an extent, the refresh rate is a bit rubbish but I can live with that. The main problem is that unselected text can look as if it's actually selected.
Here's where all the text is selected using SelectAll();
Here's where no text is actually selected, but has been previously, note the floating line suggesting typing will happen after the 'p' in Improvement.
And finally an image just showing the difference.
What I find quite odd is that if I hit an arrow key for example, the false highlighting disappears, but when using the mouse it does not.
The code for this custom TMemo is as follows:
unit TrMemo;
interface
uses
Messages, Controls, StdCtrls, classes;
const TMWM__SpecialInvalidate=WM_USER+1111;
type
TTransparentMemo = class(TMemo)
private
procedure SpecialInvalidate(var Message:TMessage); message TMWM__SpecialInvalidate;
procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
procedure WMSetText(var Message:TWMSetText); message WM_SETTEXT;
procedure CNCTLCOLOREDIT(var Message:TWMCTLCOLOREDIT); message CN_CTLCOLOREDIT;
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
protected
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); override;
end;
procedure Register;
implementation
uses Windows;
{ TTransparentMemo }
procedure TTransparentMemo.WMHScroll(var Message: TWMHScroll);
begin
inherited;
PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
end;
procedure TTransparentMemo.WMVScroll(var Message: TWMVScroll);
begin
SendMessage(Handle,TMWM__SpecialInvalidate,0,0);
inherited;
PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
end;
procedure TTransparentMemo.CNCTLCOLOREDIT(var Message:TWMCTLCOLOREDIT);
begin
with Message do
begin
SetBkMode(ChildDC,TRANSPARENT);
Result:=GetStockObject(HOLLOW_BRUSH)
end
end;
procedure TTransparentMemo.WMSetText(var Message:TWMSetText);
begin
inherited;
if not (csDesigning in ComponentState) then PostMessage(Handle,TMWM__SpecialInvalidate,0,0)
end;
procedure TTransparentMemo.SpecialInvalidate(var Message:TMessage);
var
r:TRect;
begin
if (Parent <> nil) then
begin
r:=ClientRect;
r.TopLeft:=Parent.ScreenToClient(ClientToScreen(r.TopLeft));
r.BottomRight:=Parent.ScreenToClient(ClientToScreen(r.BottomRight));
InvalidateRect(Parent.Handle,#r,true);
RedrawWindow(Handle,nil,0,RDW_FRAME+RDW_INVALIDATE);
end;
end;
procedure TTransparentMemo.WMKeyDown(var Message: TWMKeyDown);
begin
SendMessage(Handle,TMWM__SpecialInvalidate,0,0);
inherited;
PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
end;
procedure TTransparentMemo.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
Message.Result:=1
end;
constructor TTransparentMemo.Create(AOwner: TComponent);
begin
inherited;
ControlStyle:=[csCaptureMouse, csDesignInteractive, csClickEvents, csSetCaption, csOpaque, csDoubleClicks, csReplicatable, csNoStdEvents];
end;
procedure TTransparentMemo.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
ExStyle:=ExStyle or WS_EX_TRANSPARENT and not WS_EX_WINDOWEDGE
and not WS_EX_STATICEDGE and not WS_EX_DLGMODALFRAME and not
WS_EX_CLIENTEDGE;
end;
end;
procedure Register;
begin
RegisterComponents('Samples', [tTransparentMemo]);
end;
end.
Any tips/hints/answers would be greatly appreciated! Cheers in advance!
This isn't a complete fix, but you could, for example, do something like
protected
procedure Click; override;
procedure TTransparentMemo.Click;
begin
PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
inherited;
end;
And so on. Perhaps there's a better place to do this. Have a look in your VCL source (StdCtrls.pas) and you might find something in TCustomEdit or TCustomMemo which would be better options to override.
how i can to to set background image to TListview in Delphi XE??
i want to make a application like Windows Explorer.
In order to set a watermark in the listview you need to use the LVM_SETBKIMAGE message, and you need to override the TListView's default WM_ERASEBKGND message. The listview takes ownership of the bitmap handle, so you need to use TBitmap's ReleaseHandle, rather than just Handle.
If you want it aligned to the top-left, instead of the bottom right like Explorer, use LVBKIF_SOURCE_HBITMAP instead of LVBKIF_TYPE_WATERMARK for the ulFlags value.
uses
CommCtrl, ...;
type
TListView = class(ComCtrls.TListView)
protected
procedure WndProc(var Message: TMessage);
override;
end;
TForm4 = class(TForm)
ListView1: TListView;
procedure FormCreate(Sender: TObject);
end;
procedure TListView.WndProc(var Message: TMessage);
begin
if Message.Msg = WM_ERASEBKGND then
DefaultHandler(Message)
else
inherited WndProc(Message);
end;
procedure TForm4.FormCreate(Sender: TObject);
var
Img: TImage;
BkImg: TLVBKImage;
begin
FillChar(BkImg, SizeOf(BkImg), 0);
BkImg.ulFlags := LVBKIF_TYPE_WATERMARK;
// Load image and take ownership of the bitmap handle
Img := TImage.Create(nil);
try
Img.Picture.LoadFromFile('C:\Watermark.bmp');
BkImg.hbm := Img.Picture.Bitmap.ReleaseHandle;
finally
Img.Free;
end;
// Set the watermark
SendMessage(ListView1.Handle, LVM_SETBKIMAGE, 0, LPARAM(#BkImg));
end;
Stretched Watermark
The listview doesn't natively support stretching a bitmap across the entire background. To do so you need to do a StretchBlt in response to WM_ERASEBKGND yourself.
type
TMyListView = class(TListView)
protected
procedure CreateHandle; override;
procedure CreateParams(var Params: TCreateParams); override;
procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
public
Watermark: TBitmap;
end;
procedure TMyListView.CreateHandle;
begin
inherited;
// Set text background color to transparent
SendMessage(Handle, LVM_SETTEXTBKCOLOR, 0, CLR_NONE);
end;
procedure TMyListView.CreateParams(var Params: TCreateParams);
begin
inherited;
// Invalidate every time the listview is resized
Params.Style := Params.Style or CS_HREDRAW or CS_VREDRAW;
end;
procedure TMyListView.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
StretchBlt(Msg.DC, 0, 0, Width, Height, Watermark.Canvas.Handle,
0, 0, Watermark.Width, Watermark.Height, SrcCopy);
Msg.Result := 1;
end;
a Tlistview is nice but if you want more. i suggess you have to update with VirtualStringTree(VirtualTreeView) very flexible you can customize it almost anything you want and most of all its free.