diff --git a/components/spktoolbar/SpkToolbar/SpkToolbar.pas b/components/spktoolbar/SpkToolbar/SpkToolbar.pas index 7e6b0fc06..fdeb8ec30 100644 --- a/components/spktoolbar/SpkToolbar/SpkToolbar.pas +++ b/components/spktoolbar/SpkToolbar/SpkToolbar.pas @@ -42,333 +42,339 @@ interface uses LCLType, LMessages, Graphics, SysUtils, Controls, Classes, Math, Dialogs, - Types, SpkGraphTools, SpkGUITools, SpkMath, - spkt_Appearance, spkt_BaseItem, spkt_Const, spkt_Dispatch, spkt_Tab, - spkt_Pane, spkt_Types; + Types, SpkGraphTools, SpkGUITools, SpkMath, ExtCtrls, + spkt_Appearance, spkt_BaseItem, spkt_Const, spkt_Dispatch, spkt_Tab, + spkt_Pane, spkt_Types; type /// Typ opisuj¹cy regiony toolbara, które s¹ u¿ywane podczas - /// obs³ugi interakcji z mysz¹ - TSpkMouseToolbarElement = (teNone, teToolbarArea, teTabs, teTabContents); + /// obs³ugi interakcji z mysz¹ + TSpkMouseToolbarElement = (teNone, teToolbarArea, teTabs, teTabContents); - TSpkTabChangingEvent = procedure (Sender: TObject; OldIndex, NewIndex: Integer; - var Allowed: Boolean) of object; + TSpkTabChangingEvent = procedure(Sender: TObject; OldIndex, NewIndex: integer; + var Allowed: boolean) of object; -type TSpkToolbar = class; +type + TSpkToolbar = class; - /// Klasa dyspozytora s³u¿¹ca do bezpiecznego przyjmowania - /// informacji oraz ¿¹dañ od pod-elementów - TSpkToolbarDispatch = class(TSpkBaseToolbarDispatch) - private - /// Komponent toolbara, który przyjmuje informacje i ¿¹dania - /// od pod-elementów - FToolbar : TSpkToolbar; - protected - public - // ******************* - // *** Konstruktor *** - // ******************* + /// Klasa dyspozytora s³u¿¹ca do bezpiecznego przyjmowania + /// informacji oraz ¿¹dañ od pod-elementów + TSpkToolbarDispatch = class(TSpkBaseToolbarDispatch) + private + /// Komponent toolbara, który przyjmuje informacje i ¿¹dania + /// od pod-elementów + FToolbar: TSpkToolbar; + protected + public + // ******************* + // *** Konstruktor *** + // ******************* - /// Konstruktor - constructor Create(AToolbar : TSpkToolbar); + /// Konstruktor + constructor Create(AToolbar: TSpkToolbar); - // ****************************************************************** - // *** Implementacja abstrakcyjnych metod TSpkBaseToolbarDispatch *** - // ****************************************************************** + // ****************************************************************** + // *** Implementacja abstrakcyjnych metod TSpkBaseToolbarDispatch *** + // ****************************************************************** - /// Metoda wywo³ywana, gdy zmieni siê zawartoœæ obiektu wygl¹du - /// zawieraj¹cego kolory i czcionki u¿ywane do rysowania toolbara. - /// - procedure NotifyAppearanceChanged; override; - /// Metoda wywo³ywana, gdy zmieni siê lista pod-elementów jednego - /// z elementów toolbara - procedure NotifyItemsChanged; override; - /// Metoda wywo³ywana, gdy zmieni siê rozmiar lub po³o¿enie - /// (metryka) jednego z elementów toolbara - procedure NotifyMetricsChanged; override; - /// Metoda wywo³ywana, gdy zmieni siê wygl¹d jednego z elementów - /// toolbara, nie wymagaj¹cy jednak przebudowania metryk. - procedure NotifyVisualsChanged; override; - /// Metoda ¿¹da dostarczenia przez toolbar pomocniczej - /// bitmapy u¿ywanej - przyk³adowo - do obliczania rozmiarów renderowanego - /// tekstu - function GetTempBitmap : TBitmap; override; - /// Metoda przelicza wspó³rzêdne toolbara na wspó³rzêdne - /// ekranu, co umo¿liwia - na przyk³ad - rozwiniêcie popup menu. - function ClientToScreen(Point : T2DIntPoint) : T2DIntPoint; override; - end; + /// Metoda wywo³ywana, gdy zmieni siê zawartoœæ obiektu wygl¹du + /// zawieraj¹cego kolory i czcionki u¿ywane do rysowania toolbara. + /// + procedure NotifyAppearanceChanged; override; + /// Metoda wywo³ywana, gdy zmieni siê lista pod-elementów jednego + /// z elementów toolbara + procedure NotifyItemsChanged; override; + /// Metoda wywo³ywana, gdy zmieni siê rozmiar lub po³o¿enie + /// (metryka) jednego z elementów toolbara + procedure NotifyMetricsChanged; override; + /// Metoda wywo³ywana, gdy zmieni siê wygl¹d jednego z elementów + /// toolbara, nie wymagaj¹cy jednak przebudowania metryk. + procedure NotifyVisualsChanged; override; + /// Metoda ¿¹da dostarczenia przez toolbar pomocniczej + /// bitmapy u¿ywanej - przyk³adowo - do obliczania rozmiarów renderowanego + /// tekstu + function GetTempBitmap: TBitmap; override; + /// Metoda przelicza wspó³rzêdne toolbara na wspó³rzêdne + /// ekranu, co umo¿liwia - na przyk³ad - rozwiniêcie popup menu. + function ClientToScreen(Point: T2DIntPoint): T2DIntPoint; override; + end; - /// Rozszerzony pasek narzêdzi inspirowany Microsoft Fluent - /// UI + /// Rozszerzony pasek narzêdzi inspirowany Microsoft Fluent + /// UI - { TSpkToolbar } + { TSpkToolbar } - TSpkToolbar = class(TCustomControl) - private - /// Instancja obiektu dyspozytora przekazywanego elementom - /// toolbara - FToolbarDispatch : TSpkToolbarDispatch; + TSpkToolbar = class(TCustomControl) + private + /// Instancja obiektu dyspozytora przekazywanego elementom + /// toolbara + FToolbarDispatch: TSpkToolbarDispatch; - /// Bufor w którym rysowany jest toolbar - FBuffer : TBitmap; - /// Pomocnicza bitmapa przekazywana na ¿yczenie elementom - /// toolbara - FTemporary : TBitmap; + /// Bufor w którym rysowany jest toolbar + FBuffer: TBitmap; + /// Pomocnicza bitmapa przekazywana na ¿yczenie elementom + /// toolbara + FTemporary: TBitmap; + FDelayRunTimer: TTimer; - /// Tablica rectów "uchwytów" zak³adek - FTabRects : array of T2DIntRect; - /// Cliprect obszaru "uchwytów" zak³adek - FTabClipRect : T2DIntRect; - /// Cliprect obszaru zawartoœci zak³adki - FTabContentsClipRect : T2DIntRect; + /// Tablica rectów "uchwytów" zak³adek + FTabRects: array of T2DIntRect; + /// Cliprect obszaru "uchwytów" zak³adek + FTabClipRect: T2DIntRect; + /// Cliprect obszaru zawartoœci zak³adki + FTabContentsClipRect: T2DIntRect; - /// Element toolbara znajduj¹cy siê obecnie pod myszk¹ - FMouseHoverElement : TSpkMouseToolbarElement; - /// Element toolbara maj¹cy obecnie wy³¹cznoœæ na otrzymywanie - /// komunikatów od myszy - FMouseActiveElement : TSpkMouseToolbarElement; + /// Element toolbara znajduj¹cy siê obecnie pod myszk¹ + FMouseHoverElement: TSpkMouseToolbarElement; + /// Element toolbara maj¹cy obecnie wy³¹cznoœæ na otrzymywanie + /// komunikatów od myszy + FMouseActiveElement: TSpkMouseToolbarElement; - /// "Uchwyt" zak³adki, nad którym znajduje siê obecnie mysz - /// - FTabHover : integer; + /// "Uchwyt" zak³adki, nad którym znajduje siê obecnie mysz + /// + FTabHover: integer; - /// Flaga informuj¹ca o tym, czy metryki toolbara i jego elementów - /// s¹ aktualne - FMetricsValid : boolean; - /// Flaga informuj¹ca o tym, czy zawartoœæ bufora jest aktualna - /// - FBufferValid : boolean; - /// Flaga InternalUpdating pozwala na zablokowanie walidacji - /// metryk i bufora w momencie, gdy komponent przebudowuje swoj¹ zawartoœæ. - /// FInternalUpdating jest zapalana i gaszona wewnêtrznie, przez komponent. - /// - FInternalUpdating : boolean; - /// Flaga IUpdating pozwala na zablokowanie walidacji - /// metryk i bufora w momencie, gdy u¿ytkownik przebudowuje zawartoœæ - /// komponentu. FUpdating jest sterowana przez u¿ytkownika. - FUpdating : boolean; + /// Flaga informuj¹ca o tym, czy metryki toolbara i jego elementów + /// s¹ aktualne + FMetricsValid: boolean; + /// Flaga informuj¹ca o tym, czy zawartoœæ bufora jest aktualna + /// + FBufferValid: boolean; + /// Flaga InternalUpdating pozwala na zablokowanie walidacji + /// metryk i bufora w momencie, gdy komponent przebudowuje swoj¹ zawartoœæ. + /// FInternalUpdating jest zapalana i gaszona wewnêtrznie, przez komponent. + /// + FInternalUpdating: boolean; + /// Flaga IUpdating pozwala na zablokowanie walidacji + /// metryk i bufora w momencie, gdy u¿ytkownik przebudowuje zawartoœæ + /// komponentu. FUpdating jest sterowana przez u¿ytkownika. + FUpdating: boolean; - FOnTabChanging: TSpkTabChangingEvent; - FOnTabChanged: TNotifyEvent; + FOnTabChanging: TSpkTabChangingEvent; + FOnTabChanged: TNotifyEvent; - protected - /// Instancja obiektu wygl¹du, przechowuj¹cego kolory i czcionki - /// u¿ywane podczas renderowania komponentu - FAppearance : TSpkToolbarAppearance; - /// Zak³adki toolbara - FTabs : TSpkTabs; - /// Indeks wybranej zak³adki - FTabIndex : integer; - /// Lista ma³ych obrazków elementów toolbara - FImages : TImageList; - /// Lista ma³ych obrazków w stanie "disabled". Jeœli nie jest - /// przypisana, obrazki w stanie "disabled" bêd¹ generowane automatycznie. - /// - FDisabledImages : TImageList; - /// Lista du¿ych obrazków elementów toolbara - FLargeImages : TImageList; - /// Lista du¿ych obrazków w stanie "disabled". Jeœli nie jest - /// przypisana, obrazki w stanie "disabled" bêd¹ generowane automatycznie. - /// - FDisabledLargeImages : TImageList; + procedure DelayRunTimer(Sender: TObject); + protected + /// Instancja obiektu wygl¹du, przechowuj¹cego kolory i czcionki + /// u¿ywane podczas renderowania komponentu + FAppearance: TSpkToolbarAppearance; + /// Zak³adki toolbara + FTabs: TSpkTabs; + /// Indeks wybranej zak³adki + FTabIndex: integer; + /// Lista ma³ych obrazków elementów toolbara + FImages: TImageList; + /// Lista ma³ych obrazków w stanie "disabled". Jeœli nie jest + /// przypisana, obrazki w stanie "disabled" bêd¹ generowane automatycznie. + /// + FDisabledImages: TImageList; + /// Lista du¿ych obrazków elementów toolbara + FLargeImages: TImageList; + /// Lista du¿ych obrazków w stanie "disabled". Jeœli nie jest + /// przypisana, obrazki w stanie "disabled" bêd¹ generowane automatycznie. + /// + FDisabledLargeImages: TImageList; - function DoTabChanging(OldIndex, NewIndex: Integer): Boolean; - // ******************************************* - // *** Zarz¹dzanie stanem metryki i bufora *** - // ******************************************* + function DoTabChanging(OldIndex, NewIndex: integer): boolean; + // ******************************************* + // *** Zarz¹dzanie stanem metryki i bufora *** + // ******************************************* - /// Metoda gasi flagi: FMetricsValid oraz FBufferValid - procedure SetMetricsInvalid; - /// Metoda gasi flagê FBufferValid - procedure SetBufferInvalid; - /// Metoda waliduje metryki toolbara i jego elementów - procedure ValidateMetrics; - /// Metoda waliduje zawartoœæ bufora - procedure ValidateBuffer; - /// Metoda w³¹cza tryb wewnêtrznej przebudowy - zapala flagê - /// FInternalUpdating - procedure InternalBeginUpdate; - /// Metoda wy³¹cza tryb wewnêtrznej przebudowy - gasi flagê - /// FInternalUpdating - procedure InternalEndUpdate; + /// Metoda gasi flagi: FMetricsValid oraz FBufferValid + procedure SetMetricsInvalid; + /// Metoda gasi flagê FBufferValid + procedure SetBufferInvalid; + /// Metoda waliduje metryki toolbara i jego elementów + procedure ValidateMetrics; + /// Metoda waliduje zawartoœæ bufora + procedure ValidateBuffer; + /// Metoda w³¹cza tryb wewnêtrznej przebudowy - zapala flagê + /// FInternalUpdating + procedure InternalBeginUpdate; + /// Metoda wy³¹cza tryb wewnêtrznej przebudowy - gasi flagê + /// FInternalUpdating + procedure InternalEndUpdate; - // ******************************************** - // *** Pokrycie metod z dziedziczonych klas *** - // ******************************************** + // ******************************************** + // *** Pokrycie metod z dziedziczonych klas *** + // ******************************************** - /// Zmiana rozmiaru komponentu - procedure Resize; override; - /// Metoda wywo³ywana po opuszczeniu obszaru komponentu przez - /// wskaŸnik myszy - procedure MouseLeave; - /// Metoda wywo³ywana po wciœniêciu przycisku myszy - procedure MouseDown(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); override; - /// Metoda wywo³ywana, gdy nad komponentem przesunie siê wskaŸnik - /// myszy - procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; - /// Metoda wywo³ywana po puszczeniu przycisku myszy - procedure MouseUp(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); override; - /// Metoda wywo³ywana, gdy ca³y komponent wczyta siê z DFMa - /// - procedure Loaded; override; - /// Metoda wywo³ywana, gdy komponent staje siê Ownerem innego - /// komponentu, b¹dŸ gdy jeden z jego pod-komponentów jest zwalniany - /// - procedure Notification(AComponent: TComponent; - Operation: TOperation); override; + /// Zmiana rozmiaru komponentu + procedure DoOnResize; override; + procedure EraseBackground(DC: HDC); override; + /// Metoda wywo³ywana po opuszczeniu obszaru komponentu przez + /// wskaŸnik myszy + procedure MouseLeave; + /// Metoda wywo³ywana po wciœniêciu przycisku myszy + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: integer); override; + /// Metoda wywo³ywana, gdy nad komponentem przesunie siê wskaŸnik + /// myszy + procedure MouseMove(Shift: TShiftState; X, Y: integer); override; + /// Metoda wywo³ywana po puszczeniu przycisku myszy + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: integer); override; + /// Metoda wywo³ywana, gdy ca³y komponent wczyta siê z DFMa + /// + procedure Loaded; override; + /// Metoda wywo³ywana, gdy komponent staje siê Ownerem innego + /// komponentu, b¹dŸ gdy jeden z jego pod-komponentów jest zwalniany + /// + procedure Notification(AComponent: TComponent; Operation: TOperation); + override; - // ****************************************** - // *** Obs³uga zdarzeñ myszy dla zak³adek *** - // ****************************************** + // ****************************************** + // *** Obs³uga zdarzeñ myszy dla zak³adek *** + // ****************************************** - /// Metoda wywo³ywana po opuszczeniu przez wskaŸnik myszy obszaru - /// "uchwytów" zak³adek - procedure TabMouseLeave; - /// Metoda wywo³ywana po wciœniêciu przycisku myszy, gdy wskaŸnik - /// jest nad obszarem zak³adek - procedure TabMouseDown(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); - /// Metoda wywo³ywana, gdy mysz przesunie siê ponad obszarem - /// "uchwytów" zak³adek - procedure TabMouseMove(Shift: TShiftState; X, Y: Integer); - /// Metoda wywo³ywana, gdy jeden z przycisków myszy zostanie - /// puszczony, gdy obszar zak³adek by³ aktywnym elementem toolbara - /// - procedure TabMouseUp(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); + /// Metoda wywo³ywana po opuszczeniu przez wskaŸnik myszy obszaru + /// "uchwytów" zak³adek + procedure TabMouseLeave; + /// Metoda wywo³ywana po wciœniêciu przycisku myszy, gdy wskaŸnik + /// jest nad obszarem zak³adek + procedure TabMouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: integer); + /// Metoda wywo³ywana, gdy mysz przesunie siê ponad obszarem + /// "uchwytów" zak³adek + procedure TabMouseMove(Shift: TShiftState; X, Y: integer); + /// Metoda wywo³ywana, gdy jeden z przycisków myszy zostanie + /// puszczony, gdy obszar zak³adek by³ aktywnym elementem toolbara + /// + procedure TabMouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: integer); - // ****************** - // *** Pomocnicze *** - // ****************** + // ****************** + // *** Pomocnicze *** + // ****************** - /// Metoda sprawdza, czy choæ jedna zak³adka ma ustawion¹ flagê - /// widocznoœci (Visible) - function AtLeastOneTabVisible : boolean; + /// Metoda sprawdza, czy choæ jedna zak³adka ma ustawion¹ flagê + /// widocznoœci (Visible) + function AtLeastOneTabVisible: boolean; - // *************************** - // *** Obs³uga komunikatów *** - // *************************** + // *************************** + // *** Obs³uga komunikatów *** + // *************************** - /// Komunikat odbierany, gdy mysz opuœci obszar komponentu - /// - procedure CMMouseLeave(var msg : TLMessage); message CM_MOUSELEAVE; + /// Komunikat odbierany, gdy mysz opuœci obszar komponentu + /// + procedure CMMouseLeave(var msg: TLMessage); message CM_MOUSELEAVE; - // ******************************** - // *** Obs³uga designtime i DFM *** - // ******************************** + // ******************************** + // *** Obs³uga designtime i DFM *** + // ******************************** - /// Metoda zwraca elementy, które maj¹ zostaæ zapisane jako - /// pod-elementy komponentu - procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; - /// Metoda pozwala na zapisanie lub odczytanie dodatkowych - /// w³asnoœci komponentu - procedure DefineProperties(Filer : TFiler); override; + /// Metoda zwraca elementy, które maj¹ zostaæ zapisane jako + /// pod-elementy komponentu + procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; + /// Metoda pozwala na zapisanie lub odczytanie dodatkowych + /// w³asnoœci komponentu + procedure DefineProperties(Filer: TFiler); override; - // ************************* - // *** Gettery i settery *** - // ************************* + // ************************* + // *** Gettery i settery *** + // ************************* - /// Getter dla w³asnoœci Height - function GetHeight: integer; - /// Setter dla w³asnoœci Appearance - procedure SetAppearance(const Value: TSpkToolbarAppearance); - /// Getter dla w³asnoœci Color - function GetColor: TColor; - /// Setter dla w³asnoœci Color - procedure SetColor(const Value: TColor); - /// Setter dla w³asnoœci TabIndex - procedure SetTabIndex(const Value: integer); - /// Setter dla w³asnoœci Images - procedure SetImages(const Value: TImageList); - /// Setter dla w³asnoœci DisabledImages - procedure SetDisabledImages(const Value : TImageList); - /// Setter dla w³asnoœci LargeImages - procedure SetLargeImages(const Value : TImageList); - /// Setter dla w³asnoœci DisabledLargeImages - procedure SetDisabledLargeImages(const Value : TImageList); - public + /// Getter dla w³asnoœci Height + function GetHeight: integer; + /// Setter dla w³asnoœci Appearance + procedure SetAppearance(const Value: TSpkToolbarAppearance); + /// Getter dla w³asnoœci Color + function GetColor: TColor; + /// Setter dla w³asnoœci Color + procedure SetColor(const Value: TColor); + /// Setter dla w³asnoœci TabIndex + procedure SetTabIndex(const Value: integer); + /// Setter dla w³asnoœci Images + procedure SetImages(const Value: TImageList); + /// Setter dla w³asnoœci DisabledImages + procedure SetDisabledImages(const Value: TImageList); + /// Setter dla w³asnoœci LargeImages + procedure SetLargeImages(const Value: TImageList); + /// Setter dla w³asnoœci DisabledLargeImages + procedure SetDisabledLargeImages(const Value: TImageList); + public - // *********************************** - // *** Obs³uga zdarzeñ dyspozytora *** - // *********************************** + // *********************************** + // *** Obs³uga zdarzeñ dyspozytora *** + // *********************************** - /// Reakcja na zmianê struktury elementów toolbara - procedure NotifyItemsChanged; - /// Reakcja na zmianê metryki elementów toolbara - procedure NotifyMetricsChanged; - /// Reakcja na zmianê wygl¹du elementów toolbara - procedure NotifyVisualsChanged; - /// Reakcja na zmianê zawartoœci klasy wygl¹du toolbara - procedure NotifyAppearanceChanged; - /// Metoda zwraca instancjê pomocniczej bitmapy - function GetTempBitmap : TBitmap; + /// Reakcja na zmianê struktury elementów toolbara + procedure NotifyItemsChanged; + /// Reakcja na zmianê metryki elementów toolbara + procedure NotifyMetricsChanged; + /// Reakcja na zmianê wygl¹du elementów toolbara + procedure NotifyVisualsChanged; + /// Reakcja na zmianê zawartoœci klasy wygl¹du toolbara + procedure NotifyAppearanceChanged; + /// Metoda zwraca instancjê pomocniczej bitmapy + function GetTempBitmap: TBitmap; - // ******************************** - // *** Konstruktor i destruktor *** - // ******************************** + // ******************************** + // *** Konstruktor i destruktor *** + // ******************************** - /// Konstruktor - constructor Create(AOwner : TComponent); override; - /// Destruktor - destructor Destroy; override; + /// Konstruktor + constructor Create(AOwner: TComponent); override; + /// Destruktor + destructor Destroy; override; - // ***************** - // *** Rysowanie *** - // ***************** + // ***************** + // *** Rysowanie *** + // ***************** - /// Metoda odrysowuje zawartoœæ komponentu - procedure Paint; override; - /// Metoda wymusza przebudowanie metryk i bufora - procedure ForceRepaint; - /// Metoda prze³¹cza komponent w tryb aktualizacji zawartoœci - /// poprzez zapalenie flagi FUpdating - procedure BeginUpdate; - /// Metoda wy³¹cza tryb aktualizacji zawartoœci poprzez zgaszenie - /// flagi FUpdating - procedure EndUpdate; + /// Metoda odrysowuje zawartoœæ komponentu + procedure Paint; override; + /// Metoda wymusza przebudowanie metryk i bufora + procedure ForceRepaint; + /// Metoda prze³¹cza komponent w tryb aktualizacji zawartoœci + /// poprzez zapalenie flagi FUpdating + procedure BeginUpdate; + /// Metoda wy³¹cza tryb aktualizacji zawartoœci poprzez zgaszenie + /// flagi FUpdating + procedure EndUpdate; - // ************************* - // *** Obs³uga elementów *** - // ************************* + // ************************* + // *** Obs³uga elementów *** + // ************************* - /// Metoda wywo³ywana w momencie, gdy jedna z zak³adek - /// jest zwalniana - /// Nie nale¿y wywo³ywaæ metody FreeingTab z kodu! Jest ona - /// wywo³ywana wewnêtrznie, a jej zadaniem jest zaktualizowanie wewnêtrznej - /// listy zak³adek. - procedure FreeingTab(ATab : TSpkTab); + /// Metoda wywo³ywana w momencie, gdy jedna z zak³adek + /// jest zwalniana + /// Nie nale¿y wywo³ywaæ metody FreeingTab z kodu! Jest ona + /// wywo³ywana wewnêtrznie, a jej zadaniem jest zaktualizowanie wewnêtrznej + /// listy zak³adek. + procedure FreeingTab(ATab: TSpkTab); - // ************************** - // *** Dostêp do zak³adek *** - // ************************** + // ************************** + // *** Dostêp do zak³adek *** + // ************************** - /// W³asnoœæ daje dostê do zak³adek w trybie runtime. Do edycji - /// zak³adek w trybie designtime s³u¿y odpowiedni edytor, zaœ zapisywanie - /// i odczytywanie z DFMa jest zrealizowane manualnie. - property Tabs : TSpkTabs read FTabs; - published - /// Kolor t³a komponentu - property Color : TColor read GetColor write SetColor default clSkyBlue; - /// Obiekt zawieraj¹cy atrybuty wygl¹du toolbara - property Appearance : TSpkToolbarAppearance read FAppearance write SetAppearance; - /// Wysokoœæ toolbara (tylko do odczytu) - property Height : integer read GetHeight; - /// Aktywna zak³adka - property TabIndex : integer read FTabIndex write SetTabIndex; - /// Lista ma³ych obrazków - property Images : TImageList read FImages write SetImages; - /// Lista ma³ych obrazków w stanie "disabled" - property DisabledImages : TImageList read FDisabledImages write SetDisabledImages; - /// Lista du¿ych obrazków - property LargeImages : TImageList read FLargeImages write SetLargeImages; - /// Lista du¿ych obrazków w stanie "disabled" - property DisabledLargeImages : TImageList read FDisabledLargeImages write SetDisabledLargeImages; + /// W³asnoœæ daje dostê do zak³adek w trybie runtime. Do edycji + /// zak³adek w trybie designtime s³u¿y odpowiedni edytor, zaœ zapisywanie + /// i odczytywanie z DFMa jest zrealizowane manualnie. + property Tabs: TSpkTabs read FTabs; + published + /// Kolor t³a komponentu + property Color: TColor read GetColor write SetColor default clSkyBlue; + /// Obiekt zawieraj¹cy atrybuty wygl¹du toolbara + property Appearance: TSpkToolbarAppearance read FAppearance write SetAppearance; + /// Wysokoœæ toolbara (tylko do odczytu) + property Height: integer read GetHeight; + /// Aktywna zak³adka + property TabIndex: integer read FTabIndex write SetTabIndex; + /// Lista ma³ych obrazków + property Images: TImageList read FImages write SetImages; + /// Lista ma³ych obrazków w stanie "disabled" + property DisabledImages: TImageList read FDisabledImages write SetDisabledImages; + /// Lista du¿ych obrazków + property LargeImages: TImageList read FLargeImages write SetLargeImages; + /// Lista du¿ych obrazków w stanie "disabled" + property DisabledLargeImages: TImageList + read FDisabledLargeImages write SetDisabledLargeImages; - // Events called before and after a different tab is selected - property OnTabChanging: TSpkTabChangingEvent read FOnTabChanging write FOnTabChanging; - property OnTabChanged: TNotifyEvent read FOnTabChanged write FOnTabChanged; - end; + // Events called before and after a different tab is selected + property OnTabChanging: TSpkTabChangingEvent + read FOnTabChanging write FOnTabChanging; + property OnTabChanged: TNotifyEvent read FOnTabChanged write FOnTabChanged; + end; implementation @@ -380,78 +386,82 @@ uses function TSpkToolbarDispatch.ClientToScreen(Point: T2DIntPoint): T2DIntPoint; begin {$IFDEF EnhancedRecordSupport} - if FToolbar<>nil then - result:=FToolbar.ClientToScreen(Point) else - result:=T2DIntPoint.Create(-1,-1); + if FToolbar <> nil then + Result := FToolbar.ClientToScreen(Point) + else + Result := T2DIntPoint.Create(-1, -1); {$ELSE} - if FToolbar<>nil then - result:=FToolbar.ClientToScreen(Point) else - result.Create(-1,-1); + if FToolbar <> nil then + Result := FToolbar.ClientToScreen(Point) + else + Result.Create(-1, -1); {$ENDIF} end; constructor TSpkToolbarDispatch.Create(AToolbar: TSpkToolbar); begin inherited Create; - FToolbar:=AToolbar; + FToolbar := AToolbar; end; function TSpkToolbarDispatch.GetTempBitmap: TBitmap; begin - if FToolbar<>nil then - result:=FToolbar.GetTempBitmap else - result:=nil; + if FToolbar <> nil then + Result := FToolbar.GetTempBitmap + else + Result := nil; end; procedure TSpkToolbarDispatch.NotifyAppearanceChanged; begin - if FToolbar<>nil then - FToolbar.NotifyAppearanceChanged; + if FToolbar <> nil then + FToolbar.NotifyAppearanceChanged; end; procedure TSpkToolbarDispatch.NotifyMetricsChanged; begin - if FToolbar<>nil then - FToolbar.NotifyMetricsChanged; + if FToolbar <> nil then + FToolbar.NotifyMetricsChanged; end; procedure TSpkToolbarDispatch.NotifyItemsChanged; begin - if FToolbar<>nil then - FToolbar.NotifyItemsChanged; + if FToolbar <> nil then + FToolbar.NotifyItemsChanged; end; procedure TSpkToolbarDispatch.NotifyVisualsChanged; begin - if FToolbar<>nil then - FToolbar.NotifyVisualsChanged; + if FToolbar <> nil then + FToolbar.NotifyVisualsChanged; end; { TSpkToolbar } function TSpkToolbar.AtLeastOneTabVisible: boolean; -var i : integer; - TabVisible : boolean; +var + i: integer; + TabVisible: boolean; begin -result:=FTabs.count>0; -if result then - begin - TabVisible:=false; - i:=FTabs.count-1; - while (i>=0) and not(TabVisible) do - begin - TabVisible:=FTabs[i].Visible; - dec(i); - end; - result:=result and TabVisible; - end; + Result := FTabs.Count > 0; + if Result then + begin + TabVisible := False; + i := FTabs.Count - 1; + while (i >= 0) and not (TabVisible) do + begin + TabVisible := FTabs[i].Visible; + Dec(i); + end; + Result := Result and TabVisible; + end; end; procedure TSpkToolbar.BeginUpdate; begin - FUpdating:=true; + FUpdating := True; end; procedure TSpkToolbar.CMMouseLeave(var msg: TLMessage); @@ -465,52 +475,64 @@ begin inherited Create(AOwner); // Inicjacja dziedziczonych w³asnoœci - inherited Align:=alTop; + inherited Align := alTop; //todo: not found in lcl //inherited AlignWithMargins:=true; - inherited Height:=TOOLBAR_HEIGHT; - inherited Doublebuffered:=true; + inherited Height := TOOLBAR_HEIGHT; + //inherited Doublebuffered:=true; // Inicjacja wewnêtrznych pól danych - FToolbarDispatch:=TSpkToolbarDispatch.Create(self); + FToolbarDispatch := TSpkToolbarDispatch.Create(self); - FBuffer:=TBitmap.create; - FBuffer.PixelFormat:=pf24bit; + FBuffer := TBitmap.Create; + FBuffer.PixelFormat := pf24bit; - FTemporary:=TBitmap.create; - FTemporary.Pixelformat:=pf24bit; + FTemporary := TBitmap.Create; + FTemporary.Pixelformat := pf24bit; - setlength(FTabRects,0); + setlength(FTabRects, 0); {$IFDEF EnhancedRecordSupport} - FTabClipRect:=T2DIntRect.create(0,0,0,0); - FTabContentsClipRect:=T2DIntRect.create(0,0,0,0); + FTabClipRect := T2DIntRect.Create(0, 0, 0, 0); + FTabContentsClipRect := T2DIntRect.Create(0, 0, 0, 0); {$ELSE} - FTabClipRect.create(0,0,0,0); - FTabContentsClipRect.create(0,0,0,0); + FTabClipRect.Create(0, 0, 0, 0); + FTabContentsClipRect.Create(0, 0, 0, 0); {$ENDIF} - FMouseHoverElement:=teNone; - FMouseActiveElement:=teNone; + FMouseHoverElement := teNone; + FMouseActiveElement := teNone; - FTabHover:=-1; + FTabHover := -1; // Inicjacja pól - FAppearance:=TSpkToolbarAppearance.Create(FToolbarDispatch); + FAppearance := TSpkToolbarAppearance.Create(FToolbarDispatch); - FTabs:=TSpkTabs.Create(self); - FTabs.ToolbarDispatch:=FToolbarDispatch; - FTabs.Appearance:=FAppearance; + FTabs := TSpkTabs.Create(self); + FTabs.ToolbarDispatch := FToolbarDispatch; + FTabs.Appearance := FAppearance; - FTabIndex:=-1; + FTabIndex := -1; Color := clSkyBlue; + + FDelayRunTimer := TTimer.Create(nil); + FDelayRunTimer.Interval := 128; + FDelayRunTimer.Enabled := False; + FDelayRunTimer.OnTimer := DelayRunTimer; +end; + +procedure TSpkToolbar.DelayRunTimer(Sender: TObject); +begin + SetMetricsInvalid; + SetBufferInvalid; + invalidate; end; procedure TSpkToolbar.DefineProperties(Filer: TFiler); begin inherited DefineProperties(Filer); - Filer.DefineProperty('Tabs',FTabs.ReadNames,FTabs.WriteNames,true); + Filer.DefineProperty('Tabs', FTabs.ReadNames, FTabs.WriteNames, True); end; destructor TSpkToolbar.Destroy; @@ -526,12 +548,14 @@ begin FToolbarDispatch.Free; + FDelayRunTimer.Free; + inherited Destroy; end; procedure TSpkToolbar.EndUpdate; begin - FUpdating:=false; + FUpdating := False; ValidateMetrics; ValidateBuffer; @@ -540,51 +564,52 @@ end; procedure TSpkToolbar.ForceRepaint; begin -SetMetricsInvalid; -SetBufferInvalid; -Repaint; + SetMetricsInvalid; + SetBufferInvalid; + Repaint; end; procedure TSpkToolbar.FreeingTab(ATab: TSpkTab); begin -FTabs.RemoveReference(ATab); + FTabs.RemoveReference(ATab); end; procedure TSpkToolbar.GetChildren(Proc: TGetChildProc; Root: TComponent); -var i : integer; +var + i: integer; begin -inherited; + inherited; -if FTabs.Count>0 then - for i := 0 to FTabs.Count - 1 do - Proc(FTabs.Items[i]); + if FTabs.Count > 0 then + for i := 0 to FTabs.Count - 1 do + Proc(FTabs.Items[i]); end; function TSpkToolbar.GetColor: TColor; begin -result:=inherited Color; + Result := inherited Color; end; function TSpkToolbar.GetHeight: integer; begin -result:=inherited Height; + Result := inherited Height; end; function TSpkToolbar.GetTempBitmap: TBitmap; begin -result:=FTemporary; + Result := FTemporary; end; procedure TSpkToolbar.InternalBeginUpdate; begin - FInternalUpdating:=true; + FInternalUpdating := True; end; procedure TSpkToolbar.InternalEndUpdate; begin - FInternalUpdating:=false; + FInternalUpdating := False; // Po wewnêtrznych zmianach odœwie¿amy metryki i bufor ValidateMetrics; @@ -594,68 +619,73 @@ end; procedure TSpkToolbar.Loaded; begin -inherited; + inherited; -InternalBeginUpdate; + InternalBeginUpdate; -if FTabs.ListState = lsNeedsProcessing then - begin - FTabs.ProcessNames(self.Owner); - end; + if FTabs.ListState = lsNeedsProcessing then + begin + FTabs.ProcessNames(self.Owner); + end; -InternalEndUpdate; + InternalEndUpdate; -// Proces wewnêtrznego update'u zawsze odœwie¿a na koñcu metryki i bufor oraz -// odrysowuje komponent. + // Proces wewnêtrznego update'u zawsze odœwie¿a na koñcu metryki i bufor oraz + // odrysowuje komponent. end; -procedure TSpkToolbar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, - Y: Integer); +procedure TSpkToolbar.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: integer); begin // Podczas procesu przebudowy mysz jest ignorowana. if FInternalUpdating or FUpdating then - exit; + exit; inherited MouseDown(Button, Shift, X, Y); // Mo¿liwe, ¿e zosta³ wciœniêty kolejny przycisk myszy. W takiej sytuacji // aktywny obiekt otrzymuje kolejn¹ notyfikacjê. - if FMouseActiveElement=teTabs then - begin - TabMouseDown(Button, Shift, X, Y); - end else - if FMouseActiveElement=teTabContents then - begin - if FTabIndex<>-1 then - FTabs[FTabIndex].MouseDown(Button, Shift, X, Y); - end else + if FMouseActiveElement = teTabs then + begin + TabMouseDown(Button, Shift, X, Y); + end + else + if FMouseActiveElement = teTabContents then + begin + if FTabIndex <> -1 then + FTabs[FTabIndex].MouseDown(Button, Shift, X, Y); + end + else if FMouseActiveElement = teToolbarArea then - begin - // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia - end else + begin + // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia + end + else // Jeœli nie ma aktywnego elementu, aktywnym staje siê ten, który obecnie // jest pod mysz¹. - if FMouseActiveElement=teNone then - begin - if FMouseHoverElement = teTabs then - begin - FMouseActiveElement:=teTabs; - TabMouseDown(Button, Shift, X, Y); - end else - if FMouseHoverElement = teTabContents then - begin - FMouseActiveElement:=teTabContents; - if FTabIndex<>-1 then - FTabs[FTabIndex].MouseDown(Button, Shift, X, Y); - end else - if FMouseHoverElement = teToolbarArea then - begin - FMouseActiveElement:=teToolbarArea; + if FMouseActiveElement = teNone then + begin + if FMouseHoverElement = teTabs then + begin + FMouseActiveElement := teTabs; + TabMouseDown(Button, Shift, X, Y); + end + else + if FMouseHoverElement = teTabContents then + begin + FMouseActiveElement := teTabContents; + if FTabIndex <> -1 then + FTabs[FTabIndex].MouseDown(Button, Shift, X, Y); + end + else + if FMouseHoverElement = teToolbarArea then + begin + FMouseActiveElement := teToolbarArea; - // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia - end; - end; + // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia + end; + end; end; procedure TSpkToolbar.MouseLeave; @@ -663,7 +693,7 @@ procedure TSpkToolbar.MouseLeave; begin // Podczas procesu przebudowy mysz jest ignorowana. if FInternalUpdating or FUpdating then - exit; + exit; // MouseLeave nie ma szans byæ zawo³ane dla obiektu aktywnego, bo po // wciœniêciu przycisku myszy ka¿dy jej ruch jest przekazywany jako @@ -671,252 +701,277 @@ begin // zostanie zawo³any zaraz po MouseUp - ale MouseUp czyœci aktywny // obiekt. if FMouseActiveElement = teNone then - begin - // Jeœli nie ma obiektu aktywnego, obs³ugujemy elementy pod mysz¹ - if FMouseHoverElement = teTabs then - begin - TabMouseLeave; - end else - if FMouseHoverElement = teTabContents then - begin - if FTabIndex<>-1 then - FTabs[FTabIndex].MouseLeave; - end else - if FMouseHoverElement = teToolbarArea then - begin - // Placeholder, jeœli bêdzie potrzeba obs³ugi tego zdarzenia - end; - end; + begin + // Jeœli nie ma obiektu aktywnego, obs³ugujemy elementy pod mysz¹ + if FMouseHoverElement = teTabs then + begin + TabMouseLeave; + end + else + if FMouseHoverElement = teTabContents then + begin + if FTabIndex <> -1 then + FTabs[FTabIndex].MouseLeave; + end + else + if FMouseHoverElement = teToolbarArea then + begin + // Placeholder, jeœli bêdzie potrzeba obs³ugi tego zdarzenia + end; + end; - FMouseHoverElement:=teNone; + FMouseHoverElement := teNone; end; -procedure TSpkToolbar.MouseMove(Shift: TShiftState; X, Y: Integer); +procedure TSpkToolbar.MouseMove(Shift: TShiftState; X, Y: integer); -var NewMouseHoverElement : TSpkMouseToolbarElement; - MousePoint : T2DIntVector; +var + NewMouseHoverElement: TSpkMouseToolbarElement; + MousePoint: T2DIntVector; begin // Podczas procesu przebudowy mysz jest ignorowana. if FInternalUpdating or FUpdating then - exit; + exit; inherited MouseMove(Shift, X, Y); // Sprawdzamy, który obiekt jest pod mysz¹ {$IFDEF EnhancedRecordSupport} - MousePoint:=T2DIntVector.create(x,y); + MousePoint := T2DIntVector.Create(x, y); {$ELSE} - MousePoint.create(x,y); + MousePoint.Create(x, y); {$ENDIF} if FTabClipRect.Contains(MousePoint) then - NewMouseHoverElement:=teTabs else + NewMouseHoverElement := teTabs + else if FTabContentsClipRect.Contains(MousePoint) then - NewMouseHoverElement:=teTabContents else - if (X>=0) and (Y>=0) and (X= 0) and (Y >= 0) and (X < self.Width) and (Y < self.Height) then + NewMouseHoverElement := teToolbarArea + else + NewMouseHoverElement := teNone; // Jeœli jest jakiœ aktywny obiekt, to on ma wy³¹cznoœæ na komunikaty if FMouseActiveElement = teTabs then - begin - TabMouseMove(Shift, X, Y); - end else + begin + TabMouseMove(Shift, X, Y); + end + else if FMouseActiveElement = teTabContents then - begin - if FTabIndex<>-1 then - FTabs[FTabIndex].MouseMove(Shift, X, Y); - end else + begin + if FTabIndex <> -1 then + FTabs[FTabIndex].MouseMove(Shift, X, Y); + end + else if FMouseActiveElement = teToolbarArea then - begin - // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia - end else + begin + // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia + end + else if FMouseActiveElement = teNone then - begin - // Jeœli element pod mysz¹ siê zmienia, informujemy poprzedni element o - // tym, ¿e mysz opuszcza jego obszar - if NewMouseHoverElement<>FMouseHoverElement then - begin - if FMouseHoverElement = teTabs then - begin - TabMouseLeave; - end else - if FMouseHoverElement = teTabContents then - begin - if FTabIndex<>-1 then - FTabs[FTabIndex].MouseLeave; - end else - if FMouseHoverElement = teToolbarArea then - begin - // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia - end; - end; - - // Element pod mysz¹ otrzymuje MouseMove - if NewMouseHoverElement = teTabs then - begin - TabMouseMove(Shift, X, Y); - end else - if NewMouseHoverElement = teTabContents then - begin - if FTabIndex<>-1 then - FTabs[FTabIndex].MouseMove(Shift, X, Y); - end else - if NewMouseHoverElement = teToolbarArea then - begin + begin + // Jeœli element pod mysz¹ siê zmienia, informujemy poprzedni element o + // tym, ¿e mysz opuszcza jego obszar + if NewMouseHoverElement <> FMouseHoverElement then + begin + if FMouseHoverElement = teTabs then + begin + TabMouseLeave; + end + else + if FMouseHoverElement = teTabContents then + begin + if FTabIndex <> -1 then + FTabs[FTabIndex].MouseLeave; + end + else + if FMouseHoverElement = teToolbarArea then + begin // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia - end; - end; + end; + end; -FMouseHoverElement:=NewMouseHoverElement; + // Element pod mysz¹ otrzymuje MouseMove + if NewMouseHoverElement = teTabs then + begin + TabMouseMove(Shift, X, Y); + end + else + if NewMouseHoverElement = teTabContents then + begin + if FTabIndex <> -1 then + FTabs[FTabIndex].MouseMove(Shift, X, Y); + end + else + if NewMouseHoverElement = teToolbarArea then + begin + // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia + end; + end; + + FMouseHoverElement := NewMouseHoverElement; end; -procedure TSpkToolbar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, - Y: Integer); +procedure TSpkToolbar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); -var ClearActive: Boolean; +var + ClearActive: boolean; begin // Podczas procesu przebudowy mysz jest ignorowana. if FInternalUpdating or FUpdating then - exit; + exit; inherited MouseUp(Button, Shift, X, Y); - ClearActive:=not(ssLeft in Shift) and not(ssMiddle in Shift) and not(ssRight in Shift); + ClearActive := not (ssLeft in Shift) and not (ssMiddle in Shift) and not (ssRight in Shift); // Jeœli jest jakiœ aktywny obiekt, to on ma wy³¹cznoœæ na otrzymywanie // komunikatów - if FMouseActiveElement=teTabs then - begin - TabMouseUp(Button, Shift, X, Y); - end else - if FMouseActiveElement=teTabContents then - begin - if FTabIndex<>-1 then - FTabs[FTabIndex].MouseUp(Button, Shift, X, Y); - end else + if FMouseActiveElement = teTabs then + begin + TabMouseUp(Button, Shift, X, Y); + end + else + if FMouseActiveElement = teTabContents then + begin + if FTabIndex <> -1 then + FTabs[FTabIndex].MouseUp(Button, Shift, X, Y); + end + else if FMouseActiveElement = teToolbarArea then - begin - // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia - end; + begin + // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia + end; // Jeœli puszczono ostatni przycisk i mysz nie znajduje siê nad aktywnym // obiektem, trzeba dodatkowo wywo³aæ MouseLeave dla aktywnego i MouseMove // dla obiektu pod mysz¹. - if ClearActive and (FMouseActiveElement<>FMouseHoverElement) then - begin - if FMouseActiveElement = teTabs then - TabMouseLeave else - if FMouseActiveElement = teTabContents then - begin - if FTabIndex<>-1 then - FTabs[FTabIndex].MouseLeave; - end else - if FMouseActiveElement = teToolbarArea then - begin - // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia - end; + if ClearActive and (FMouseActiveElement <> FMouseHoverElement) then + begin + if FMouseActiveElement = teTabs then + TabMouseLeave + else + if FMouseActiveElement = teTabContents then + begin + if FTabIndex <> -1 then + FTabs[FTabIndex].MouseLeave; + end + else + if FMouseActiveElement = teToolbarArea then + begin + // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia + end; - if FMouseHoverElement=teTabs then - TabMouseMove(Shift, X, Y) else - if FMouseHoverElement=teTabContents then - begin - if FTabIndex<>-1 then - FTabs[FTabIndex].MouseMove(Shift, X, Y); - end else - if FMouseHoverElement = teToolbarArea then - begin - // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia - end; - end; + if FMouseHoverElement = teTabs then + TabMouseMove(Shift, X, Y) + else + if FMouseHoverElement = teTabContents then + begin + if FTabIndex <> -1 then + FTabs[FTabIndex].MouseMove(Shift, X, Y); + end + else + if FMouseHoverElement = teToolbarArea then + begin + // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia + end; + end; // MouseUp gasi aktywny obiekt, o ile zosta³y puszczone wszystkie // przyciski if ClearActive then - FMouseActiveElement:=teNone; + FMouseActiveElement := teNone; end; -procedure TSpkToolbar.Notification(AComponent: TComponent; - Operation: TOperation); +procedure TSpkToolbar.Notification(AComponent: TComponent; Operation: TOperation); -var Tab : TSpkTab; - Pane : TSpkPane; - Item : TSpkBaseItem; +var + Tab: TSpkTab; + Pane: TSpkPane; + Item: TSpkBaseItem; begin inherited; if Operation <> opRemove then - exit; + exit; if AComponent is TSpkTab then - begin - FreeingTab(AComponent as TSpkTab); - end else + begin + FreeingTab(AComponent as TSpkTab); + end + else if AComponent is TSpkPane then - begin - Pane:=AComponent as TSpkPane; - if (Pane.Parent<>nil) and (Pane.Parent is TSpkTab) then - begin - Tab:=Pane.Parent as TSpkTab; - Tab.FreeingPane(Pane); - end; - end else + begin + Pane := AComponent as TSpkPane; + if (Pane.Parent <> nil) and (Pane.Parent is TSpkTab) then + begin + Tab := Pane.Parent as TSpkTab; + Tab.FreeingPane(Pane); + end; + end + else if AComponent is TSpkBaseItem then - begin - Item:=AComponent as TSpkBaseItem; - if (Item.Parent<>nil) and (Item.Parent is TSpkPane) then - begin - Pane:=Item.Parent as TSpkPane; - Pane.FreeingItem(Item); - end; - end; + begin + Item := AComponent as TSpkBaseItem; + if (Item.Parent <> nil) and (Item.Parent is TSpkPane) then + begin + Pane := Item.Parent as TSpkPane; + Pane.FreeingItem(Item); + end; + end; end; procedure TSpkToolbar.NotifyAppearanceChanged; begin SetMetricsInvalid; - if not(FInternalUpdating or FUpdating) then - Repaint; + if not (FInternalUpdating or FUpdating) then + Repaint; end; procedure TSpkToolbar.NotifyMetricsChanged; begin SetMetricsInvalid; - if not(FInternalUpdating or FUpdating) then - Repaint; + if not (FInternalUpdating or FUpdating) then + Repaint; end; procedure TSpkToolbar.NotifyItemsChanged; var - OldTabIndex: Integer; + OldTabIndex: integer; begin OldTabIndex := FTabIndex; // Poprawianie TabIndex o ile zachodzi taka potrzeba - if not(AtLeastOneTabVisible) then FTabIndex:=-1 + if not (AtLeastOneTabVisible) then + FTabIndex := -1 else - begin - FTabIndex:=max(0,min(FTabs.count-1,FTabIndex)); + begin + FTabIndex := max(0, min(FTabs.Count - 1, FTabIndex)); // Wiem, ¿e przynajmniej jedna zak³adka jest widoczna (z wczeœniejszego // warunku), wiêc poni¿sza pêtla na pewno siê zakoñczy. - while not(FTabs[FTabIndex].Visible) do - FTabIndex:=(FTabIndex + 1) mod FTabs.count; - end; - FTabHover:=-1; + while not (FTabs[FTabIndex].Visible) do + FTabIndex := (FTabIndex + 1) mod FTabs.Count; + end; + FTabHover := -1; - if DoTabChanging(OldTabIndex, FTabIndex) then begin + if DoTabChanging(OldTabIndex, FTabIndex) then + begin SetMetricsInvalid; - if not(FInternalUpdating or FUpdating) then - Repaint; + if not (FInternalUpdating or FUpdating) then + Repaint; - if Assigned(FOnTabChanged) then FOnTabChanged(self); - end else + if Assigned(FOnTabChanged) then + FOnTabChanged(self); + end + else FTabIndex := OldTabIndex; end; @@ -925,52 +980,57 @@ procedure TSpkToolbar.NotifyVisualsChanged; begin SetBufferInvalid; - if not(FInternalUpdating or FUpdating) then - Repaint; + if not (FInternalUpdating or FUpdating) then + Repaint; end; procedure TSpkToolbar.Paint; begin -// Jeœli trwa proces przebudowy (wewnêtrznej lub u¿ytkownika), walidacja metryk -// i bufora nie jest przeprowadzana, jednak bufor jest rysowany w takiej -// postaci, w jakiej zosta³ zapamiêtany przed rozpoczêciem procesu przebudowy. -if not(FInternalUpdating or FUpdating) then - begin - if not(FMetricsValid) then + // Jeœli trwa proces przebudowy (wewnêtrznej lub u¿ytkownika), walidacja metryk + // i bufora nie jest przeprowadzana, jednak bufor jest rysowany w takiej + // postaci, w jakiej zosta³ zapamiêtany przed rozpoczêciem procesu przebudowy. + if not (FInternalUpdating or FUpdating) then + begin + if not (FMetricsValid) then ValidateMetrics; - if not(FBufferValid) then + if not (FBufferValid) then ValidateBuffer; - end; - -self.canvas.draw(0, 0, FBuffer); + end; + self.canvas.draw(0, 0, FBuffer); end; -procedure TSpkToolbar.Resize; +procedure TSpkToolbar.DoOnResize; begin - inherited Height:=TOOLBAR_HEIGHT; + inherited Height := TOOLBAR_HEIGHT; - SetMetricsInvalid; - SetBufferInvalid; + FDelayRunTimer.Enabled := False; + FDelayRunTimer.Enabled := True; - if not(FInternalUpdating or FUpdating) then - invalidate; + if not (FInternalUpdating or FUpdating) then + invalidate; inherited; end; +procedure TSpkToolbar.EraseBackground(DC: HDC); +begin + // The correct implementation is doing nothing + inherited; +end; + procedure TSpkToolbar.SetBufferInvalid; begin -FBufferValid:=false; + FBufferValid := False; end; procedure TSpkToolbar.SetColor(const Value: TColor); begin -inherited Color:=Value; -SetBufferInvalid; + inherited Color := Value; + SetBufferInvalid; -if not(FInternalUpdating or FUpdating) then - Repaint; + if not (FInternalUpdating or FUpdating) then + Repaint; end; procedure TSpkToolbar.SetDisabledImages(const Value: TImageList); @@ -979,8 +1039,8 @@ begin FTabs.DisabledImages := Value; SetMetricsInvalid; - if not(FInternalUpdating or FUpdating) then - Repaint; + if not (FInternalUpdating or FUpdating) then + Repaint; end; procedure TSpkToolbar.SetDisabledLargeImages(const Value: TImageList); @@ -989,8 +1049,8 @@ begin FTabs.DisabledLargeImages := Value; SetMetricsInvalid; - if not(FInternalUpdating or FUpdating) then - Repaint; + if not (FInternalUpdating or FUpdating) then + Repaint; end; procedure TSpkToolbar.SetImages(const Value: TImageList); @@ -999,8 +1059,8 @@ begin FTabs.Images := Value; SetMetricsInvalid; - if not(FInternalUpdating or FUpdating) then - Repaint; + if not (FInternalUpdating or FUpdating) then + Repaint; end; procedure TSpkToolbar.SetLargeImages(const Value: TImageList); @@ -1009,11 +1069,11 @@ begin FTabs.LargeImages := Value; SetMetricsInvalid; - if not(FInternalUpdating or FUpdating) then - Repaint; + if not (FInternalUpdating or FUpdating) then + Repaint; end; -function TSpkToolbar.DoTabChanging(OldIndex, NewIndex: Integer): Boolean; +function TSpkToolbar.DoTabChanging(OldIndex, NewIndex: integer): boolean; begin Result := True; if Assigned(FOnTabChanging) then @@ -1022,143 +1082,151 @@ end; procedure TSpkToolbar.SetMetricsInvalid; begin -FMetricsValid:=false; -FBufferValid:=false; + FMetricsValid := False; + FBufferValid := False; end; procedure TSpkToolbar.SetTabIndex(const Value: integer); var - OldTabIndex: Integer; + OldTabIndex: integer; begin OldTabIndex := FTabIndex; - if not(AtLeastOneTabVisible) then FTabIndex:=-1 + if not (AtLeastOneTabVisible) then + FTabIndex := -1 else - begin - FTabIndex:=max(0,min(FTabs.count-1, Value)); + begin + FTabIndex := max(0, min(FTabs.Count - 1, Value)); // Wiem, ¿e przynajmniej jedna zak³adka jest widoczna (z wczeœniejszego // warunku), wiêc poni¿sza pêtla na pewno siê zakoñczy. - while not(FTabs[FTabIndex].Visible) do - FTabIndex:=(FTabIndex + 1) mod FTabs.count; - end; - FTabHover:=-1; + while not (FTabs[FTabIndex].Visible) do + FTabIndex := (FTabIndex + 1) mod FTabs.Count; + end; + FTabHover := -1; - if DoTabChanging(OldTabIndex, FTabIndex) then begin + if DoTabChanging(OldTabIndex, FTabIndex) then + begin SetMetricsInvalid; - if not(FInternalUpdating or FUpdating) then - Repaint; - if Assigned(FOnTabChanged) then FOnTabChanged(self); - end else + if not (FInternalUpdating or FUpdating) then + Repaint; + if Assigned(FOnTabChanged) then + FOnTabChanged(self); + end + else FTabIndex := OldTabIndex; end; -procedure TSpkToolbar.TabMouseDown(Button: TMouseButton; Shift: TShiftState; X, - Y: Integer); +procedure TSpkToolbar.TabMouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: integer); -var SelTab: Integer; - TabRect: T2DIntRect; - i: Integer; +var + SelTab: integer; + TabRect: T2DIntRect; + i: integer; begin -// Podczas procesu przebudowy mysz jest ignorowana. -if FInternalUpdating or FUpdating then - exit; + // Podczas procesu przebudowy mysz jest ignorowana. + if FInternalUpdating or FUpdating then + exit; -SelTab:=-1; -if AtLeastOneTabVisible then - for i := 0 to FTabs.count - 1 do - if FTabs[i].visible then - begin - if FTabClipRect.IntersectsWith(FTabRects[i], TabRect) then + SelTab := -1; + if AtLeastOneTabVisible then + for i := 0 to FTabs.Count - 1 do + if FTabs[i].Visible then + begin + if FTabClipRect.IntersectsWith(FTabRects[i], TabRect) then {$IFDEF EnhancedRecordSupport} - if TabRect.Contains(T2DIntPoint.Create(x, y)) then + if TabRect.Contains(T2DIntPoint.Create(x, y)) then {$ELSE} - if TabRect.Contains(x, y) then + if TabRect.Contains(x, y) then {$ENDIF} - SelTab:=i; - end; + SelTab := i; + end; -// Jeœli klikniêta zosta³a któraœ zak³adka, ró¿na od obecnie zaznaczonej, -// zmieñ zaznaczenie. -if (Button = mbLeft) and (SelTab<>-1) and (SelTab<>FTabIndex) then - begin - if DoTabChanging(FTabIndex, SelTab) then begin - FTabIndex:=SelTab; - SetMetricsInvalid; - Repaint; - if Assigned(FOnTabChanged) then FOnTabChanged(self); - end; - end; + // Jeœli klikniêta zosta³a któraœ zak³adka, ró¿na od obecnie zaznaczonej, + // zmieñ zaznaczenie. + if (Button = mbLeft) and (SelTab <> -1) and (SelTab <> FTabIndex) then + begin + if DoTabChanging(FTabIndex, SelTab) then + begin + FTabIndex := SelTab; + SetMetricsInvalid; + Repaint; + if Assigned(FOnTabChanged) then + FOnTabChanged(self); + end; + end; end; procedure TSpkToolbar.TabMouseLeave; begin -// Podczas procesu przebudowy mysz jest ignorowana. -if FInternalUpdating or FUpdating then - exit; + // Podczas procesu przebudowy mysz jest ignorowana. + if FInternalUpdating or FUpdating then + exit; -if FTabHover<>-1 then - begin - FTabHover:=-1; - SetBufferInvalid; - Repaint; - end; + if FTabHover <> -1 then + begin + FTabHover := -1; + SetBufferInvalid; + Repaint; + end; end; -procedure TSpkToolbar.TabMouseMove(Shift: TShiftState; X, Y: Integer); +procedure TSpkToolbar.TabMouseMove(Shift: TShiftState; X, Y: integer); -var NewTabHover : integer; - TabRect : T2DIntRect; - i : integer; +var + NewTabHover: integer; + TabRect: T2DIntRect; + i: integer; begin -// Podczas procesu przebudowy mysz jest ignorowana. -if FInternalUpdating or FUpdating then - exit; + // Podczas procesu przebudowy mysz jest ignorowana. + if FInternalUpdating or FUpdating then + exit; -NewTabHover:=-1; -if AtLeastOneTabVisible then - for i := 0 to FTabs.count - 1 do - if FTabs[i].Visible then - begin - if FTabClipRect.IntersectsWith(FTabRects[i], TabRect) then + NewTabHover := -1; + if AtLeastOneTabVisible then + for i := 0 to FTabs.Count - 1 do + if FTabs[i].Visible then + begin + if FTabClipRect.IntersectsWith(FTabRects[i], TabRect) then {$IFDEF EnhancedRecordSupport} - if TabRect.Contains(T2DIntPoint.Create(x, y)) then + if TabRect.Contains(T2DIntPoint.Create(x, y)) then {$ELSE} - if TabRect.Contains(x, y) then + if TabRect.Contains(x, y) then {$ENDIF} - NewTabHover:=i; - end; + NewTabHover := i; + end; -if NewTabHover<>FTabHover then - begin - FTabHover:=NewTabHover; - SetBufferInvalid; - Repaint; - end; + if NewTabHover <> FTabHover then + begin + FTabHover := NewTabHover; + SetBufferInvalid; + Repaint; + end; end; -procedure TSpkToolbar.TabMouseUp(Button: TMouseButton; Shift: TShiftState; X, - Y: Integer); +procedure TSpkToolbar.TabMouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: integer); begin -// Podczas procesu przebudowy mysz jest ignorowana. -if FInternalUpdating or FUpdating then - exit; + // Podczas procesu przebudowy mysz jest ignorowana. + if FInternalUpdating or FUpdating then + exit; -if (FTabIndex > -1) then - FTabs[FTabIndex].ExecOnClick; + if (FTabIndex > -1) then + FTabs[FTabIndex].ExecOnClick; -// Zak³adki nie potrzebuj¹ obs³ugi MouseUp. + // Zak³adki nie potrzebuj¹ obs³ugi MouseUp. end; procedure TSpkToolbar.SetAppearance(const Value: TSpkToolbarAppearance); begin - FAppearance.assign(Value); + FAppearance.Assign(Value); SetBufferInvalid; - if not(FInternalUpdating or FUpdating) then - Repaint; + if not (FInternalUpdating or FUpdating) then + Repaint; end; procedure TSpkToolbar.ValidateBuffer; @@ -1166,471 +1234,511 @@ procedure TSpkToolbar.ValidateBuffer; procedure DrawBackgroundColor; begin - FBuffer.canvas.brush.color:=Color; - FBuffer.canvas.brush.style:=bsSolid; - FBuffer.canvas.fillrect(Rect(0, 0, self.width, self.height)); + FBuffer.canvas.brush.color := Color; + FBuffer.canvas.brush.style := bsSolid; + FBuffer.canvas.fillrect(Rect(0, 0, self.Width, self.Height)); end; procedure DrawBody; - var FocusedAppearance : TSpkToolbarAppearance; - i: Integer; + var + FocusedAppearance: TSpkToolbarAppearance; + i: integer; begin - // Pobieramy appearance aktualnie zaznaczonej zak³adki (b¹dŸ - // FToolbarAppearance, jeœli zaznaczona zak³adka nie ma ustawionego - // OverrideAppearance - if (FTabIndex<>-1) and (FTabs[FTabIndex].OverrideAppearance) then - FocusedAppearance:=FTabs[FTabIndex].CustomAppearance else - FocusedAppearance:=FAppearance; + // Pobieramy appearance aktualnie zaznaczonej zak³adki (b¹dŸ + // FToolbarAppearance, jeœli zaznaczona zak³adka nie ma ustawionego + // OverrideAppearance + if (FTabIndex <> -1) and (FTabs[FTabIndex].OverrideAppearance) then + FocusedAppearance := FTabs[FTabIndex].CustomAppearance + else + FocusedAppearance := FAppearance; - TGuiTools.DrawRoundRect(FBuffer.Canvas, + TGuiTools.DrawRoundRect(FBuffer.Canvas, {$IFDEF EnhancedRecordSupport} - T2DIntRect.Create(0, - TOOLBAR_TAB_CAPTIONS_HEIGHT, - self.width-1, - self.Height-1), + T2DIntRect.Create(0, + TOOLBAR_TAB_CAPTIONS_HEIGHT, + self.Width - 1, + self.Height - 1), {$ELSE} - Create2DIntRect(0, - TOOLBAR_TAB_CAPTIONS_HEIGHT, - self.width-1, - self.Height-1), + Create2DIntRect(0, + TOOLBAR_TAB_CAPTIONS_HEIGHT, + self.Width - 1, + self.Height - 1), {$ENDIF} - TOOLBAR_CORNER_RADIUS, - FocusedAppearance.Tab.GradientFromColor, - FocusedAppearance.Tab.GradientToColor, - FocusedAppearance.Tab.GradientType); - TGuiTools.DrawAARoundCorner(FBuffer, + TOOLBAR_CORNER_RADIUS, + FocusedAppearance.Tab.GradientFromColor, + FocusedAppearance.Tab.GradientToColor, + FocusedAppearance.Tab.GradientType); + TGuiTools.DrawAARoundCorner(FBuffer, {$IFDEF EnhancedRecordSupport} - T2DIntPoint.Create(0, TOOLBAR_TAB_CAPTIONS_HEIGHT), + T2DIntPoint.Create(0, TOOLBAR_TAB_CAPTIONS_HEIGHT), {$ELSE} - Create2DIntPoint(0, TOOLBAR_TAB_CAPTIONS_HEIGHT), + Create2DIntPoint(0, TOOLBAR_TAB_CAPTIONS_HEIGHT), {$ENDIF} - TOOLBAR_CORNER_RADIUS, - cpLeftTop, - FocusedAppearance.Tab.BorderColor); - TGuiTools.DrawAARoundCorner(FBuffer, + TOOLBAR_CORNER_RADIUS, + cpLeftTop, + FocusedAppearance.Tab.BorderColor); + TGuiTools.DrawAARoundCorner(FBuffer, {$IFDEF EnhancedRecordSupport} - T2DIntPoint.Create(self.width - TOOLBAR_CORNER_RADIUS, TOOLBAR_TAB_CAPTIONS_HEIGHT), + T2DIntPoint.Create(self.Width - + TOOLBAR_CORNER_RADIUS, TOOLBAR_TAB_CAPTIONS_HEIGHT), {$ELSE} - Create2DIntPoint(self.width - TOOLBAR_CORNER_RADIUS, TOOLBAR_TAB_CAPTIONS_HEIGHT), + Create2DIntPoint(self.Width - + TOOLBAR_CORNER_RADIUS, TOOLBAR_TAB_CAPTIONS_HEIGHT), {$ENDIF} - TOOLBAR_CORNER_RADIUS, - cpRightTop, - FocusedAppearance.Tab.BorderColor); - TGuiTools.DrawAARoundCorner(FBuffer, + TOOLBAR_CORNER_RADIUS, + cpRightTop, + FocusedAppearance.Tab.BorderColor); + TGuiTools.DrawAARoundCorner(FBuffer, {$IFDEF EnhancedRecordSupport} - T2DIntPoint.Create(0, self.height - TOOLBAR_CORNER_RADIUS), + T2DIntPoint.Create(0, self.Height - TOOLBAR_CORNER_RADIUS), {$ELSE} - Create2DIntPoint(0, self.height - TOOLBAR_CORNER_RADIUS), + Create2DIntPoint(0, self.Height - TOOLBAR_CORNER_RADIUS), {$ENDIF} - TOOLBAR_CORNER_RADIUS, - cpLeftBottom, - FocusedAppearance.Tab.BorderColor); - TGuiTools.DrawAARoundCorner(FBuffer, + TOOLBAR_CORNER_RADIUS, + cpLeftBottom, + FocusedAppearance.Tab.BorderColor); + TGuiTools.DrawAARoundCorner(FBuffer, {$IFDEF EnhancedRecordSupport} - T2DIntPoint.Create(self.width - TOOLBAR_CORNER_RADIUS, self.height - TOOLBAR_CORNER_RADIUS), + T2DIntPoint.Create(self.Width - + TOOLBAR_CORNER_RADIUS, self.Height - TOOLBAR_CORNER_RADIUS), {$ELSE} - Create2DIntPoint(self.width - TOOLBAR_CORNER_RADIUS, self.height - TOOLBAR_CORNER_RADIUS), + Create2DIntPoint(self.Width - + TOOLBAR_CORNER_RADIUS, self.Height - TOOLBAR_CORNER_RADIUS), {$ENDIF} - TOOLBAR_CORNER_RADIUS, - cpRightBottom, - FocusedAppearance.Tab.BorderColor); - TGuiTools.DrawVLine(FBuffer, 0, TOOLBAR_TAB_CAPTIONS_HEIGHT + TOOLBAR_CORNER_RADIUS, self.height - TOOLBAR_CORNER_RADIUS, FocusedAppearance.Tab.BorderColor); - TGuiTools.DrawHLine(FBuffer, TOOLBAR_CORNER_RADIUS, self.Width-TOOLBAR_CORNER_RADIUS, self.height-1, FocusedAppearance.Tab.BorderColor); - TGuiTools.DrawVLine(FBuffer, self.width-1, TOOLBAR_TAB_CAPTIONS_HEIGHT + TOOLBAR_CORNER_RADIUS, self.height - TOOLBAR_CORNER_RADIUS, FocusedAppearance.Tab.BorderColor); + TOOLBAR_CORNER_RADIUS, + cpRightBottom, + FocusedAppearance.Tab.BorderColor); + TGuiTools.DrawVLine(FBuffer, 0, TOOLBAR_TAB_CAPTIONS_HEIGHT + + TOOLBAR_CORNER_RADIUS, self.Height - TOOLBAR_CORNER_RADIUS, + FocusedAppearance.Tab.BorderColor); + TGuiTools.DrawHLine(FBuffer, TOOLBAR_CORNER_RADIUS, self.Width - TOOLBAR_CORNER_RADIUS, + self.Height - 1, FocusedAppearance.Tab.BorderColor); + TGuiTools.DrawVLine(FBuffer, self.Width - 1, TOOLBAR_TAB_CAPTIONS_HEIGHT + + TOOLBAR_CORNER_RADIUS, self.Height - TOOLBAR_CORNER_RADIUS, + FocusedAppearance.Tab.BorderColor); - if not(AtLeastOneTabVisible) then - begin - // Jeœli nie ma zak³adek, rysujemy poziom¹ liniê - TGuiTools.DrawHLine(FBuffer, TOOLBAR_CORNER_RADIUS, self.width - TOOLBAR_CORNER_RADIUS, TOOLBAR_TAB_CAPTIONS_HEIGHT, FocusedAppearance.Tab.BorderColor); - end - else - begin - // Jeœli s¹, pozostawiamy miejsce na zak³adki - // Szukamy ostatniej widocznej - i:=FTabs.count-1; - while not(FTabs[i].Visible) do - dec(i); + if not (AtLeastOneTabVisible) then + begin + // Jeœli nie ma zak³adek, rysujemy poziom¹ liniê + TGuiTools.DrawHLine(FBuffer, TOOLBAR_CORNER_RADIUS, self.Width - + TOOLBAR_CORNER_RADIUS, TOOLBAR_TAB_CAPTIONS_HEIGHT, FocusedAppearance.Tab.BorderColor); + end + else + begin + // Jeœli s¹, pozostawiamy miejsce na zak³adki + // Szukamy ostatniej widocznej + i := FTabs.Count - 1; + while not (FTabs[i].Visible) do + Dec(i); - // Tylko prawa czêœæ, reszta bêdzie narysowana wraz z zak³adkami - if FTabRects[i].Right-1) and (FTabs[FTabIndex].OverrideAppearance) then - FocusedAppearance:=FTabs[FTabIndex].CustomAppearance else - FocusedAppearance:=FAppearance; + // Pobieramy appearance aktualnie zaznaczonej zak³adki (jej appearance, jeœli + // ma zapalon¹ flagê OverrideAppearance, FToolbarAppearance w przeciwnym + // wypadku) + if (FTabIndex <> -1) and (FTabs[FTabIndex].OverrideAppearance) then + FocusedAppearance := FTabs[FTabIndex].CustomAppearance + else + FocusedAppearance := FAppearance; - if FTabs.count>0 then - for i := 0 to FTabs.count - 1 do - if FTabs[i].Visible then + if FTabs.Count > 0 then + for i := 0 to FTabs.Count - 1 do + if FTabs[i].Visible then + begin + // Jest sens rysowaæ? + if not (FTabClipRect.IntersectsWith(FTabRects[i])) then + continue; + + // Pobieramy appearance rysowanej w³aœnie zak³adki + if (FTabs[i].OverrideAppearance) then + CurrentAppearance := FTabs[i].CustomAppearance + else + CurrentAppearance := FAppearance; + + TabRect := FTabRects[i]; + + // Rysujemy zak³adkê + if i = FTabIndex then + begin + if i = FTabHover then begin - // Jest sens rysowaæ? - if not(FTabClipRect.IntersectsWith(FTabRects[i])) then - continue; - - // Pobieramy appearance rysowanej w³aœnie zak³adki - if (FTabs[i].OverrideAppearance) then - CurrentAppearance:=FTabs[i].CustomAppearance else - CurrentAppearance:=FAppearance; - - TabRect:=FTabRects[i]; - - // Rysujemy zak³adkê - if i = FTabIndex then - begin - if i = FTabHover then - begin - DrawTab(i, - CurrentAppearance.Tab.BorderColor, - TColorTools.Brighten(TColorTools.Brighten(CurrentAppearance.Tab.GradientFromColor, 50),50), - CurrentAppearance.Tab.GradientFromColor, - CurrentAppearance.Tab.TabHeaderFont.Color); - end - else - begin - DrawTab(i, - CurrentAppearance.Tab.BorderColor, - TColorTools.Brighten(CurrentAppearance.Tab.GradientFromColor, 50), - CurrentAppearance.Tab.GradientFromColor, - CurrentAppearance.Tab.TabHeaderFont.color); - end; - - DrawTabText(i, CurrentAppearance.Tab.TabHeaderFont); - end + DrawTab(i, + CurrentAppearance.Tab.BorderColor, + TColorTools.Brighten(TColorTools.Brighten( + CurrentAppearance.Tab.GradientFromColor, 50), 50), + CurrentAppearance.Tab.GradientFromColor, + CurrentAppearance.Tab.TabHeaderFont.Color); + end else - begin - if i = FTabHover then - begin - DrawTab(i, - TColorTools.Shade(self.Color,CurrentAppearance.Tab.BorderColor,50), - TColorTools.Shade(self.color,TColorTools.brighten(CurrentAppearance.Tab.GradientFromColor,50),50), - TColorTools.Shade(self.color,CurrentAppearance.Tab.GradientFromColor, 50), - CurrentAppearance.Tab.TabHeaderFont.color); - end; - - // Dolna kreska - // Uwaga: Niezale¿nie od zak³adki rysowana kolorem appearance - // aktualnie zaznaczonej zak³adki! - DrawBottomLine(i, FocusedAppearance.Tab.BorderColor); - - // Tekst - DrawTabText(i, CurrentAppearance.Tab.TabHeaderFont); - end; + begin + DrawTab(i, + CurrentAppearance.Tab.BorderColor, + TColorTools.Brighten( + CurrentAppearance.Tab.GradientFromColor, 50), + CurrentAppearance.Tab.GradientFromColor, + CurrentAppearance.Tab.TabHeaderFont.color); end; + + DrawTabText(i, CurrentAppearance.Tab.TabHeaderFont); + end + else + begin + if i = FTabHover then + begin + DrawTab(i, + TColorTools.Shade( + self.Color, CurrentAppearance.Tab.BorderColor, 50), + TColorTools.Shade(self.color, TColorTools.brighten( + CurrentAppearance.Tab.GradientFromColor, 50), 50), + TColorTools.Shade( + self.color, CurrentAppearance.Tab.GradientFromColor, 50), + CurrentAppearance.Tab.TabHeaderFont.color); + end; + + // Dolna kreska + // Uwaga: Niezale¿nie od zak³adki rysowana kolorem appearance + // aktualnie zaznaczonej zak³adki! + DrawBottomLine(i, FocusedAppearance.Tab.BorderColor); + + // Tekst + DrawTabText(i, CurrentAppearance.Tab.TabHeaderFont); + end; + end; end; procedure DrawTabContents; begin - if FTabIndex<>-1 then - FTabs[FTabIndex].Draw(FBuffer, FTabContentsClipRect); + if FTabIndex <> -1 then + FTabs[FTabIndex].Draw(FBuffer, FTabContentsClipRect); end; begin -if FInternalUpdating or FUpdating then - exit; -if FBufferValid then - exit; + if FInternalUpdating or FUpdating then + exit; + if FBufferValid then + exit; -// ValidateBuffer mo¿e byæ wywo³ane tylko wtedy, gdy metrics zosta³y obliczone. -// Metoda zak³ada, ¿e bufor ma ju¿ odpowiednie rozmiary oraz ¿e wszystkie -// recty, zarówno toolbara jak i elementów podrzêdnych, zosta³y poprawnie -// obliczone. + // ValidateBuffer mo¿e byæ wywo³ane tylko wtedy, gdy metrics zosta³y obliczone. + // Metoda zak³ada, ¿e bufor ma ju¿ odpowiednie rozmiary oraz ¿e wszystkie + // recty, zarówno toolbara jak i elementów podrzêdnych, zosta³y poprawnie + // obliczone. -// *** T³o komponentu *** -DrawBackgroundColor; + // *** T³o komponentu *** + DrawBackgroundColor; -// *** Generowanie t³a dla toolbara *** -DrawBody; + // *** Generowanie t³a dla toolbara *** + DrawBody; -// *** Zak³adki *** -DrawTabs; + // *** Zak³adki *** + DrawTabs; -// *** Zawartoœæ zak³adek *** -DrawTabContents; + // *** Zawartoœæ zak³adek *** + DrawTabContents; -// Bufor jest poprawny -FBufferValid:=true; + // Bufor jest poprawny + FBufferValid := True; end; procedure TSpkToolbar.ValidateMetrics; -var i : integer; - x : integer; - TabWidth: Integer; - TabAppearance : TSpkToolbarAppearance; +var + i: integer; + x: integer; + TabWidth: integer; + TabAppearance: TSpkToolbarAppearance; begin -if FInternalUpdating or FUpdating then - exit; -if FMetricsValid then - exit; + if FInternalUpdating or FUpdating then + exit; + if FMetricsValid then + exit; -FBuffer.SetSize(self.width, self.height); + FBuffer.SetSize(self.Width, self.Height); -// *** Zak³adki *** + // *** Zak³adki *** -// Cliprect zak³adek (zawgórn¹ ramkê komponentu) + // Cliprect zak³adek (zawgórn¹ ramkê komponentu) {$IFDEF EnhancedRecordSupport} -FTabClipRect:=T2DIntRect.Create(TOOLBAR_CORNER_RADIUS, - 0, - self.width - TOOLBAR_CORNER_RADIUS - 1, - TOOLBAR_TAB_CAPTIONS_HEIGHT); + FTabClipRect := T2DIntRect.Create(TOOLBAR_CORNER_RADIUS, + 0, self.Width - + TOOLBAR_CORNER_RADIUS - 1, TOOLBAR_TAB_CAPTIONS_HEIGHT); {$ELSE} -FTabClipRect.Create(TOOLBAR_CORNER_RADIUS, - 0, - self.width - TOOLBAR_CORNER_RADIUS - 1, - TOOLBAR_TAB_CAPTIONS_HEIGHT); + FTabClipRect.Create(TOOLBAR_CORNER_RADIUS, + 0, + self.Width - TOOLBAR_CORNER_RADIUS - 1, + TOOLBAR_TAB_CAPTIONS_HEIGHT); {$ENDIF} -// Recty nag³ówków zak³adek (zawieraj¹ górn¹ ramkê komponentu) -setlength(FTabRects, FTabs.Count); -if FTabs.count>0 then - begin - x:=TOOLBAR_CORNER_RADIUS; - for i := 0 to FTabs.count - 1 do - if FTabs[i].Visible then - begin - // Pobieramy appearance zak³adki - if FTabs[i].OverrideAppearance then - TabAppearance:=FTabs[i].CustomAppearance else - TabAppearance:=FAppearance; - FBuffer.Canvas.font.assign(TabAppearance.Tab.TabHeaderFont); + // Recty nag³ówków zak³adek (zawieraj¹ górn¹ ramkê komponentu) + setlength(FTabRects, FTabs.Count); + if FTabs.Count > 0 then + begin + x := TOOLBAR_CORNER_RADIUS; + for i := 0 to FTabs.Count - 1 do + if FTabs[i].Visible then + begin + // Pobieramy appearance zak³adki + if FTabs[i].OverrideAppearance then + TabAppearance := FTabs[i].CustomAppearance + else + TabAppearance := FAppearance; + FBuffer.Canvas.font.Assign(TabAppearance.Tab.TabHeaderFont); - TabWidth:=2 + // Ramka - 2*TAB_CORNER_RADIUS + // Zaokr¹glenia - 2*TOOLBAR_TAB_CAPTIONS_TEXT_HPADDING + // Wewnêtrzne marginesy - max(TOOLBAR_MIN_TAB_CAPTION_WIDTH, - FBuffer.Canvas.TextWidth(FTabs.Items[i].Caption)); // Szerokoœæ tekstu + TabWidth := 2 + // Ramka + 2 * TAB_CORNER_RADIUS + + // Zaokr¹glenia + 2 * TOOLBAR_TAB_CAPTIONS_TEXT_HPADDING + + // Wewnêtrzne marginesy + max(TOOLBAR_MIN_TAB_CAPTION_WIDTH, + FBuffer.Canvas.TextWidth(FTabs.Items[i].Caption)); + // Szerokoœæ tekstu - FTabRects[i].Left:=x; - FTabRects[i].Right:=x + TabWidth - 1; - FTabRects[i].Top:=0; - FTabRects[i].Bottom:=TOOLBAR_TAB_CAPTIONS_HEIGHT; + FTabRects[i].Left := x; + FTabRects[i].Right := x + TabWidth - 1; + FTabRects[i].Top := 0; + FTabRects[i].Bottom := TOOLBAR_TAB_CAPTIONS_HEIGHT; - x:=FTabRects[i].right+1; - end - else - begin + x := FTabRects[i].right + 1; + end + else + begin {$IFDEF EnhancedRecordSupport} - FTabRects[i]:=T2DIntRect.Create(-1,-1,-1,-1); + FTabRects[i] := T2DIntRect.Create(-1, -1, -1, -1); {$ELSE} - FTabRects[i].Create(-1,-1,-1,-1); + FTabRects[i].Create(-1, -1, -1, -1); {$ENDIF} - end; - end; + end; + end; -// *** Tafle *** + // *** Tafle *** -if FTabIndex<>-1 then - begin - // Rect obszaru zak³adki + if FTabIndex <> -1 then + begin + // Rect obszaru zak³adki {$IFDEF EnhancedRecordSupport} - FTabContentsClipRect:=T2DIntRect.Create(TOOLBAR_BORDER_WIDTH + TAB_PANE_LEFTPADDING, - TOOLBAR_TAB_CAPTIONS_HEIGHT + TOOLBAR_BORDER_WIDTH + TAB_PANE_TOPPADDING, - self.width - 1 - TOOLBAR_BORDER_WIDTH - TAB_PANE_RIGHTPADDING, - self.Height - 1 - TOOLBAR_BORDER_WIDTH - TAB_PANE_BOTTOMPADDING); + FTabContentsClipRect := T2DIntRect.Create(TOOLBAR_BORDER_WIDTH + + TAB_PANE_LEFTPADDING, TOOLBAR_TAB_CAPTIONS_HEIGHT + + TOOLBAR_BORDER_WIDTH + TAB_PANE_TOPPADDING, + self.Width - 1 - TOOLBAR_BORDER_WIDTH - + TAB_PANE_RIGHTPADDING, self.Height - + 1 - TOOLBAR_BORDER_WIDTH - TAB_PANE_BOTTOMPADDING); {$ELSE} - FTabContentsClipRect.Create(TOOLBAR_BORDER_WIDTH + TAB_PANE_LEFTPADDING, - TOOLBAR_TAB_CAPTIONS_HEIGHT + TOOLBAR_BORDER_WIDTH + TAB_PANE_TOPPADDING, - self.width - 1 - TOOLBAR_BORDER_WIDTH - TAB_PANE_RIGHTPADDING, - self.Height - 1 - TOOLBAR_BORDER_WIDTH - TAB_PANE_BOTTOMPADDING); + FTabContentsClipRect.Create(TOOLBAR_BORDER_WIDTH + TAB_PANE_LEFTPADDING, + TOOLBAR_TAB_CAPTIONS_HEIGHT + + TOOLBAR_BORDER_WIDTH + TAB_PANE_TOPPADDING, + self.Width - 1 - TOOLBAR_BORDER_WIDTH - + TAB_PANE_RIGHTPADDING, + self.Height - 1 - TOOLBAR_BORDER_WIDTH - + TAB_PANE_BOTTOMPADDING); {$ENDIF} - FTabs[FTabIndex].Rect:=FTabContentsClipRect; - end; + FTabs[FTabIndex].Rect := FTabContentsClipRect; + end; -FMetricsValid:=true; + FMetricsValid := True; end; end.