HeaderControl с дополнительной возможностью отображения стрелок

Code:

////////////////////////////////////////////////////////////////////////////////

//

//  ****************************************************************************

//  * Unit Name : GSHeaderControl

//  * Purpose   : Обычный HeaderControl с дополнительной возможностью отображения стрелок

//  * Author    : Александр (Rouse_) Багель

//  * Version   : 1.00

//  ****************************************************************************

//

{©Drkb v.3}

unit GSHeaderControl;

interface

uses

Windows, Messages, SysUtils, Classes, Controls, ComCtrls, CommCtrl, Themes,

Graphics;

const

HDF_SORTDOWN = $0200;

HDF_SORTUP = $0400;

type

TGSSortDirection = (sdUp, sdDown);

TGSHeaderControl = class(THeaderControl)

private

   FSortSection: Integer;

   FSortDirection: TGSSortDirection;

   FUpDownBitmap: array [sdUp..sdDown] of TBitmap;

   procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;

   procedure SetSortDirection(const Value: TGSSortDirection);

   procedure SetSortSection(const Value: Integer);

public

   constructor Create(AOwner: TComponent); override;

   destructor Destroy; override;

   // Отрисовка стрелок через эти 2 свойства

   // Секция в которой будем рисовать стрелку (для отключения стрелок, SortedSection := -1)

   property SortedSection: Integer read FSortSection write SetSortSection;

   // Направление стрелки (вверх - вниз)

   property SortDirection: TGSSortDirection read FSortDirection write SetSortDirection;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('Samlpes', [TGSHeaderControl]);

end;

{ TGSHeaderControl }

constructor TGSHeaderControl.Create(AOwner: TComponent);

var

I: TGSSortDirection;

begin

inherited;

FSortSection := -1;

FSortDirection := sdDown;

for I := sdUp to sdDown do

begin

   FUpDownBitmap[I] := TBitmap.Create;

   FUpDownBitmap[I].Width := 14;

   FUpDownBitmap[I].Height := 14;

   FUpDownBitmap[I].Canvas.Brush.Color := clBtnFace;

   FUpDownBitmap[I].Canvas.Fillrect(Rect(0, 0, 14, 14));

   FUpDownBitmap[I].Canvas.Font.Size := 14;

   FUpDownBitmap[I].Canvas.Font.Name := 'Marlett';

end;

// Эти битматы для рисования стрелки при отключенных темах ХР

FUpDownBitmap[sdUp].Canvas.TextOut(0, -2, #53);

FUpDownBitmap[sdDown].Canvas.TextOut(0, -2, #54);

end;

destructor TGSHeaderControl.Destroy;

begin

FUpDownBitmap[sdUp].Free;

FUpDownBitmap[sdDown].Free;

inherited;

end;

// Указываем направление стрелки (вверх - вниз)

procedure TGSHeaderControl.SetSortDirection(const Value: TGSSortDirection);

begin

FSortDirection := Value;

SetSortSection(FSortSection);

end;

// Включаем стили для отрисовки стрелок

procedure TGSHeaderControl.SetSortSection(const Value: Integer);

var

Item: THDItem;

PreviosSelected: Integer;

Direction: Integer;

begin

PreviosSelected := FSortSection;

FSortSection := Value;

if Sections.Count = 0 then Exit;

if Value >= Sections.Count then Exit;

// При включенных темах будем рисовать вот так:

if ThemeServices.ThemesEnabled then

begin

   if FSortDirection = sdUp then

     Direction := HDF_SORTUP

   else

     Direction := HDF_SORTDOWN;

   Item.Mask := HDI_FORMAT;

   // Убираем предыдущую стрелку

   if Header_GetItem(Handle, PreviosSelected, Item) then

     if (Item.fmt and HDF_SORTUP) = HDF_SORTUP then

     begin

       Item.fmt := Item.fmt xor HDF_SORTUP;

       Header_SetItem(Handle, PreviosSelected, Item);

     end;

     if (Item.fmt and HDF_SORTDOWN) = HDF_SORTDOWN then

     begin

       Item.fmt := Item.fmt xor HDF_SORTDOWN;

       Header_SetItem(Handle, PreviosSelected, Item);

     end;

   // Рисуем новую

   Item.Mask := HDI_FORMAT;

   Header_GetItem(Handle, FSortSection, Item);

   Item.fmt := Item.fmt or Direction;

   Header_SetItem(Handle, FSortSection, Item);

end

else

begin // При выключенных темах, рисуем вот так:

   // Убираем предыдущую стрелку

   Item.Mask := HDI_FORMAT or HDI_BITMAP;

   Header_GetItem(Handle, PreviosSelected, Item);

   if (Item.fmt and HDF_BITMAP_ON_RIGHT) = HDF_BITMAP_ON_RIGHT then

     Item.fmt := Item.fmt xor HDF_BITMAP_ON_RIGHT;

   if (Item.fmt and HDF_BITMAP) = HDF_BITMAP then

     Item.fmt := Item.fmt xor HDF_BITMAP;

   Header_SetItem(Handle, PreviosSelected, Item);

   // Рисуем новую

   Item.Mask := HDI_FORMAT or HDI_BITMAP;

   Header_GetItem(Handle, FSortSection, Item);

   if (Item.fmt and HDF_BITMAP_ON_RIGHT) = HDF_BITMAP_ON_RIGHT then

     Item.fmt := Item.fmt xor HDF_BITMAP_ON_RIGHT;

   if (Item.fmt and HDF_BITMAP) = HDF_BITMAP then

     Item.fmt := Item.fmt xor HDF_BITMAP;

   Item.fmt := Item.fmt or HDF_BITMAP_ON_RIGHT or HDF_BITMAP;

   Item.hbm := FUpDownBitmap[FSortDirection].Handle;

   Header_SetItem(Handle, FSortSection, Item);

end;

end;

// Включаем обработчик OnSectionClick при стиле hsFlat

procedure TGSHeaderControl.WMLButtonDown(var Message: TWMLButtonDown);

var

Index: Integer;

Info: THDHitTestInfo;

begin

Info.Point.X := Message.Pos.X;

Info.Point.Y := Message.Pos.Y;

Index := SendMessage(Handle, HDM_HITTEST, 0, Integer(@Info));

if (Index < 0) or (Info.Flags and HHT_ONHEADER = 0) or

   Sections[Index].AllowClick then

begin

   inherited;

   if Style = hsFlat then

     if Index in [0 .. Sections.Count - 1] then

       Self.OnSectionClick(Self, Sections[Index]);

end;

end;

end.