VPF::Как засунуть в LISTBox свою прокрутку

IvanoffAndrey

Дата 9.11.2006, 20:51 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 157
Регистрация: 8.7.2006
Где: СГАУ

Репутация: 1
Всего: 2

Написал компонент - полоса прокрутки - от обычной отличается только возможностью заливаться разными цветами - очень надо было.
Можно ли еe теперь запихнуть в стандартный LIstBox. - очень не хочется писать еще и ListBox.

--------------------

Размерность пространства есть число Pi и в каждой точке вселенной оно стремиться к этому числу.

Voyager

Дата 13.11.2006, 01:17 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 532
Регистрация: 8.2.2005

Репутация: 2
Всего: 18

Видимо нельзя запихать ее в LIstBox, а вот связать LIstBox и отдельную полосу прокрутки можно.

IvanoffAndrey

Дата 13.11.2006, 14:39 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 157
Регистрация: 8.7.2006
Где: СГАУ

Репутация: 1
Всего: 2

Вот. Это то что мне нужно. Т.е. изменить полосу прокрутки стандартного ЛистБокса на мою.
Расскажи как это сделать пожалуйста.

--------------------

Размерность пространства есть число Pi и в каждой точке вселенной оно стремиться к этому числу.

AlexST

Дата 13.11.2006, 14:54 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 331
Регистрация: 30.4.2006
Где: Москва

Репутация: нет
Всего: 3

IvanoffAndrey, да не заменить тебе Voyager сказал, а связать, т. е. убрать полосу у бокса и заместо неё юзать свою. Всё просто. smile

Yanis

Дата 13.11.2006, 15:01 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111

IvanoffAndrey
Если по простому, то кинуть ListBox и твою прокрутку на один контейнер и настроить Align. Затем при помощи специальных функция и сообщений убрать стандартную прокрутку для ListBox-а. Далее требуется только обрабатывать сообщения для прокрутки и списка и ....

А вообще лучше сделать наследника от ListBox-а и изменить у него процедуру отрисовки прокрутки на свою.

--------------------

*щёлк*

IvanoffAndrey

Дата 14.11.2006, 19:26 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 157
Регистрация: 8.7.2006
Где: СГАУ

Репутация: 1
Всего: 2

Можно поподробнее как убрать у листБокса полосу прокрутки.

Добавлено @ 19:31
Вот интерфейс компанента:

Код


unit FatScrollBar;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;

