how to set background image to TListview in Delphi XE? - delphi

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.

Related

Delphi 5 transparency breaks child draw

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".

Custom control with non-client area - doesn't calculate at first

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.)

How to reflect the changes after I resize the non-client area?

I want to make a custom control with a selectable border size. See the code below. The border is drawn in the non-client area and his width can be 0, 1 or 2 pixels. I've successfully done the border drawings in the WM_NCPAINT. The problem is that after I change the property that control the border size I don't know how to tell the system to recalculate the new dimensions of client and non-client areas. I've noticed that when I resize the window (with the mouse) the changes are applied, but I donn't know how to do that immediately after I change the border size.
SuperList.pas
unit SuperList;
interface
uses Windows, Controls, Graphics, Classes, Messages, SysUtils, StdCtrls, UxTheme;
type
TBorderType = (btNone, btSingle, btDouble);
TSuperList = class(TCustomControl)
private
HHig,HMidH,HMidL,HLow:TColor;
BCanvas: TCanvas;
FBorderSize: TBorderType;
procedure SetBorderSize(const Value:TBorderType);
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
protected
procedure Paint; override;
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner:TComponent); override;
published
property BorderType:TBorderType read FBorderSize write SetBorderSize default btDouble;
end;
implementation
constructor TSuperList.Create(AOwner:TComponent);
begin
inherited;
BCanvas:=TCanvas.Create;
FBorderSize:=btDouble;
HHig:=clWhite; HMidH:=clBtnFace; HMidL:=clGray; HLow:=cl3DDkShadow;
end;
procedure TSuperList.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := Params.Style or WS_VSCROLL or WS_HSCROLL;
end;
procedure TSuperList.SetBorderSize(const Value:TBorderType);
begin
if Value<>FBorderSize then begin
FBorderSize:=Value;
// .... ?????? I think here must be done something...
Perform(WM_NCPAINT,1,0); // repainting the non-client area (I do not know how can I invalidate the non-client area differently)
Invalidate; // repainting the client area
// I've tried even with the... RedrawWindow(Handle,nil,0,RDW_FRAME or RDW_INVALIDATE or RDW_UPDATENOW or RDW_INTERNALPAINT);
end;
end;
procedure TSuperList.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
Message.Result:=1;
end;
procedure TSuperList.WMSize(var Message: TWMSize);
begin
inherited;
Perform(WM_NCPAINT,1,0);
end;
procedure TSuperList.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
inherited;
if FBorderSize>btNone then
InflateRect(Message.CalcSize_Params^.rgrc0,-Integer(FBorderSize),-Integer(FBorderSize));
end;
procedure TSuperList.Paint;
begin
Canvas.Brush.Color:=clWhite;
Canvas.FillRect(ClientRect);
end;
procedure TSuperList.WMNCPaint(var Message: TWMNCPaint);
var DC: HDC;
R: TRect;
HS_Size,VS_Size:Integer;
HS_Vis,VS_Vis:Boolean;
begin
inherited;
Message.Result:=0;
if FBorderSize>btNone then
begin
DC:=GetWindowDC(Handle); if DC=0 then Exit;
BCanvas.Handle:=DC;
BCanvas.Pen.Color:=clNone;
BCanvas.Brush.Color:=clNone;
try
VS_Size:=GetSystemMetrics(SM_CXVSCROLL);
HS_Size:=GetSystemMetrics(SM_CYHSCROLL);
VS_Vis:=GetWindowLong(Handle,GWL_STYLE) and WS_VSCROLL <> 0;
HS_Vis:=GetWindowLong(Handle,GWL_STYLE) and WS_HSCROLL <> 0;
R:=ClientRect;
OffsetRect(R,Integer(FBorderSize),Integer(FBorderSize));
if VS_Vis and HS_Vis then begin
ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom+HS_Size);
ExcludeClipRect(DC, R.Left, R.Top, R.Right+VS_Size, R.Bottom);
BCanvas.Brush.Color:=HMidH;
R.Right:=Width-Integer(FBorderSize); R.Left:=R.Right-VS_Size;
R.Bottom:=Height-Integer(FBorderSize); R.Top:=R.Bottom-HS_Size;
BCanvas.FillRect(R);
end else begin
if VS_Vis then Inc(R.Right,VS_Size);
if HS_Vis then Inc(R.Bottom,HS_Size);
ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
end;
BCanvas.MoveTo(0,Height-1);
BCanvas.Pen.Color:=HMidL; BCanvas.LineTo(0,0); BCanvas.LineTo(Width-1,0);
if IsThemeActive then begin
BCanvas.Pen.Color:=HMidL;
BCanvas.LineTo(Width-1,Height-1);
BCanvas.LineTo(-1,Height-1);
end else begin
if FBorderSize=btDouble then begin
BCanvas.Pen.Color:=HHig;
BCanvas.LineTo(Width-1,Height-1);
BCanvas.LineTo(-1,Height-1);
end else begin
if VS_Vis then BCanvas.Pen.Color:=HHig else BCanvas.Pen.Color:=HMidL;
BCanvas.LineTo(Width-1,Height-1);
if HS_Vis then BCanvas.Pen.Color:=HHig else BCanvas.Pen.Color:=HMidL;
BCanvas.LineTo(-1,Height-1);
end;
end;
if FBorderSize=btDouble then begin
BCanvas.MoveTo(1,Height-2);
BCanvas.Pen.Color:=HLow; BCanvas.LineTo(1,1); BCanvas.LineTo(Width-2,1);
BCanvas.Pen.Color:=HMidH; BCanvas.LineTo(Width-2,Height-2); BCanvas.LineTo(0,Height-2);
end;
finally
ReleaseDC(Handle,DC);
end;
end;
end;
end.
Unit1.pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, SuperList, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
public
List: TSuperList;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
List:=TSuperList.Create(self);
List.Parent:=Form1;
List.Margins.Left:=20; List.Margins.Right:=20;
List.Margins.Top:=50; List.Margins.Bottom:=20;
List.AlignWithMargins:=true;
List.Align:=alClient;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
List.BorderType:=btNone;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
List.BorderType:=btSingle;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
List.BorderType:=btDouble;
end;
end.
Send a CM_BORDERCHANGED message:
Perform(CM_BORDERCHANGED, 0, 0);
This will fire the handler in TWinControl:
procedure TWinControl.CMBorderChanged(var Message: TMessage);
begin
inherited;
if HandleAllocated then
begin
SetWindowPos(Handle, 0, 0,0,0,0, SWP_NOACTIVATE or
SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE or SWP_FRAMECHANGED);
if Visible then
Invalidate;
end;
end;
And from the documentation on SetWindowPos:
SWP_FRAMECHANGED: Applies new frame styles set using the SetWindowLong function. Sends a WM_NCCALCSIZE message to the window, even if the window's size is not being changed. If this flag is not specified, WM_NCCALCSIZE is sent only when the window's size is being changed.

Highlight TPanel on mouse move

I'm trying to make app to show some information, It'll create Panels runtime and place info on it, each panel will be flat as on picture, also app will use runtime themes, so i'd not be able to change panel bg color on mouse move, I tried to place info on TSpeedButton :v O.o it has wonderfull highlight function when it's flat while app is using runtime theme, but the main problem is that images and labels aren't moving when i move speedbutton and i need this much, they just stay there..
I tried to edit TCustomPanel.Paint to see if panel will look like highlighted button, adding code at the end:
PaintRect := ClientRect;
Details := StyleServices.GetElementDetails(ttbButtonHot);
StyleServices.DrawElement(Canvas.Handle, Details, PaintRect);
but with no success..
also it's pretty hard to link some custom code OnClick event at runtime, e.g:
ShowMessage('custom message on each panel');
I have not got any idea on how to do this, hope some one will give me advice or show me some example..
btw, panel will be created this way:
var
P: TPanel;
begin
P := TPanel.Create(Self);
P.Left := 20;
P.Top := 100;
P.Width := 60;
P.Height := 20;
P.Visible := True;
P.Parent := Self;
#P.OnClick := #Showmessageproc; // somehow this way..
end;
App pic:
If i do so:
procedure TMyPanel.MouseMove(Shift: TShiftState; X, Y: Integer);
var
mEvnt: TTrackMouseEvent;
begin
inherited;
if not FMouseTracking then begin
mEvnt.cbSize := SizeOf(mEvnt);
mEvnt.dwFlags := TME_LEAVE;
mEvnt.hwndTrack := Handle;
TrackMouseEvent(mEvnt);
FMouseTracking := True;
showmessage('IN');
end;
end;
procedure TMyPanel.WMMouseLeave(var Msg: TMessage);
begin
if Msg.Msg = WM_MOUSELEAVE then showmessage('OUT');
Msg.Result := 0;
FMouseTracking := False;
if Assigned(FOnMouseLeave) then
FOnMouseLeave(Self);
end;
procedure G(Sender: TObject);
begin
showmessage('message');
end;
procedure TMainFrm.Button1Click(Sender: TObject);
var
P: TMyPanel;
begin
P := TMyPanel.Create(Self);
P.Left := 20;
I := I + 100;
P.Top := I;
P.Width := 200;
P.Height := 80;
P.Visible := True;
P.Parent := Self;
#P.OnClick := #g;
end;
when I move mouse on runtime created panel, 2 msgbox appears, IN and OUT, "mousemove" works fine but "mouse leave" bad, also the mainc question is still actual. the problem is that that I can't get canvas of created panel to draw on. the example above could be achieved more simple way:
#P.OnMouseLeave := #onmouseleaveproc;
#P.OnMouseMove := #onmousemoveproc;
but with Canvas, everything is more difficult, somewhere i've read that canvas is protected in TCustomPanel.
Also there's another question: Is it possible to handle panel wich called e.g OnMouseMove ? because there maybe will be 30 of them (runtime created panels)
I've tried this way: (and it does not works)
type
TMyPanel = class(TPanel)
public
constructor Create(AOwner: TComponent); override;
private
// FMouseTracking: Boolean;
// FOnMouseLeave: TNotifyEvent;
procedure CMMouseEnter(var msg: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
protected
// procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
published
// property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
end;
constructor TMyPanel.Create(AOwner: TComponent);
begin
ControlStyle := ControlStyle - [csParentBackground] + [csOpaque];
inherited;
end;
procedure TMyPanel.CMMouseEnter(var msg: TMessage);
begin
inherited;
Color := clBlue;
{ Do Whatever }
end;
procedure TMyPanel.CMMouseLeave(var msg: TMessage);
begin
inherited;
Color := clRed;
{ Do Whatever }
end;
Simply, color does not changes. (color changes with themes OFF)
It's basically explained here for Delphi 6, but same concept I think. You want to define a custom windows message handler for your panel. This will give you basic mouse enter/exit capability. You can then play with setting TPanel properties from there to find something to your liking. For example, to mock a speed button, you might be able to just set the background color and change the border bevel accordingly. If that isn't adequate, you can write to the TPanel's Canvas directly (paint the behavior that you want to see) on mouse enter/exit to get the visual behavior you're after.
I created the following new component in Delphi and installed it. A new TColorPanel component showed up in a new MyComponents tab in the IDE. I then used this to put a TColorPanel on a new app and it responded properly to the mouse enter/leave events, changing the color as desired. I'm not sure how you made your app's panels as TMyPanel instead of standard TPanel. This is just how I tried it. I used your latest message handling code as-is.
unit ColorPanel;
interface
uses
WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;
type
TColorPanel = class(TPanel)
public
constructor Create(AOwner: TComponent); override;
private
procedure CMMouseEnter(var msg: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
protected
// procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
published
// property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('MyComponents', [TColorPanel]);
end;
constructor TColorPanel.Create(AOwner: TComponent);
begin
ControlStyle := ControlStyle - [csParentBackground] + [csOpaque];
inherited;
end;
procedure TColorPanel.CMMouseEnter(var msg: TMessage);
begin
inherited;
Color := clBlue;
{ Do Whatever }
end;
procedure TColorPanel.CMMouseLeave(var msg: TMessage);
begin
inherited;
Color := clRed;
{ Do Whatever }
end;
end.
I'm not sure why yours isn't working, other than to determine how you declared your app's panels to be TMyPanel.

How to set background image for Edit (Delphi)

how can i have a image for Editbox background ?
This is very possible, indeed. In your form, define
private
{ Private declarations }
FBitmap: TBitmap;
FBrush: HBRUSH;
protected
procedure WndProc(var Message: TMessage); override;
and do
procedure TForm1.FormCreate(Sender: TObject);
begin
FBitmap := TBitmap.Create;
FBitmap.LoadFromFile('C:\Users\Andreas Rejbrand\Pictures\AS20Utv.bmp');
FBrush := 0;
FBrush := CreatePatternBrush(FBitmap.Handle);
end;
and
procedure TForm1.WndProc(var Message: TMessage);
begin
inherited;
case Message.Msg of
WM_CTLCOLOREDIT, WM_CTLCOLORSTATIC:
if (Message.LParam = Edit1.Handle) and (FBrush <> 0) then
begin
SetBkMode(Message.WParam, TRANSPARENT);
Message.Result := FBrush;
end;
end;
end;
Of course you can wrap this into a component of your own, say TEditEx. If I get time over, I might do this. (And, notice that there is no need to buy an expensive (and maybe not that high-quality) component pack from a third-party company.)

Resources