Link to home
Start Free TrialLog in
Avatar of k6__
k6__

asked on

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

Avatar of rwilson032697
rwilson032697

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.
Avatar of k6__

ASKER

I have Tried eg. Canvas.Brush.Color := clRed;
but nothing...

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.
Avatar of k6__

ASKER

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



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
Avatar of k6__

ASKER

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 ?
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;

Sure you need add some function to save correspondence between THeaderControl and ListView header.
Avatar of k6__

ASKER

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

Avatar of k6__

ASKER

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

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.
Avatar of k6__

ASKER

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;
}
//---------------------------------------------------------------------------

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.





ASKER CERTIFIED SOLUTION
Avatar of Slavak
Slavak

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of k6__

ASKER

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

Avatar of k6__

ASKER

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

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.