type
  TGradientColors = array[0..255] of TRGBQuad;
  TRGBQuadArray = array[0..1024] of TRGBQuad;
  PRGBQuadArray = ^TRGBQuadArray;
  TStateStyleProperty = class(TPersistent)
  private
    FOnChange: TNotifyEvent;
    FColorCold, FColorHot, FColorDown: TColor;
    FStyleCold, FStyleHot, FStyleDown: TBrushStyle;
    FPatternCold, FPatternHot, FPatternDown: TBitmap;
  protected
    procedure SetColorCold(const Value: TColor);
    procedure SetColorHot(const Value: TColor);
    procedure SetColorDown(const Value: TColor);
    procedure SetStyleCold(const Value: TBrushStyle);
    procedure SetStyleHot(const Value: TBrushStyle);
    procedure SetStyleDown(const Value: TBrushStyle);
    procedure SetPatternCold(const Value: TBitmap);
    procedure SetPatternHot(const Value: TBitmap);
    procedure SetPatternDown(const Value: TBitmap);
  public
    procedure Changed;
    constructor Create;
    destructor Destroy; override;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  published
    property ColorCold: TColor read FColorCold write SetColorCold;
    property ColorHot: TColor read FColorHot write SetColorHot;
    property ColorDown: TColor read FColorDown write SetColorDown;
    property StyleCold: TBrushStyle read FStyleCold write SetStyleCold;
    property StyleHot: TBrushStyle read FStyleHot write SetStyleHot;
    property StyleDown: TBrushStyle read FStyleDown write SetStyleDown;
    property PatternCold: TBitmap read FPatternCold write SetPatternCold;
    property PatternHot: TBitmap read FPatternHot write SetPatternHot;
    property PatternDown: TBitmap read FPatternDown write SetPatternDown;
  end;

  TStyleProperty = class(TPersistent)
  private
    FOnChange: TNotifyEvent;
    FOwner: TObject;
    FBorder, FFill: TStateStyleProperty;
  protected
    procedure Changed;
    procedure StyleChanged(Sender: TObject);
  public
    constructor Create(AOwner: TObject);
    destructor Destroy; override;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  published
    property Border: TStateStyleProperty read FBorder write FBorder;
    property Fill: TStateStyleProperty read FFill write FFill;
  end;

  TScrollbarArea = (saArrowDown, saArrowUp, saTrackDown, saTrackUp, saScroller, saNone);
  TAreaRects = array[TScrollbarArea] of TRect;
  TAreaState = (asCold, asHot, asDown);
  TAreaStates = array[TScrollbarArea] of TAreaState;
  TArrowPoly = array[0..2] of TPoint;

  TMouseState = record
    Pos: TPoint;
    Button: TMouseButton;
    Shift: TShiftState;
  end;

  TFatScrollBar = class(TGraphicControl)
  private
    { Private declarations }
    FArrowWidth, FScrollerWidth, FMax, FMin, FArrowStretch,
    FLargeChange, FSmallChange, FPosition: Integer;
    FKind: TScrollBarKind;
    FOnChange, FOnMouseIn, FOnMouseOut: TNotifyEvent;
    FStyleArrow, FStyleArrowButton, FStyleScroller, FStyleTrack: TStyleProperty;
    FArrowPoly: array[saArrowDown..saArrowUp] of TArrowPoly;
    FAreaRect: TAreaRects;
    FAreaState: TAreaStates;
    DownAt: TScrollbarArea;
    Scrolling: Boolean;
    ScrollPos, ScrollOffset: TPoint;
    FScrollTimer: TTimer;
    FScrollArea: TScrollbarArea;
    FMouseState: TMouseState;
    FBuffer: TBitmap;
  protected
    { Protected declarations }
    function GetInterval: Integer;
    procedure SetInterval(const Value: Integer);
    procedure SetKind(const Value: TScrollBarKind);
    procedure SetScrollerWidth(const Value: Integer);
    procedure SetArrowWidth(const Value: Integer);
    procedure SetArrowStretch(const Value: Integer);
    procedure SetMax(const Value: Integer);
    procedure SetMin(const Value: Integer);
    procedure SetLargeChange(const Value: Integer);
    procedure SetSmallChange(const Value: Integer);
    procedure SetPosition(const Value: Integer);
    procedure GetStyleByState(const State: TAreaState; StyleProperty: TStyleProperty;
      var CBorder, CFill: TColor; var SBorder, SFill: TBrushStyle; var BBorder, BFill: TBitmap);
    procedure PaintArea(const Area: TScrollbarArea);
    function CheckArrowWidth(const AWidth: Integer): Integer;
    function CheckScrollerWidth(const AWidth: Integer): Integer;

    procedure ScrollerChanged;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure Resize; override;

    procedure StyleArrowChanged(Sender: TObject);
    procedure StyleArrowButtonChanged(Sender: TObject);
    procedure StyleScrollerChanged(Sender: TObject);
    procedure StyleTrackChanged(Sender: TObject);

    procedure AreaClick(const Area: TScrollbarArea);
    procedure AreaMouseDown(const Area: TScrollbarArea);
    procedure AreaMouseUp(const Area: TScrollbarArea);
    procedure ScrollToPos(const X, Y: Integer);

    procedure GetScrollerInfo(var X, Y, W, H: Integer);
    procedure RecalculateArrows;
    procedure RecalculateAreas;
    procedure RecalculateScroller;
    procedure DoScrollTimer(Sender: TObject);
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure CMMouseEnter(var M: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var M: TMessage); message CM_MOUSELEAVE;
    procedure WMSize(var M: TMessage); message WM_SIZE;
  published
    { Published declarations }
    property Kind: TScrollBarKind read FKind write SetKind;
    property Align;
    property Anchors;
    property ArrowWidth: Integer read FArrowWidth write SetArrowWidth;
    property ArrowStretch: Integer read FArrowStretch write SetArrowStretch;
    property BiDiMode;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property LargeChange: Integer read FLargeChange write SetLargeChange;
    property Max: Integer read FMax write SetMax;
    property Min: Integer read FMin write SetMin;
    property ParentBiDiMode;
    property ParentShowHint;
    property PopupMenu;
    property Position: Integer read FPosition write SetPosition;
    property ShowHint;
    property SmallChange: Integer read FSmallChange write SetSmallChange;
    property Visible;

    property ScrollInterval: Integer read GetInterval write SetInterval;
    property StyleArrow: TStyleProperty read FStyleArrow write FStyleArrow;
    property StyleArrowButton: TStyleProperty read FStyleArrowButton write FStyleArrowButton;
    property StyleScroller: TStyleProperty read FStyleScroller write FStyleScroller;
    property StyleTrack: TStyleProperty read FStyleTrack write FStyleTrack;
    property ScrollerWidth: Integer read FScrollerWidth write SetScrollerWidth;

    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnStartDock;
    property OnStartDrag;

    property OnMouseIn: TNotifyEvent read FOnMouseIn write FOnMouseIn;
    property OnMouseOut: TNotifyEvent read FOnMouseOut write FOnMouseOut;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

Можно пример как осуществить удаление полосы у ЛистБокса и связать с ней свою. Очень надо.

--------------------

Размерность пространства есть число Pi и в каждой точке вселенной оно стремиться к этому числу.

Yanis

Дата 20.11.2006, 09:58 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111

http://msdn.microsoft.com/library/default..../scrollbars.asp

--------------------

*щёлк*

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »