Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
Разработка программного обеспечения
KANSoftWare

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

Delphi , Компоненты и Классы , Компоненты

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

Code:

////////////////////////////////////////////////////////////////////////////////
//
//  ****************************************************************************
//  * Unit Name : GSHeaderControl
//  * Purpose   : Обычный HeaderControl с дополнительной возможностью отображения стрелок
//  * Author    : Александр (Rouse_) Багель
//  * Version   : 1.00
//  ****************************************************************************
//
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.
Взято из http://forum.sources.ru

Автор: Rouse_

Статья HeaderControl с дополнительной возможностью отображения стрелок раздела Компоненты и Классы Компоненты может быть полезна для разработчиков на Delphi и FreePascal.


Комментарии и вопросы


Ваше мнение или вопрос к статье в виде простого текста (Tag <a href=... Disabled). Все комментарии модерируются, модератор оставляет за собой право удалить непонравившейся ему комментарий.

заголовок

e-mail

Ваше имя

Сообщение

Введите код




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.



:: Главная :: Компоненты ::


реклама

::


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru Rambler's Top100
19.09.2021 14:42:38/0.00096893310546875/0