1156 lines
32 KiB
ObjectPascal
1156 lines
32 KiB
ObjectPascal
unit spkt_Pane;
|
|
|
|
{$mode delphi}
|
|
{.$Define EnhancedRecordSupport}
|
|
|
|
(*******************************************************************************
|
|
* *
|
|
* File: spkt_Pane.pas *
|
|
* Description: The component of the toolbar panel *
|
|
* Copyright: (c) 2009 by Spook. *
|
|
* License: Modified LGPL (with linking exception, like Lazarus LCL) *
|
|
' See "license.txt" in this installation *
|
|
* *
|
|
*******************************************************************************)
|
|
|
|
interface
|
|
|
|
uses
|
|
Graphics, Controls, Classes, SysUtils, Math, Dialogs,
|
|
SpkGraphTools, SpkGUITools, SpkMath,
|
|
spkt_Appearance, spkt_Const, spkt_Dispatch, spkt_Exceptions,
|
|
spkt_BaseItem, spkt_Items, spkt_Types;
|
|
|
|
type
|
|
TSpkPaneState = (psIdle, psHover);
|
|
|
|
TSpkMousePaneElementType = (peNone, pePaneArea, peItem);
|
|
|
|
TSpkMousePaneElement = record
|
|
ElementType: TSpkMousePaneElementType;
|
|
ElementIndex: integer;
|
|
end;
|
|
|
|
T2DIntRectArray = array of T2DIntRect;
|
|
|
|
TSpkPaneItemsLayout = record
|
|
Rects: T2DIntRectArray;
|
|
Width: integer;
|
|
end;
|
|
|
|
TSpkPane = class;
|
|
|
|
TSpkPane = class(TSpkComponent)
|
|
private
|
|
FPaneState: TSpkPaneState;
|
|
FMouseHoverElement: TSpkMousePaneElement;
|
|
FMouseActiveElement: TSpkMousePaneElement;
|
|
protected
|
|
FCaption: string;
|
|
FRect: T2DIntRect;
|
|
FToolbarDispatch: TSpkBaseToolbarDispatch;
|
|
FAppearance: TSpkToolbarAppearance;
|
|
FImages: TImageList;
|
|
FDisabledImages: TImageList;
|
|
FLargeImages: TImageList;
|
|
FDisabledLargeImages: TImageList;
|
|
FImagesWidth: Integer;
|
|
FLargeImagesWidth: Integer;
|
|
FVisible: boolean;
|
|
FItems: TSpkItems;
|
|
|
|
// *** Generating a layout of elements ***
|
|
function GenerateLayout: TSpkPaneItemsLayout;
|
|
|
|
// *** Designtime and LFM support ***
|
|
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
|
|
procedure DefineProperties(Filer : TFiler); override;
|
|
procedure Loaded; override;
|
|
|
|
// *** Getters and setters ***
|
|
procedure SetCaption(const Value: string);
|
|
procedure SetVisible(const Value: boolean);
|
|
procedure SetAppearance(const Value: TSpkToolbarAppearance);
|
|
procedure SetImages(const Value: TImageList);
|
|
procedure SetDisabledImages(const Value: TImageList);
|
|
procedure SetLargeImages(const Value: TImageList);
|
|
procedure SetDisabledLargeImages(const Value: TImageList);
|
|
procedure SetImagesWidth(const Value: Integer);
|
|
procedure SetLargeImagesWidth(const Value: Integer);
|
|
procedure SetRect(ARect : T2DIntRect);
|
|
procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch);
|
|
|
|
public
|
|
// *** Constructor, destructor ***
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
// *** Mouse support ***
|
|
procedure MouseLeave;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
procedure MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
|
|
// *** Geometry and drawing ***
|
|
function GetWidth: integer;
|
|
procedure Draw(ABuffer: TBitmap; ClipRect: T2DIntRect);
|
|
function FindItemAt(x, y: integer): integer;
|
|
|
|
// *** Support for elements ***
|
|
procedure FreeingItem(AItem: TSpkBaseItem);
|
|
|
|
property ToolbarDispatch: TSpkBaseToolbarDispatch read FToolbarDispatch write SetToolbarDispatch;
|
|
property Appearance: TSpkToolbarAppearance read FAppearance write SetAppearance;
|
|
property Rect: T2DIntRect read FRect write SetRect;
|
|
property Images: TImageList read FImages write SetImages;
|
|
property DisabledImages: TImageList read FDisabledImages write SetDisabledImages;
|
|
property LargeImages: TImageList read FLargeImages write SetLargeImages;
|
|
property DisabledLargeImages: TImageList read FDisabledLargeImages write SetDisabledLargeImages;
|
|
property ImagesWidth: Integer read FImagesWidth write SetImagesWidth;
|
|
property LargeImagesWidth: Integer read FLargeImagesWidth write SetLargeImagesWidth;
|
|
property Items: TSpkItems read FItems;
|
|
|
|
published
|
|
property Caption: string read FCaption write SetCaption;
|
|
property Visible: boolean read FVisible write SetVisible default true;
|
|
end;
|
|
|
|
TSpkPanes = class(TSpkCollection)
|
|
private
|
|
protected
|
|
FToolbarDispatch: TSpkBaseToolbarDispatch;
|
|
FAppearance: TSpkToolbarAppearance;
|
|
FImages: TImageList;
|
|
FDisabledImages: TImageList;
|
|
FLargeImages: TImageList;
|
|
FDisabledLargeImages: TImageList;
|
|
FImagesWidth: Integer;
|
|
FLargeImagesWidth: Integer;
|
|
|
|
// *** Getters and setters ***
|
|
procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch);
|
|
function GetItems(AIndex: integer): TSpkPane; reintroduce;
|
|
procedure SetAppearance(const Value: TSpkToolbarAppearance);
|
|
procedure SetImages(const Value: TImageList);
|
|
procedure SetDisabledImages(const Value: TImageList);
|
|
procedure SetLargeImages(const Value: TImageList);
|
|
procedure SetDisabledLargeImages(const Value: TImageList);
|
|
procedure SetImagesWidth(const Value: Integer);
|
|
procedure SetLargeImagesWidth(const Value: Integer);
|
|
|
|
public
|
|
// *** Adding and inserting elements ***
|
|
function Add: TSpkPane;
|
|
function Insert(AIndex: integer): TSpkPane;
|
|
|
|
// *** Reaction to changes in the list ***
|
|
procedure Notify(Item: TComponent; Operation: TOperation); override;
|
|
procedure Update; override;
|
|
|
|
property Items[index: integer]: TSpkPane read GetItems; default;
|
|
property ToolbarDispatch: TSpkBaseToolbarDispatch read FToolbarDispatch write SetToolbarDispatch;
|
|
property Appearance: TSpkToolbarAppearance read FAppearance write SetAppearance;
|
|
property Images: TImageList read FImages write SetImages;
|
|
property DisabledImages: TImageList read FDisabledImages write SetDisabledImages;
|
|
property LargeImages: TImageList read FLargeImages write SetLargeImages;
|
|
property DisabledLargeImages: TImageList read FDisabledLargeImages write SetDisabledLargeImages;
|
|
property ImagesWidth: Integer read FImagesWidth write SetImagesWidth;
|
|
property LargeImagesWidth: Integer read FLargeImagesWidth write SetLargeImagesWidth;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
{ TSpkPane }
|
|
|
|
constructor TSpkPane.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
FPaneState := psIdle;
|
|
FMouseHoverElement.ElementType := peNone;
|
|
FMouseHoverElement.ElementIndex := -1;
|
|
FMouseActiveElement.ElementType := peNone;
|
|
FMouseActiveElement.ElementIndex := -1;
|
|
|
|
FCaption := 'Pane';
|
|
{$IFDEF EnhancedRecordSupport}
|
|
FRect := T2DIntRect.Create(0,0,0,0);
|
|
{$ELSE}
|
|
FRect.Create(0,0,0,0);
|
|
{$ENDIF}
|
|
FToolbarDispatch := nil;
|
|
FAppearance := nil;
|
|
FImages := nil;
|
|
FDisabledImages := nil;
|
|
FLargeImages := nil;
|
|
FDisabledLargeImages := nil;
|
|
|
|
FVisible := true;
|
|
|
|
FItems := TSpkItems.Create(self);
|
|
FItems.ToolbarDispatch := FToolbarDispatch;
|
|
FItems.Appearance := FAppearance;
|
|
FItems.ImagesWidth := FImagesWidth;
|
|
FItems.LargeImagesWidth := FLargeImagesWidth;
|
|
end;
|
|
|
|
destructor TSpkPane.Destroy;
|
|
begin
|
|
FItems.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TSpkPane.SetRect(ARect: T2DIntRect);
|
|
var
|
|
Pt: T2DIntPoint;
|
|
i: integer;
|
|
Layout: TSpkPaneItemsLayout;
|
|
begin
|
|
FRect := ARect;
|
|
|
|
// Obliczamy layout
|
|
Layout := GenerateLayout;
|
|
|
|
{$IFDEF EnhancedRecordSupport}
|
|
Pt := T2DIntPoint.Create(
|
|
{$ELSE}
|
|
Pt.Create(
|
|
{$ENDIF}
|
|
ARect.Left + PaneBorderSize + PaneLeftPadding,
|
|
ARect.Top + PaneBorderSize
|
|
);
|
|
|
|
if Length(Layout.Rects) > 0 then
|
|
begin
|
|
for i := 0 to High(Layout.Rects) do
|
|
FItems[i].Rect:=Layout.Rects[i] + Pt;
|
|
end;
|
|
end;
|
|
|
|
procedure TSpkPane.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch);
|
|
begin
|
|
FToolbarDispatch := Value;
|
|
FItems.ToolbarDispatch := FToolbarDispatch;
|
|
end;
|
|
|
|
|
|
procedure TSpkPane.DefineProperties(Filer: TFiler);
|
|
begin
|
|
inherited DefineProperties(Filer);
|
|
Filer.DefineProperty('Items', FItems.ReadNames, FItems.WriteNames, true);
|
|
end;
|
|
|
|
procedure TSpkPane.Draw(ABuffer: TBitmap; ClipRect: T2DIntRect);
|
|
var
|
|
x: Integer;
|
|
y: Integer;
|
|
BgFromColor, BgToColor, CaptionColor: TColor;
|
|
FontColor, BorderLightColor, BorderDarkColor, c: TColor;
|
|
i: Integer;
|
|
R: T2DIntRect;
|
|
delta: Integer;
|
|
begin
|
|
// Under some conditions, we are not able to draw::
|
|
// * No dispatcher
|
|
if FToolbarDispatch = nil then
|
|
exit;
|
|
|
|
// * No appearance
|
|
if FAppearance = nil then
|
|
exit;
|
|
|
|
if FPaneState = psIdle then
|
|
begin
|
|
// psIdle
|
|
BgFromColor := FAppearance.Pane.GradientFromColor;
|
|
BgToColor := FAppearance.Pane.GradientToColor;
|
|
CaptionColor := FAppearance.Pane.CaptionBgColor;
|
|
FontColor := FAppearance.Pane.CaptionFont.Color;
|
|
BorderLightColor := FAppearance.Pane.BorderLightColor;
|
|
BorderDarkColor := FAppearance.Pane.BorderDarkColor;
|
|
end else
|
|
begin
|
|
// psHover
|
|
delta := FAppearance.Pane.HotTrackBrightnessChange;
|
|
BgFromColor := TColorTools.Brighten(FAppearance.Pane.GradientFromColor, delta);
|
|
BgToColor := TColorTools.Brighten(FAppearance.Pane.GradientToColor, delta);
|
|
CaptionColor := TColorTools.Brighten(FAppearance.Pane.CaptionBgColor, delta);
|
|
FontColor := TColorTools.Brighten(FAppearance.Pane.CaptionFont.Color, delta);
|
|
BorderLightColor := TColorTools.Brighten(FAppearance.Pane.BorderLightColor, delta);
|
|
BorderDarkColor := TColorTools.Brighten(FAppearance.Pane.BorderDarkColor, delta);
|
|
end;
|
|
|
|
// The background
|
|
{$IFDEF EnhancedRecordSupport}
|
|
R := T2DIntRect.Create(
|
|
{$ELSE}
|
|
R := Create2DIntRect(
|
|
{$ENDIF}
|
|
FRect.Left,
|
|
FRect.Top,
|
|
FRect.Right - PaneBorderHalfSize,
|
|
FRect.Bottom - PaneBorderHalfSize
|
|
);
|
|
TGuiTools.DrawRoundRect(
|
|
ABuffer.Canvas,
|
|
R,
|
|
PaneCornerRadius,
|
|
BgFromColor,
|
|
BgToColor,
|
|
FAppearance.Pane.GradientType,
|
|
ClipRect
|
|
);
|
|
|
|
// Label background
|
|
{$IFDEF EnhancedRecordSupport}
|
|
R := T2DIntRect.Create(
|
|
{$ELSE}
|
|
R := Create2DIntRect(
|
|
{$ENDIF}
|
|
FRect.Left,
|
|
FRect.Bottom - PaneCaptionHeight - PaneBorderHalfSize,
|
|
FRect.Right - PaneBorderHalfSize,
|
|
FRect.Bottom - PaneBorderHalfSize
|
|
);
|
|
TGuiTools.DrawRoundRect(
|
|
ABuffer.Canvas,
|
|
R,
|
|
PaneCornerRadius,
|
|
CaptionColor,
|
|
clNone,
|
|
bkSolid,
|
|
ClipRect,
|
|
false,
|
|
false,
|
|
true,
|
|
true
|
|
);
|
|
|
|
// Pane label
|
|
ABuffer.Canvas.Font.Assign(FAppearance.Pane.CaptionFont);
|
|
x := FRect.Left + (FRect.Width - ABuffer.Canvas.TextWidth(FCaption)) div 2;
|
|
y := FRect.Bottom - PaneBorderSize - PaneCaptionHeight + 1 +
|
|
(PaneCaptionHeight - ABuffer.Canvas.TextHeight('Wy')) div 2;
|
|
|
|
TGUITools.DrawText(
|
|
ABuffer.Canvas,
|
|
x,
|
|
y,
|
|
FCaption,
|
|
FontColor,
|
|
ClipRect
|
|
);
|
|
|
|
// Frames
|
|
case FAppearance.Pane.Style of
|
|
psRectangleFlat:
|
|
begin
|
|
{$IFDEF EnhancedRecordSupport}
|
|
R := T2DIntRect.Create(
|
|
{$ELSE}
|
|
R := Create2DIntRect(
|
|
{$ENDIF}
|
|
FRect.Left,
|
|
FRect.Top,
|
|
FRect.Right,
|
|
FRect.bottom
|
|
);
|
|
TGUITools.DrawAARoundFrame(
|
|
ABuffer,
|
|
R,
|
|
PaneCornerRadius,
|
|
BorderDarkColor,
|
|
ClipRect
|
|
);
|
|
end;
|
|
|
|
psRectangleEtched, psRectangleRaised:
|
|
begin
|
|
{$IFDEF EnhancedRecordSupport}
|
|
R := T2DIntRect.Create(
|
|
{$ELSE}
|
|
R := Create2DIntRect(
|
|
{$ENDIF}
|
|
FRect.Left + 1,
|
|
FRect.Top + 1,
|
|
FRect.Right,
|
|
FRect.bottom
|
|
);
|
|
if FAppearance.Pane.Style = psRectangleEtched then
|
|
c := BorderLightColor else
|
|
c := BorderDarkColor;
|
|
TGUITools.DrawAARoundFrame(
|
|
ABuffer,
|
|
R,
|
|
PaneCornerRadius,
|
|
c,
|
|
ClipRect
|
|
);
|
|
|
|
{$IFDEF EnhancedRecordSupport}
|
|
R := T2DIntRect.Create(
|
|
{$ELSE}
|
|
R := Create2DIntRect(
|
|
{$ENDIF}
|
|
FRect.Left,
|
|
FRect.Top,
|
|
FRect.Right-1,
|
|
FRect.Bottom-1
|
|
);
|
|
if FAppearance.Pane.Style = psRectangleEtched then
|
|
c := BorderDarkColor
|
|
else
|
|
c := BorderLightColor;
|
|
TGUITools.DrawAARoundFrame(
|
|
ABuffer,
|
|
R,
|
|
PaneCornerRadius,
|
|
c,
|
|
ClipRect
|
|
);
|
|
end;
|
|
|
|
psDividerRaised, psDividerEtched:
|
|
begin
|
|
if FAppearance.Pane.Style = psDividerRaised then
|
|
c := BorderLightColor else
|
|
c := BorderDarkColor;
|
|
TGUITools.DrawVLine(
|
|
ABuffer,
|
|
FRect.Right + PaneBorderHalfSize - 1,
|
|
FRect.Top,
|
|
FRect.Bottom,
|
|
c
|
|
);
|
|
if FAppearance.Pane.Style = psDividerRaised then
|
|
c := BorderDarkColor
|
|
else
|
|
c := BorderLightColor;
|
|
TGUITools.DrawVLine(
|
|
ABuffer,
|
|
FRect.Right + PaneBorderHalfSize,
|
|
FRect.Top,
|
|
FRect.Bottom,
|
|
c
|
|
);
|
|
end;
|
|
|
|
psDividerFlat:
|
|
TGUITools.DrawVLine(
|
|
ABuffer,
|
|
FRect.Right + PaneBorderHalfSize,
|
|
FRect.Top,
|
|
FRect.Bottom,
|
|
BorderDarkColor
|
|
);
|
|
end;
|
|
|
|
// Elements
|
|
for i := 0 to FItems.Count - 1 do
|
|
if FItems[i].Visible then
|
|
FItems[i].Draw(ABuffer, ClipRect);
|
|
end;
|
|
|
|
function TSpkPane.FindItemAt(x, y: integer): integer;
|
|
var
|
|
i: integer;
|
|
begin
|
|
result := -1;
|
|
i := FItems.count-1;
|
|
while (i >= 0) and (result = -1) do
|
|
begin
|
|
if FItems[i].Visible then
|
|
begin
|
|
{$IFDEF EnhancedRecordSupport}
|
|
if FItems[i].Rect.Contains(T2DIntVector.create(x,y)) then
|
|
{$ELSE}
|
|
if FItems[i].Rect.Contains(x,y) then
|
|
{$ENDIF}
|
|
Result := i;
|
|
end;
|
|
dec(i);
|
|
end;
|
|
end;
|
|
|
|
procedure TSpkPane.FreeingItem(AItem: TSpkBaseItem);
|
|
begin
|
|
FItems.RemoveReference(AItem);
|
|
end;
|
|
|
|
function TSpkPane.GenerateLayout: TSpkPaneItemsLayout;
|
|
type
|
|
TLayoutRow = array of integer;
|
|
TLayoutColumn = array of TLayoutRow;
|
|
TLayout = array of TLayoutColumn;
|
|
var
|
|
Layout: TLayout;
|
|
CurrentColumn: integer;
|
|
CurrentRow: integer;
|
|
CurrentItem: integer;
|
|
c, r, i: Integer;
|
|
ItemTableBehaviour: TSpkItemTableBehaviour;
|
|
ItemGroupBehaviour: TSpkItemGroupBehaviour;
|
|
ItemSize: TSpkItemSize;
|
|
ForceNewColumn: boolean;
|
|
LastX: integer;
|
|
MaxRowX: integer;
|
|
ColumnX: integer;
|
|
rows: Integer;
|
|
ItemWidth: Integer;
|
|
tmpRect: T2DIntRect;
|
|
begin
|
|
SetLength(Result.Rects, FItems.count);
|
|
Result.Width := 0;
|
|
|
|
if FItems.Count = 0 then
|
|
exit;
|
|
|
|
// Note: the algorithm is structured in such a way that three of them,
|
|
// CurrentColumn, CurrentRow and CurrentItem, point to an element that
|
|
// is not yet present (just after the recently added element).
|
|
|
|
SetLength(Layout, 1);
|
|
CurrentColumn := 0;
|
|
|
|
SetLength(Layout[CurrentColumn], 1);
|
|
CurrentRow := 0;
|
|
|
|
SetLength(Layout[CurrentColumn][CurrentRow], 0);
|
|
CurrentItem := 0;
|
|
|
|
ForceNewColumn := false;
|
|
|
|
for i := 0 to FItems.Count - 1 do
|
|
begin
|
|
ItemTableBehaviour := FItems[i].GetTableBehaviour;
|
|
ItemSize := FItems[i].GetSize;
|
|
|
|
// Starting a new column?
|
|
if (i=0) or
|
|
(ItemSize = isLarge) or
|
|
(ItemTableBehaviour = tbBeginsColumn) or
|
|
((ItemTableBehaviour = tbBeginsRow) and (CurrentRow = 2)) or
|
|
(ForceNewColumn) then
|
|
begin
|
|
// If we are already at the beginning of the new column, there is nothing to do.
|
|
if (CurrentRow <> 0) or (CurrentItem <> 0) then
|
|
begin
|
|
SetLength(Layout, Length(Layout)+1);
|
|
CurrentColumn := High(Layout);
|
|
|
|
SetLength(Layout[CurrentColumn], 1);
|
|
CurrentRow := 0;
|
|
|
|
SetLength(Layout[CurrentColumn][CurrentRow], 0);
|
|
CurrentItem := 0;
|
|
end;
|
|
end else
|
|
// Starting a new row?
|
|
if (ItemTableBehaviour = tbBeginsRow) then
|
|
begin
|
|
// If we are already at the beginning of a new poem, there is nothing to do.
|
|
if CurrentItem <> 0 then
|
|
begin
|
|
SetLength(Layout[CurrentColumn], Length(Layout[CurrentColumn])+1);
|
|
inc(CurrentRow);
|
|
CurrentItem := 0;
|
|
end;
|
|
end;
|
|
|
|
ForceNewColumn := (ItemSize = isLarge);
|
|
|
|
// If the item is visible, we add it in the current column and the current row.
|
|
if FItems[i].Visible then
|
|
begin
|
|
SetLength(Layout[CurrentColumn][CurrentRow], Length(Layout[CurrentColumn][CurrentRow])+1);
|
|
Layout[CurrentColumn][CurrentRow][CurrentItem] := i;
|
|
|
|
inc(CurrentItem);
|
|
end;
|
|
end;
|
|
|
|
// We have a ready layout here. Now you have to calculate the positions
|
|
// and sizes of the Rects.
|
|
|
|
// First, fill them with empty data that will fill the place of invisible elements.
|
|
{$IFDEF EnhancedRecordSupport}
|
|
for i := 0 to FItems.Count - 1 do
|
|
Result.Rects[i] := T2DIntRect.Create(-1, -1, -1, -1);
|
|
{$ELSE}
|
|
for i := 0 to FItems.Count - 1 do
|
|
Result.Rects[i].Create(-1, -1, -1, -1);
|
|
{$ENDIF}
|
|
|
|
MaxRowX := 0;
|
|
|
|
// Now, we iterate through the layout, fixing the recit.
|
|
for c := 0 to High(Layout) do
|
|
begin
|
|
if c>0 then
|
|
begin
|
|
LastX := MaxRowX + PaneColumnSpacer;
|
|
MaxRowX := LastX;
|
|
end
|
|
else
|
|
begin
|
|
LastX := MaxRowX;
|
|
end;
|
|
|
|
ColumnX := LastX;
|
|
|
|
rows := Length(Layout[c]);
|
|
for r := 0 to rows - 1 do
|
|
begin
|
|
LastX := ColumnX;
|
|
|
|
for i := 0 to High(Layout[c][r]) do
|
|
begin
|
|
ItemGroupBehaviour := FItems[Layout[c][r][i]].GetGroupBehaviour;
|
|
ItemSize := FItems[Layout[c][r][i]].GetSize;
|
|
ItemWidth := FItems[Layout[c][r][i]].GetWidth;
|
|
|
|
if ItemSize = isLarge then
|
|
begin
|
|
tmpRect.Top := PaneFullRowTopPadding;
|
|
tmpRect.Bottom := tmpRect.Top + PaneFullRowHeight - 1;
|
|
tmpRect.Left := LastX;
|
|
tmpRect.Right := LastX + ItemWidth - 1;
|
|
|
|
LastX := tmpRect.Right + 1;
|
|
if LastX > MaxRowX then
|
|
MaxRowX := LastX;
|
|
end
|
|
else
|
|
begin
|
|
if ItemGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then
|
|
begin
|
|
tmpRect.Left := LastX;
|
|
tmpRect.Right := tmpRect.Left + ItemWidth - 1;
|
|
end
|
|
else
|
|
begin
|
|
// If the element is not the first one, it must be offset by
|
|
// the margin from the previous one
|
|
if i>0 then
|
|
tmpRect.Left := LastX + PaneGroupSpacer
|
|
else
|
|
tmpRect.Left := LastX;
|
|
tmpRect.Right := tmpRect.Left + ItemWidth - 1;
|
|
end;
|
|
|
|
{$REGION 'Calculation of tmpRect.top and bottom'}
|
|
case rows of
|
|
1 : begin
|
|
tmpRect.Top := PaneOneRowTopPadding;
|
|
tmpRect.Bottom := tmpRect.Top + PaneRowHeight - 1;
|
|
end;
|
|
2 : case r of
|
|
0 : begin
|
|
tmpRect.Top := PaneTwoRowsTopPadding;
|
|
tmpRect.Bottom := tmpRect.top + PaneRowHeight - 1;
|
|
end;
|
|
1 : begin
|
|
tmpRect.Top := PaneTwoRowsTopPadding + PaneRowHeight + PaneTwoRowsVSpacer;
|
|
tmpRect.Bottom := tmpRect.top + PaneRowHeight - 1;
|
|
end;
|
|
end;
|
|
3 : case r of
|
|
0 : begin
|
|
tmpRect.Top := PaneThreeRowsTopPadding;
|
|
tmpRect.Bottom := tmpRect.Top + PaneRowHeight - 1;
|
|
end;
|
|
1 : begin
|
|
tmpRect.Top := PaneThreeRowsTopPadding + PaneRowHeight + PaneThreeRowsVSpacer;
|
|
tmpRect.Bottom := tmpRect.Top + PaneRowHeight - 1;
|
|
end;
|
|
2 : begin
|
|
tmpRect.Top := PaneThreeRowsTopPadding + 2 * PaneRowHeight + 2 * PaneThreeRowsVSpacer;
|
|
tmpRect.Bottom := tmpRect.Top + PaneRowHeight - 1;
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDREGION}
|
|
|
|
LastX := tmpRect.right + 1;
|
|
if LastX > MaxRowX then
|
|
MaxRowX:=LastX;
|
|
end;
|
|
|
|
Result.Rects[Layout[c][r][i]] := tmpRect;
|
|
end;
|
|
end;
|
|
end;
|
|
// At this point, MaxRowX points to the first pixel behind the most
|
|
// right-hand element - ergo is equal to the width of the entire layout.
|
|
Result.Width := MaxRowX;
|
|
end;
|
|
|
|
procedure TSpkPane.GetChildren(Proc: TGetChildProc; Root: TComponent);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
inherited;
|
|
for i := 0 to FItems.Count - 1 do
|
|
Proc(FItems.Items[i]);
|
|
end;
|
|
|
|
function TSpkPane.GetWidth: integer;
|
|
var
|
|
tmpBitmap: TBitmap;
|
|
PaneCaptionWidth, PaneElementsWidth: integer;
|
|
TextW: integer;
|
|
ElementsW: integer;
|
|
Layout: TSpkPaneItemsLayout;
|
|
begin
|
|
// Preparing...
|
|
Result := -1;
|
|
if FToolbarDispatch = nil then
|
|
exit;
|
|
if FAppearance = nil then
|
|
exit;
|
|
|
|
tmpBitmap := FToolbarDispatch.GetTempBitmap;
|
|
if tmpBitmap = nil then
|
|
exit;
|
|
tmpBitmap.Canvas.Font.Assign(FAppearance.Pane.CaptionFont);
|
|
|
|
// *** The minimum width of the sheet (text) ***
|
|
TextW := tmpBitmap.Canvas.TextWidth(FCaption);
|
|
PaneCaptionWidth := 2*PaneBorderSize + 2*PaneCaptionHMargin + TextW;
|
|
|
|
// *** The width of the elements of the sheet ***
|
|
Layout := GenerateLayout;
|
|
ElementsW := Layout.Width;
|
|
PaneElementsWidth := PaneBorderSize + PaneLeftPadding + ElementsW + PaneRightPadding + PaneBorderSize;
|
|
|
|
// *** Setting the width of the pane ***
|
|
Result := Max(PaneCaptionWidth, PaneElementsWidth);
|
|
end;
|
|
|
|
procedure TSpkPane.Loaded;
|
|
begin
|
|
inherited;
|
|
if FItems.ListState = lsNeedsProcessing then
|
|
FItems.ProcessNames(self.Owner);
|
|
end;
|
|
|
|
procedure TSpkPane.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
begin
|
|
if FMouseActiveElement.ElementType = peItem then
|
|
begin
|
|
if FMouseActiveElement.ElementIndex <> -1 then
|
|
FItems[FMouseActiveElement.ElementIndex].MouseDown(Button, Shift, X, Y);
|
|
end else
|
|
if FMouseActiveElement.ElementType = pePaneArea then
|
|
begin
|
|
FPaneState := psHover;
|
|
end else
|
|
if FMouseActiveElement.ElementType = peNone then
|
|
begin
|
|
if FMouseHoverElement.ElementType = peItem then
|
|
begin
|
|
if FMouseHoverElement.ElementIndex <> -1 then
|
|
begin
|
|
FMouseActiveElement.ElementType := peItem;
|
|
FMouseActiveElement.ElementIndex := FMouseHoverElement.ElementIndex;
|
|
FItems[FMouseHoverElement.ElementIndex].MouseDown(Button, Shift, X, Y);
|
|
end
|
|
else
|
|
begin
|
|
FMouseActiveElement.ElementType := pePaneArea;
|
|
FMouseActiveElement.ElementIndex := -1;
|
|
end;
|
|
end else
|
|
if FMouseHoverElement.ElementType = pePaneArea then
|
|
begin
|
|
FMouseActiveElement.ElementType := pePaneArea;
|
|
FMouseActiveElement.ElementIndex := -1;
|
|
// Placeholder, if there is a need to handle this event.
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TSpkPane.MouseLeave;
|
|
begin
|
|
if FMouseActiveElement.ElementType = peNone then
|
|
begin
|
|
if FMouseHoverElement.ElementType = peItem then
|
|
begin
|
|
if FMouseHoverElement.ElementIndex <> -1 then
|
|
FItems[FMouseHoverElement.ElementIndex].MouseLeave;
|
|
end else
|
|
if FMouseHoverElement.ElementType = pePaneArea then
|
|
begin
|
|
// Placeholder, if there is a need to handle this event.
|
|
end;
|
|
end;
|
|
|
|
FMouseHoverElement.ElementType := peNone;
|
|
FMouseHoverElement.ElementIndex := -1;
|
|
|
|
// Regardless of which item was active / under the mouse, you need to
|
|
// expire HotTrack.
|
|
if FPaneState <> psIdle then
|
|
begin
|
|
FPaneState := psIdle;
|
|
if Assigned(FToolbarDispatch) then
|
|
FToolbarDispatch.NotifyVisualsChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TSpkPane.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
i: integer;
|
|
NewMouseHoverElement: TSpkMousePaneElement;
|
|
begin
|
|
// MouseMove is only called when the tile is active, or when the mouse moves
|
|
// inside its area. Therefore, it is always necessary to ignite HotTrack
|
|
// in this situation.
|
|
|
|
if FPaneState = psIdle then
|
|
begin
|
|
FPaneState := psHover;
|
|
if Assigned(FToolbarDispatch) then
|
|
FToolbarDispatch.NotifyVisualsChanged;
|
|
end;
|
|
|
|
// We're looking for an object under the mouse
|
|
i := FindItemAt(X, Y);
|
|
if i <> -1 then
|
|
begin
|
|
NewMouseHoverElement.ElementType := peItem;
|
|
NewMouseHoverElement.ElementIndex := i;
|
|
end else
|
|
if (X >= FRect.Left) and (Y >= FRect.Top) and
|
|
(X <= FRect.Right) and (Y <= FRect.Bottom) then
|
|
begin
|
|
NewMouseHoverElement.ElementType := pePaneArea;
|
|
NewMouseHoverElement.ElementIndex := -1;
|
|
end else
|
|
begin
|
|
NewMouseHoverElement.ElementType := peNone;
|
|
NewMouseHoverElement.ElementIndex := -1;
|
|
end;
|
|
|
|
if FMouseActiveElement.ElementType = peItem then
|
|
begin
|
|
if FMouseActiveElement.ElementIndex <> -1 then
|
|
FItems[FMouseActiveElement.ElementIndex].MouseMove(Shift, X, Y);
|
|
end else
|
|
if FMouseActiveElement.ElementType = pePaneArea then
|
|
begin
|
|
// Placeholder, if there is a need to handle this event
|
|
end else
|
|
if FMouseActiveElement.ElementType = peNone then
|
|
begin
|
|
// If the item under the mouse changes, we inform the previous element
|
|
// that the mouse leaves its area
|
|
if (NewMouseHoverElement.ElementType <> FMouseHoverElement.ELementType) or
|
|
(NewMouseHoverElement.ElementIndex <> FMouseHoverElement.ElementIndex) then
|
|
begin
|
|
if FMouseHoverElement.ElementType = peItem then
|
|
begin
|
|
if FMouseHoverElement.ElementIndex <> -1 then
|
|
FItems[FMouseHoverElement.ElementIndex].MouseLeave;
|
|
end else
|
|
if FMouseHoverElement.ElementType = pePaneArea then
|
|
begin
|
|
// Placeholder, if there is a need to handle this event
|
|
end;
|
|
end;
|
|
|
|
if NewMouseHoverElement.ElementType = peItem then
|
|
begin
|
|
if NewMouseHoverElement.ElementIndex <> -1 then
|
|
FItems[NewMouseHoverElement.ElementIndex].MouseMove(Shift, X, Y);
|
|
end else
|
|
if NewMouseHoverElement.ElementType = pePaneArea then
|
|
begin
|
|
// Placeholder, if there is a need to handle this event
|
|
end;
|
|
end;
|
|
|
|
FMouseHoverElement := NewMouseHoverElement;
|
|
end;
|
|
|
|
procedure TSpkPane.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
var
|
|
ClearActive: boolean;
|
|
begin
|
|
ClearActive := not (ssLeft in Shift) and not (ssMiddle in Shift) and not (ssRight in Shift);
|
|
|
|
if FMouseActiveElement.ElementType = peItem then
|
|
begin
|
|
if FMouseActiveElement.ElementIndex <> -1 then
|
|
FItems[FMouseActiveElement.ElementIndex].MouseUp(Button, Shift, X, Y);
|
|
end else
|
|
if FMouseActiveElement.ElementType = pePaneArea then
|
|
begin
|
|
// Placeholder, if there is a need to handle this event
|
|
end;
|
|
|
|
if ClearActive and
|
|
(FMouseActiveElement.ElementType <> FMouseHoverElement.ElementType) or
|
|
(FMouseActiveElement.ElementIndex <> FMouseHoverElement.ElementIndex) then
|
|
begin
|
|
if FMouseActiveElement.ElementType = peItem then
|
|
begin
|
|
if FMouseActiveElement.ElementIndex <> -1 then
|
|
FItems[FMouseActiveElement.ElementIndex].MouseLeave;
|
|
end else
|
|
if FMouseActiveElement.ElementType = pePaneArea then
|
|
begin
|
|
// Placeholder, if there is a need to handle this event
|
|
end;
|
|
|
|
if FMouseHoverElement.ElementType = peItem then
|
|
begin
|
|
if FMouseActiveElement.ElementIndex <> -1 then
|
|
FItems[FMouseActiveElement.ElementIndex].MouseMove(Shift, X, Y);
|
|
end else
|
|
if FMouseHoverElement.ElementType = pePaneArea then
|
|
begin
|
|
// Placeholder, if there is a need to handle this event
|
|
end else
|
|
if FMouseHoverElement.ElementType = peNone then
|
|
begin
|
|
if FPaneState <> psIdle then
|
|
begin
|
|
FPaneState := psIdle;
|
|
if Assigned(FToolbarDispatch) then
|
|
FToolbarDispatch.NotifyVisualsChanged;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if ClearActive then
|
|
begin
|
|
FMouseActiveElement.ElementType := peNone;
|
|
FMouseActiveElement.ElementIndex := -1;
|
|
end;
|
|
end;
|
|
|
|
procedure TSpkPane.SetAppearance(const Value: TSpkToolbarAppearance);
|
|
begin
|
|
FAppearance := Value;
|
|
FItems.Appearance := Value;
|
|
end;
|
|
|
|
procedure TSpkPane.SetCaption(const Value: string);
|
|
begin
|
|
FCaption := Value;
|
|
if Assigned(FToolbarDispatch) then
|
|
FToolbarDispatch.NotifyMetricsChanged;
|
|
end;
|
|
|
|
procedure TSpkPane.SetDisabledImages(const Value: TImageList);
|
|
begin
|
|
FDisabledImages := Value;
|
|
FItems.DisabledImages := FDisabledImages;
|
|
end;
|
|
|
|
procedure TSpkPane.SetDisabledLargeImages(const Value: TImageList);
|
|
begin
|
|
FDisabledLargeImages := Value;
|
|
FItems.DisabledLargeImages := FDisabledLargeImages;
|
|
end;
|
|
|
|
procedure TSpkPane.SetImages(const Value: TImageList);
|
|
begin
|
|
FImages := Value;
|
|
FItems.Images := FImages;
|
|
end;
|
|
|
|
procedure TSpkPane.SetImagesWidth(const Value: Integer);
|
|
begin
|
|
FImagesWidth := Value;
|
|
FItems.ImagesWidth := FImagesWidth;
|
|
end;
|
|
|
|
procedure TSpkPane.SetLargeImages(const Value: TImageList);
|
|
begin
|
|
FLargeImages := Value;
|
|
FItems.LargeImages := FLargeImages;
|
|
end;
|
|
|
|
procedure TSpkPane.SetLargeImagesWidth(const Value: Integer);
|
|
begin
|
|
FLargeImagesWidth := Value;
|
|
FItems.LargeImagesWidth := FLargeImagesWidth;
|
|
end;
|
|
|
|
procedure TSpkPane.SetVisible(const Value: boolean);
|
|
begin
|
|
FVisible := Value;
|
|
if Assigned(FToolbarDispatch) then
|
|
FToolbarDispatch.NotifyItemsChanged;
|
|
end;
|
|
|
|
|
|
{ TSpkPanes }
|
|
|
|
function TSpkPanes.Add: TSpkPane;
|
|
begin
|
|
Result := TSpkPane.Create(FRootComponent);
|
|
Result.Parent := FRootComponent;
|
|
AddItem(Result);
|
|
end;
|
|
|
|
function TSpkPanes.GetItems(AIndex: integer): TSpkPane;
|
|
begin
|
|
Result := TSpkPane(inherited Items[AIndex]);
|
|
end;
|
|
|
|
function TSpkPanes.Insert(AIndex: integer): TSpkPane;
|
|
var
|
|
lOwner, lParent: TComponent;
|
|
i: Integer;
|
|
begin
|
|
if (AIndex < 0) or (AIndex > self.Count) then
|
|
raise InternalException.Create('TSpkPanes.Insert: Invalid index!');
|
|
|
|
if FRootComponent<>nil then
|
|
begin
|
|
lOwner := FRootComponent.Owner;
|
|
lParent := FRootComponent;
|
|
end
|
|
else
|
|
begin
|
|
lOwner := nil;
|
|
lParent := nil;
|
|
end;
|
|
|
|
Result := TSpkPane.Create(lOwner);
|
|
Result.Parent := lParent;
|
|
|
|
if FRootComponent <> nil then
|
|
begin
|
|
i := 0;
|
|
while FRootComponent.Owner.FindComponent('SpkPane'+IntToStr(i)) <> nil do
|
|
inc(i);
|
|
Result.Name := 'SpkPane' + IntToStr(i);
|
|
end;
|
|
|
|
InsertItem(AIndex, Result);
|
|
end;
|
|
|
|
procedure TSpkPanes.Notify(Item: TComponent; Operation: TOperation);
|
|
begin
|
|
inherited Notify(Item, Operation);
|
|
case Operation of
|
|
opInsert:
|
|
begin
|
|
// Setting the dispatcher to nil will cause that during the
|
|
// ownership assignment, the Notify method will not be called
|
|
TSpkPane(Item).ToolbarDispatch := nil;
|
|
TSpkPane(Item).Appearance := FAppearance;
|
|
TSpkPane(Item).Images := FImages;
|
|
TSpkPane(Item).DisabledImages := FDisabledImages;
|
|
TSpkPane(Item).LargeImages := FLargeImages;
|
|
TSpkPane(Item).DisabledLargeImages := FDisabledLargeImages;
|
|
TSpkPane(Item).ImagesWidth := FImagesWidth;
|
|
TSpkPane(Item).LargeImagesWidth := FLargeImagesWidth;
|
|
TSpkPane(Item).ToolbarDispatch := FToolbarDispatch;
|
|
end;
|
|
opRemove:
|
|
if not(csDestroying in Item.ComponentState) then
|
|
begin
|
|
TSpkPane(Item).ToolbarDispatch := nil;
|
|
TSpkPane(Item).Appearance := nil;
|
|
TSpkPane(Item).Images := nil;
|
|
TSpkPane(Item).DisabledImages := nil;
|
|
TSpkPane(Item).LargeImages := nil;
|
|
TSpkPane(Item).DisabledLargeImages := nil;
|
|
// TSpkPane(Item).ImagesWidth := 0;
|
|
// TSpkPane(Item).LargeImagesWidth := 0;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TSpkPanes.SetImages(const Value: TImageList);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
FImages := Value;
|
|
for I := 0 to self.Count - 1 do
|
|
Items[i].Images := Value;
|
|
end;
|
|
|
|
procedure TSpkPanes.SetImagesWidth(const Value: Integer);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
FImagesWidth := Value;
|
|
for I := 0 to Count - 1 do
|
|
Items[i].ImagesWidth := Value;
|
|
end;
|
|
|
|
procedure TSpkPanes.SetLargeImages(const Value: TImageList);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
FLargeImages := Value;
|
|
for I := 0 to self.Count - 1 do
|
|
Items[i].LargeImages := Value;
|
|
end;
|
|
|
|
procedure TSpkPanes.SetLargeImagesWidth(const Value: Integer);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
FLargeImagesWidth := Value;
|
|
for I := 0 to Count - 1 do
|
|
Items[i].LargeImagesWidth := Value;
|
|
end;
|
|
|
|
procedure TSpkPanes.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch);
|
|
var
|
|
i: integer;
|
|
begin
|
|
FToolbarDispatch := Value;
|
|
for i := 0 to self.Count - 1 do
|
|
Items[i].ToolbarDispatch := FToolbarDispatch;
|
|
end;
|
|
|
|
procedure TSpkPanes.SetAppearance(const Value: TSpkToolbarAppearance);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
FAppearance := Value;
|
|
for i := 0 to self.Count - 1 do
|
|
Items[i].Appearance := FAppearance;
|
|
if FToolbarDispatch <> nil then
|
|
FToolbarDispatch.NotifyMetricsChanged;
|
|
end;
|
|
|
|
procedure TSpkPanes.SetDisabledImages(const Value: TImageList);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
FDisabledImages := Value;
|
|
for I := 0 to self.Count - 1 do
|
|
Items[i].DisabledImages := Value;
|
|
end;
|
|
|
|
procedure TSpkPanes.SetDisabledLargeImages(const Value: TImageList);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
FDisabledLargeImages := Value;
|
|
for I := 0 to self.Count - 1 do
|
|
Items[i].DisabledLargeImages := Value;
|
|
end;
|
|
|
|
procedure TSpkPanes.Update;
|
|
begin
|
|
inherited Update;
|
|
if Assigned(FToolbarDispatch) then
|
|
FToolbarDispatch.NotifyItemsChanged;
|
|
end;
|
|
|
|
|
|
end.
|