Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Change The Color Of Fixed Columns in a TLISTVIEW

Posted on 1999-06-27
17
Medium Priority
?
2,067 Views
Last Modified: 2012-05-04
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
Comment
Question by:k6__
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 8
  • 8
17 Comments
 
LVL 12

Expert Comment

by:rwilson032697
ID: 1384807
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
 
LVL 2

Author Comment

by:k6__
ID: 1384808
I have Tried eg. Canvas.Brush.Color := clRed;
but nothing...

0
 
LVL 3

Expert Comment

by:Slavak
ID: 1384809
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
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
LVL 2

Author Comment

by:k6__
ID: 1384810
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
 
LVL 3

Expert Comment

by:Slavak
ID: 1384811
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
 
LVL 2

Author Comment

by:k6__
ID: 1384812
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
 
LVL 3

Expert Comment

by:Slavak
ID: 1384813
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
 
LVL 3

Expert Comment

by:Slavak
ID: 1384814
Sure you need add some function to save correspondence between THeaderControl and ListView header.
0
 
LVL 2

Author Comment

by:k6__
ID: 1384815
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
 
LVL 2

Author Comment

by:k6__
ID: 1384816
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
 
LVL 3

Expert Comment

by:Slavak
ID: 1384817
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
 
LVL 2

Author Comment

by:k6__
ID: 1384818
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
 
LVL 3

Expert Comment

by:Slavak
ID: 1384819
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
 
LVL 3

Accepted Solution

by:
Slavak earned 400 total points
ID: 1384820
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
 
LVL 2

Author Comment

by:k6__
ID: 1384821
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
 
LVL 2

Author Comment

by:k6__
ID: 1384822
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
 
LVL 3

Expert Comment

by:Slavak
ID: 1384823
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: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

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.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
This tutorial will teach you the special effect of super speed similar to the fictional character Wally West aka "The Flash" After Shake : http://www.videocopilot.net/presets/after_shake/ All lightning effects with instructions : http://www.mediaf…
Have you created a query with information for a calendar? ... and then, abra-cadabra, the calendar is done?! I am going to show you how to make that happen. Visualize your data!  ... really see it To use the code to create a calendar from a q…
Suggested Courses

722 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question