• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2170
  • Last Modified:

Change The Color Of Fixed Columns in a TLISTVIEW

i have a TListview and i want to change the color of the
fixed columns ... style = vsReport.
Source Code required...

ps: in the String Grid there is a property FixedColor to
    chenge Fixed columns Color...

0
k6__
Asked:
k6__
  • 8
  • 8
1 Solution
 
rwilson032697Commented:
I haven't tried this, but how about using the OnCustomDraw event and setting the Canvas.brush.color to the color you want. Or, draw the headers yourself...

Cheers,

Raymond.
0
 
k6__Author Commented:
I have Tried eg. Canvas.Brush.Color := clRed;
but nothing...

0
 
SlavakCommented:
Hi,

Try this code:

procedure TForm1.ListView1CustomDraw(Sender: TCustomListView;
  const ARect: TRect; var DefaultDraw: Boolean);
Var
 I : Integer;
 R : TRect;
begin
 With ListView1 Do Begin
  If ViewStyle <> vsReport Then Exit;

  R := ARect; I := 0;
  While (I <= Columns.Count) and (R.Left < ARect.Right) Do   Begin
   If I < Columns.Count
    Then R.Right := R.Left + Columns[I].Width
    Else R.Right := ARect.Right;

   If I mod 2 = 0
    Then Canvas.Brush.Color := clSilver
    Else Canvas.Brush.Color := clAqua;

   Canvas.FillRect(R);

   R.Left := R.Right;
   Inc(I);
  End;
 End;
 DefaultDraw := True;
end;

procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
 ListView1.Canvas.Brush.Color := clSilver;
 DefaultDraw := True;
end;

procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  var DefaultDraw: Boolean);
begin
 If SubItem mod 2 = 0
  Then ListView1.Canvas.Brush.Color := clSilver
  Else ListView1.Canvas.Brush.Color := clAqua;
 DefaultDraw := True;
end;

Regards.
0
Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
k6__Author Commented:
Noo .. =( i didn't ment the Columns Below the Fixed...
I ment the Fixed Columns! (The columns which they
are First.. and always in clSilver mode..)

eg

--------|--------|--------        <- Fixed
        |        |                <- Normal;
        |        |                <- Normal;
        |        |                <- Normal;

I want to chenge the color of Fixed One...
eg...
put a list view on a form.. double click on the list view
add columns ...eg 3 columns ... and set the style in
vsReport... you'll see 3 Silver Columns on the top of
List View =)



0
 
SlavakCommented:
I see 2 ways to do this:

1. Set ShowColumnHeaders of ListView control to False and use THeaderControl instead.

2. Get window handle of header of ListView control and paint a buttons.

I think first way is prefer, but it's your choice.

Regards
0
 
k6__Author Commented:
the funny in this whole story is that THeaderControl doesn't
have any property to change colors!! =)
anyway ... can you provide me a source example how to
paint the buttons if it's easy ?
0
 
SlavakCommented:
I think use of THeaderControl more simple.

It's true that THeaderControl doesn't have property to change color. But every section has property Style that you should change to hsOwnerDraw.

After that you should write code for OnDrawSection event of THeaderControl like this:

procedure TForm1.HeaderControl1DrawSection(HeaderControl: THeaderControl;
  Section: THeaderSection; const Rect: TRect; Pressed: Boolean);
Var
 BorderX, BorderY : Integer;
begin
 BorderY := GetSystemMetrics(SM_CYBORDER);
 BorderX := GetSystemMetrics(SM_CXFIXEDFRAME) + BorderY;

 With HeaderControl.Canvas Do Begin
  Brush.Color := clYellow;
  Brush.Style := bsSolid;
  FillRect(Rect);

  Font.Color := clBlack;
  TextOut(Rect.Left + BorderX, Rect.Top + BorderY, Section.Text);
 End;
end;

0
 
SlavakCommented:
Sure you need add some function to save correspondence between THeaderControl and ListView header.
0
 
k6__Author Commented:
nah...
put a header control and add your code...
make 3 sections...
run the programm...
as you see the 3 sections will be eg.. yellow but the 4th
section will not be yellow ...
Not to mention that headercontol doesn't do stuff that
Columns in TListview does like moving the Columns .. eg from
first to third etc...

