Delphi Pages Forums  

Go Back   Delphi Pages Forums > Delphi Forum > General

Lost Password?

Reply
 
Thread Tools Display Modes
  #1  
Old 08-04-2008, 12:10 PM
jtaylor jtaylor is offline
Member
 
Join Date: Mar 2005
Posts: 76
Default tlistview header color change

Hi,

I want to dynamically create a TlistView header and on only one column I want to change the back ground color.

I did see on example on here
http://www.delphipages.com/threads/thread.cfm?ID=196029&G=196023

But I really did not understand it, sorry. Is there a simple way to do this? I dont want the column of data color changed (I know how to do this) just the header

thanks
Reply With Quote
  #2  
Old 08-06-2008, 03:19 AM
jtaylor jtaylor is offline
Member
 
Join Date: Mar 2005
Posts: 76
Default RE: tlistview header color change - solution

Found the solution.

Make a component out of this code and use it instead of the Tlistview.

You can sete the FixedColor property for the background color of the header

You can also set a single column to have a different color, for example if you have m-f and you want the active day to be a different column.

You will have to have ParentFont=true and the column headers will inherit the font of the listview.

Bye

unit ListviewEx;

interface

Uses Windows, SysUtils, Messages, Classes, Controls, ComCtrls, Graphics;

Const
PM_CHANGEPROC = WM_USER + 1;
PM_HEADERMSG = WM_USER + 2;

Type
TListViewEx = class(TListView)
private
FFixedColor : TColor;
AFixedColor : TColor;
AColumnHdr : integer;
Header : HWND;
HeaderWndProc : Integer;
procedure ChangeHeaderWndProc(var Msg : TMessage); message PM_CHANGEPROC;
procedure HeaderMessage(var Msg : TMessage); message PM_HEADERMSG;
procedure CMRecreateWnd(var Message: TMessage); message CM_RECREATEWND;
procedure DrawButtons;
procedure SetFixedColor(const Value: TColor);
procedure SetActiveFixedColor(const Value: TColor);
procedure SetActiveColumnHdr(const Value: integer);
public
constructor Create(AOwner : TComponent); override;
procedure CreateHandle; override;
published
property FixedColor : TColor read FFixedColor Write SetFixedColor;
property ActiveFixedColor : TColor read AFixedColor Write SetActiveFixedColor;
property ActiveColumnHdr : integer read AColumnHdr Write SetActiveColumnHdr;
End;


procedure Register;

implementation

procedure Register;
Begin
RegisterComponents('TListViewEX', [TListViewEx]);
End;

{ TListViewEx }

function MyWndProc(Wnd: HWND; Msg, WParam, LParam: Longint): Longint; stdcall;
Var
ParentH : HWND;
M : TMessage;
Begin
ParentH := GetParent(Wnd);
If (ParentH = 0) or (ParentH = Wnd) Then Begin
Result := 1;
Exit;
End;

M.Msg := Msg;
M.WParam := WParam;
M.LParam := LParam;

Result := SendMessage(ParentH, PM_HEADERMSG, Integer(@M), 0);
end;

procedure TListViewEx.ChangeHeaderWndProc(var Msg: TMessage);
begin
CMRecreateWnd(Msg);
If (Parent <> nil) Then Begin
Header := FindWindowEx(Handle, 0, 'SysHeader32', nil);
If Header = 0 Then Exit;
HeaderWndProc := GetWindowLong(Header, GWL_WNDPROC);
SetWindowLong(Header, GWL_WNDPROC, Longint(@MyWndProc));
End;
end;

procedure TListViewEx.CMRecreateWnd(var Message: TMessage);
begin
If Header <> 0 Then Begin
If HeaderWndProc <> 0 Then
SetWindowLong(Header, GWL_WNDPROC, HeaderWndProc);
Header := 0;
HeaderWndProc := 0;
End;
end;

procedure TListViewEx.HeaderMessage(var Msg: TMessage);
Var
M : PMessage;
begin
M := PMessage(Msg.WParam);

Msg.Result := CallWindowProc(Pointer(HeaderWndProc), Header, M^.Msg, M^.WParam, M^.LParam);

If M^.Msg = WM_PAINT Then
DrawButtons;
end;

procedure TListViewEx.DrawButtons;
Var
DC : HDC;
Bounds : TRect;
Border1,
Border2 : Integer;
I, X : Integer;

Canvas : TCanvas;
Begin
If Header = 0 Then Exit;

Windows.GetClientRect(Header, Bounds);

Border1 := GetSystemMetrics(SM_CXBORDER);
Border2 := GetSystemMetrics(SM_CXFIXEDFRAME) - Border1;

DC := GetDC(Header); X := 0;

Canvas := TCanvas.Create;
Canvas.Handle := DC;


Canvas.Brush.Color := FFixedColor;
if ParentFont then
Canvas.Font := self.Font;

For I := 0 To Columns.Count - 1 Do Begin

if AColumnHdr > -1 then
begin
if (i = AColumnHdr) then
Canvas.Brush.Color := AFixedColor
else
Canvas.Brush.Color := FFixedColor;
end;
Canvas.FillRect(Rect(X + Border1, Border1,
X + Columns[I].Width - Border2,
Bounds.Bottom - Border2));

Canvas.TextOut(X + Border2, Border2, Columns[I].Caption);

X := X + Columns[I].Width;
End;
Canvas.FillRect(Rect(X + Border1, Border1, Bounds.Right, Bounds.Bottom - Border2));

Canvas.Free;
End;

procedure TListViewEx.SetActiveColumnHdr(const Value: integer);
begin
AColumnHdr := Value;
end;

procedure TListViewEx.SetActiveFixedColor(const Value: TColor);
begin
AFixedColor := Value;
end;


procedure TListViewEx.SetFixedColor(const Value: TColor);
begin
FFixedColor := Value;
DrawButtons;
end;

procedure TListViewEx.CreateHandle;
begin
inherited;

If Parent <> nil Then
PostMessage(Handle, PM_CHANGEPROC, 0, 0);
end;

constructor TListViewEx.Create(AOwner: TComponent);
begin
inherited;
Header := 0;
HeaderWndProc := 0;

ViewStyle := vsReport;
FixedColor := clBtnFace;

AColumnHdr := -1;
AFixedColor := clBtnFace;
end;


end.
Reply With Quote
Reply

Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is On

Forum Jump


All times are GMT. The time now is 11:24 AM.


Powered by vBulletin® Version 3.8.8
Copyright ©2000 - 2019, vBulletin Solutions, Inc.