Thanx for you post but i need to paint to a TListview...

0
 
k6__Author Commented:
nah...
put a header control and add your code...
make 3 sections...
run the programm...
as you see the 3 sections will be eg.. yellow but the 4th
section will not be yellow ...
Not to mention that headercontol doesn't do stuff that
Columns in TListview does like moving the Columns .. eg from
first to third etc...

Thanx for you post but i need to paint to a TListview...

0
 
SlavakCommented:
Hi,

Try code below. This component is like TListView, but has FixedColor property.

unit Unit2;

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;
  Header        : HWND;
  HeaderWndProc : Integer;
  procedure ChangeHeaderWndProc(var Msg : TMessage); message PM_CHANGEPROC;
  procedure HeaderMessage(var Msg : TMessage); message PM_HEADERMSG;
  procedure DrawButtons;
  procedure SetFixedColor(const Value: TColor);
 protected
  procedure SetParent(AParent: TWinControl); override;
 published
  property FixedColor : TColor read FFixedColor Write SetFixedColor;
 End;

implementation

{ TListViewEx }

function MyWndProc(Wnd: HWND; Msg, WParam, LParam: Longint): Longint; stdcall;
Var
 ParentH : HWND;
 M       : TMessage;
Begin
 ParentH := GetParent(Wnd);

 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
 If Parent <> nil Then Begin
  Header := FindWindowEx(Handle, 0, 'SysHeader32', nil);
  HeaderWndProc := GetWindowLong(Header, GWL_WNDPROC);
  SetWindowLong(Header, GWL_WNDPROC, Longint(@MyWndProc));
 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
 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;

 For I := 0 To Columns.Count - 1 Do Begin
  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.SetParent(AParent: TWinControl);
begin
 inherited;

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

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

Regards.
0
 
k6__Author Commented:
Ok ... but Worked one... all the other times it killed my
resource and delphi too ... with stack overflow messages
etc...

procedure TListViewEx.ChangeHeaderWndProc(var Msg: TMessage);
begin
 If Parent <> nil Then Begin
  Header := FindWindowEx(Handle, 0, 'SysHeader32', nil);
  HeaderWndProc := GetWindowLong(Header, GWL_WNDPROC);
->>>  SetWindowLong(Header, GWL_WNDPROC, Int64(@MyWndProc)); <<<-
{This is where the stack overflow comes from}
 End;
end;

it's buggy.. my whole desktop repaint to black etc...
any suggestions ?
please try to understand .. i'll give you the points ... but
i want a working one =-)...
i have found a sample from C++ Builder and i post it maybe
this will help you... i tried to convert it to delphi but
i got stack overflows as you and finally it became a Transparent TListView ...

Thanx for you help ... here the code i found:

//---------------------------------------------------------------------------
#include <vcl\vcl.h>
#pragma hdrstop

#include "LVHeader.h"
//---------------------------------------------------------------------------
#pragma resource "*.dfm"
TForm1 *Form1;
//---------------------------------------------------------------------------
__fastcall TForm1::TForm1(TComponent* Owner)
      : TForm(Owner)
{
      //Get the Header control's handle (KEY METHOD)
    HWND HeaderHandle = GetDlgItem(ListView1->Handle, 0);
    HD_ITEM hdi;

    for (int index = 0; index < ListView1->Columns->Count; index++)
    {
            //Specify that we're going to change the fmt member
        hdi.mask = HDI_FORMAT;

        //Flag owner draw state
        hdi.fmt = HDF_OWNERDRAW;

        //Force the changes
        Header_SetItem(HeaderHandle, index, &hdi);
    }

    //subclass the window procedure
    OldListViewWP = ListView1->WindowProc;
    ListView1->WindowProc = NewListViewWP;
}
//---------------------------------------------------------------------------
void __fastcall TForm1::NewListViewWP(TMessage &Msg)
{
      if (Msg.Msg == WM_DRAWITEM)
    {
        LPDRAWITEMSTRUCT lpdis = (DRAWITEMSTRUCT *)Msg.LParam;

        HDC HeaderHDC = lpdis->hDC;
        RECT Rect = lpdis->rcItem;
        int Index = lpdis->itemID;
        int State = lpdis->itemState;

            TFont *HeaderFont = new TFont();
            TBrush *HeaderBrush = new TBrush();
        HeaderFont->Style = HeaderFont->Style << fsBold;
        HeaderBrush->Color = clBlue;

        SelectObject(HeaderHDC, HeaderFont->Handle);

        ::FillRect(HeaderHDC, &Rect, HeaderBrush->Handle);
        ::SetTextColor(HeaderHDC, ColorToRGB(clYellow));
        ::SetBkMode(HeaderHDC, TRANSPARENT);

            int x_offset = 2;
        int y_offset = 1;
        int text_offset = 5;

        //Handle the depressed case by
        //offsetting the text and bitmap
        if (State & ODS_SELECTED)
        {
              x_offset = x_offset + 1;
            y_offset = y_offset + 1;
            text_offset = text_offset + 1;
        }

        //Lets draw Image1 only on the first columns header
        if (Index == 0)
        {
               BitBlt(HeaderHDC, Rect.left + x_offset,
                    Rect.top + y_offset,
                    Image1->Picture->Bitmap->Width,
                    Image1->Picture->Bitmap->Height,
                    Image1->Canvas->Handle, 0, 0, SRCCOPY);

             Rect.left = Rect.left + Image1->Picture->Bitmap->Width
                         + text_offset;
        }
        else Rect.left = Rect.left + text_offset;
        Rect.top = Rect.top + y_offset;

        AnsiString text = ListView1->Columns->Items[Index]->Caption;
        ::DrawText(HeaderHDC, text.c_str(), text.Length(), &Rect, DT_LEFT);

        delete HeaderFont;
        delete HeaderBrush;

              Msg.Result = true;
    }
      else OldListViewWP(Msg);
}


void __fastcall TForm1::FormClose(TObject *Sender, TCloseAction &Action)
{
      ListView1->WindowProc = OldListViewWP;
}
//---------------------------------------------------------------------------

0
 
SlavakCommented:
Hi,

You right.
My code have a problem if you make it as component and place in design time.

Now you can use it like this

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, unListViewEx, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    L : TListViewEx;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
 L := TListViewEx.Create(Self);
 L.Parent := Self;
 L.ViewStyle := vsReport;
 L.Left := 50;
 L.Top := 20;
 L.Columns.Add.Caption := 'Column1';
 L.Columns.Add.Caption := 'Column2';
 L.Columns.Add.Caption := 'Column3';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 L.FixedColor := Random($FFFFFF);
end;

end.

If I'll have more time I'll fix the code for design time usage.

Regards.





0
 
SlavakCommented:
Hi,

Try this version. I tried it at design time and real-time.

unit unListViewEx;

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;
  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);
 public
  constructor Create(AOwner : TComponent); override;
  procedure CreateHandle; override;
 published
  property FixedColor : TColor read FFixedColor Write SetFixedColor;
 End;


procedure Register;

implementation

procedure Register;
Begin
 RegisterComponents('Slava', [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;

 For I := 0 To Columns.Count - 1 Do Begin
  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.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;
end;

end.

Regards.
0
 
k6__Author Commented:
Excellent!! Why didn't you post this from the begging ? =)
It's Great ... still has some glintches.. but i think i can
fix them... Thanx !!! and sorry if i trouble you =)

0
 
k6__Author Commented:
btw. i would appriciate if you can help me with this:
when i (Auto)resize the columns it does screw up the header.
eg. when i double click on the Seperetor between headers to
autosize the header it will screw up the whole Header on the
list view... if you have any idea please post it .. thanx =)

0
 
SlavakCommented:
Hi,
 
Double click on separator overlap the columns like CoolBar.
Column.Width property still equal to normal column width.
I don't know now a way to retrieve an actual (window) width of overlapped columns.

With AutoSize I have no problem.

Just one tip: Use TextRect function instead of TextOut in DrawBtn function.
 
Regards.
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

  • 8
  • 8
Tackle projects and never again get stuck behind a technical roadblock.
Join Now