pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

SpkToolbar: Apply conventional source formatting

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5383 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-11-26 23:56:34 +00:00
parent 6f72dd9582
commit 49c250890f
15 changed files with 2452 additions and 2521 deletions
Download Patch File Download Diff File Expand all files Collapse all files

36
components/spktoolbar/SpkToolbar/SpkToolbar.pas
View File

@ -418,11 +418,13 @@ type
property OnTabChanged: TNotifyEvent read FOnTabChanged write FOnTabChanged;
end;
implementation
uses
LCLIntf, Themes;
{ TSpkToolbarDispatch }
function TSpkToolbarDispatch.ClientToScreen(Point: T2DIntPoint): T2DIntPoint;
@ -478,21 +480,20 @@ begin
FToolbar.NotifyVisualsChanged;
end;
{ TSpkToolbar }
function TSpkToolbar.AtLeastOneTabVisible: 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
while (i >= 0) and not TabVisible do
begin
TabVisible := FTabs[i].Visible;
Dec(i);
@ -588,7 +589,6 @@ end;
procedure TSpkToolbar.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
Filer.DefineProperty('Tabs', FTabs.ReadNames, FTabs.WriteNames, True);
end;
@ -596,13 +596,11 @@ destructor TSpkToolbar.Destroy;
begin
// Release the fields
FTabs.Free;
FAppearance.Free;
// Release the internal fields
FTemporary.Free;
FBuffer.Free;
FToolbarDispatch.Free;
{$IFDEF DELAYRUNTIMER}
@ -615,7 +613,6 @@ end;
procedure TSpkToolbar.EndUpdate;
begin
FUpdating := False;
ValidateMetrics;
ValidateBuffer;
Repaint;
@ -638,10 +635,8 @@ var
i: integer;
begin
inherited;
if FTabs.Count > 0 then
for i := 0 to FTabs.Count - 1 do
Proc(FTabs.Items[i]);
for i := 0 to FTabs.Count - 1 do
Proc(FTabs.Items[i]);
end;
function TSpkToolbar.GetColor: TColor;
@ -681,9 +676,7 @@ begin
InternalBeginUpdate;
if FTabs.ListState = lsNeedsProcessing then
begin
FTabs.ProcessNames(self.Owner);
end;
InternalEndUpdate;
@ -975,7 +968,6 @@ end;
procedure TSpkToolbar.NotifyAppearanceChanged;
begin
SetMetricsInvalid;
if not (FInternalUpdating or FUpdating) then
Repaint;
end;
@ -983,7 +975,6 @@ end;
procedure TSpkToolbar.NotifyMetricsChanged;
begin
SetMetricsInvalid;
if not (FInternalUpdating or FUpdating) then
Repaint;
end;
@ -1025,7 +1016,6 @@ end;
procedure TSpkToolbar.NotifyVisualsChanged;
begin
SetBufferInvalid;
if not (FInternalUpdating or FUpdating) then
Repaint;
end;
@ -1081,7 +1071,6 @@ procedure TSpkToolbar.SetColor(const Value: TColor);
begin
inherited Color := Value;
SetBufferInvalid;
if not (FInternalUpdating or FUpdating) then
Repaint;
end;
@ -1091,7 +1080,6 @@ begin
FDisabledImages := Value;
FTabs.DisabledImages := Value;
SetMetricsInvalid;
if not (FInternalUpdating or FUpdating) then
Repaint;
end;
@ -1101,7 +1089,6 @@ begin
FDisabledLargeImages := Value;
FTabs.DisabledLargeImages := Value;
SetMetricsInvalid;
if not (FInternalUpdating or FUpdating) then
Repaint;
end;
@ -1111,7 +1098,6 @@ begin
FImages := Value;
FTabs.Images := Value;
SetMetricsInvalid;
if not (FInternalUpdating or FUpdating) then
Repaint;
end;
@ -1121,7 +1107,6 @@ begin
FLargeImages := Value;
FTabs.LargeImages := Value;
SetMetricsInvalid;
if not (FInternalUpdating or FUpdating) then
Repaint;
end;
@ -1272,14 +1257,12 @@ begin
if (FTabIndex > -1) then
FTabs[FTabIndex].ExecOnClick;
//Tabs don't need MouseUp
end;
procedure TSpkToolbar.SetAppearance(const Value: TSpkToolbarAppearance);
begin
FAppearance.Assign(Value);
SetBufferInvalid;
if not (FInternalUpdating or FUpdating) then
Repaint;
@ -1316,6 +1299,7 @@ procedure TSpkToolbar.ValidateBuffer;
FocusedAppearance.Tab.GradientFromColor,
FocusedAppearance.Tab.GradientToColor,
FocusedAppearance.Tab.GradientType);
TGuiTools.DrawAARoundCorner(FBuffer,
{$IFDEF EnhancedRecordSupport}
T2DIntPoint.Create(0, ToolbarTabCaptionsHeight),
@ -1325,6 +1309,7 @@ procedure TSpkToolbar.ValidateBuffer;
ToolbarCornerRadius,
cpLeftTop,
FocusedAppearance.Tab.BorderColor);
TGuiTools.DrawAARoundCorner(FBuffer,
{$IFDEF EnhancedRecordSupport}
T2DIntPoint.Create(self.Width - ToolbarCornerRadius, ToolbarTabCaptionsHeight),
@ -1334,6 +1319,7 @@ procedure TSpkToolbar.ValidateBuffer;
ToolbarCornerRadius,
cpRightTop,
FocusedAppearance.Tab.BorderColor);
TGuiTools.DrawAARoundCorner(FBuffer,
{$IFDEF EnhancedRecordSupport}
T2DIntPoint.Create(0, self.Height - ToolbarCornerRadius),
@ -1343,6 +1329,7 @@ procedure TSpkToolbar.ValidateBuffer;
ToolbarCornerRadius,
cpLeftBottom,
FocusedAppearance.Tab.BorderColor);
TGuiTools.DrawAARoundCorner(FBuffer,
{$IFDEF EnhancedRecordSupport}
T2DIntPoint.Create(self.Width - ToolbarCornerRadius, self.Height - ToolbarCornerRadius),
@ -1352,11 +1339,14 @@ procedure TSpkToolbar.ValidateBuffer;
ToolbarCornerRadius,
cpRightBottom,
FocusedAppearance.Tab.BorderColor);
TGuiTools.DrawVLine(FBuffer, 0, ToolbarTabCaptionsHeight +
ToolbarCornerRadius, self.Height - ToolbarCornerRadius,
FocusedAppearance.Tab.BorderColor);
TGuiTools.DrawHLine(FBuffer, ToolbarCornerRadius, self.Width - ToolbarCornerRadius,
self.Height - 1, FocusedAppearance.Tab.BorderColor);
TGuiTools.DrawVLine(FBuffer, self.Width - 1, ToolbarTabCaptionsHeight +
ToolbarCornerRadius, self.Height - ToolbarCornerRadius,
FocusedAppearance.Tab.BorderColor);

747
components/spktoolbar/SpkToolbar/spkt_Appearance.pas
View File

File diff suppressed because it is too large Load Diff

162
components/spktoolbar/SpkToolbar/spkt_BaseItem.pas
View File

@ -15,88 +15,95 @@ unit spkt_BaseItem;
interface
uses Graphics, Classes, Controls,
SpkMath, spkt_Appearance, spkt_Dispatch, spkt_Types;
uses
Graphics, Classes, Controls,
SpkMath, spkt_Appearance, spkt_Dispatch, spkt_Types;
type TSpkItemSize = (isLarge, isNormal);
TSpkItemTableBehaviour = (tbBeginsRow, tbBeginsColumn, tbContinuesRow);
TSpkItemGroupBehaviour = (gbSingleItem, gbBeginsGroup, gbContinuesGroup, gbEndsGroup);
type
TSpkItemSize = (isLarge, isNormal);
TSpkBaseItem = class abstract(TSpkComponent)
private
protected
FRect : T2DIntRect;
FToolbarDispatch : TSpkBaseToolbarDispatch;
FAppearance : TSpkToolbarAppearance;
FImages : TImageList;
FDisabledImages : TImageList;
FLargeImages : TImageList;
FDisabledLargeImages : TImageList;
FVisible : boolean;
FEnabled : boolean;
TSpkItemTableBehaviour = (tbBeginsRow, tbBeginsColumn, tbContinuesRow);
procedure SetVisible(const Value: boolean); virtual;
procedure SetEnabled(const Value: boolean); virtual;
procedure SetRect(const Value: T2DIntRect); virtual;
procedure SetImages(const Value: TImageList); virtual;
procedure SetDisabledImages(const Value : TImageList); virtual;
procedure SetLargeImages(const Value: TImageList); virtual;
procedure SetDisabledLargeImages(const Value: TImageList); virtual;
procedure SetAppearance(const Value: TSpkToolbarAppearance);
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
TSpkItemGroupBehaviour = (gbSingleItem, gbBeginsGroup, gbContinuesGroup, gbEndsGroup);
procedure MouseLeave; virtual; abstract;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); virtual; abstract;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); virtual; abstract;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); virtual; abstract;
TSpkBaseItem = class abstract(TSpkComponent)
private
protected
FRect: T2DIntRect;
FToolbarDispatch: TSpkBaseToolbarDispatch;
FAppearance: TSpkToolbarAppearance;
FImages: TImageList;
FDisabledImages: TImageList;
FLargeImages: TImageList;
FDisabledLargeImages: TImageList;
FVisible: boolean;
FEnabled: boolean;
function GetWidth : integer; virtual; abstract;
function GetTableBehaviour : TSpkItemTableBehaviour; virtual; abstract;
function GetGroupBehaviour : TSpkItemGroupBehaviour; virtual; abstract;
function GetSize : TSpkItemSize; virtual; abstract;
procedure Draw(ABuffer : TBitmap; ClipRect : T2DIntRect); virtual; abstract;
procedure SetVisible(const Value: boolean); virtual;
procedure SetEnabled(const Value: boolean); virtual;
procedure SetRect(const Value: T2DIntRect); virtual;
procedure SetImages(const Value: TImageList); virtual;
procedure SetDisabledImages(const Value: TImageList); virtual;
procedure SetLargeImages(const Value: TImageList); virtual;
procedure SetDisabledLargeImages(const Value: TImageList); virtual;
procedure SetAppearance(const Value: TSpkToolbarAppearance);
property ToolbarDispatch : TSpkBaseToolbarDispatch read FToolbarDispatch write FToolbarDispatch;
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;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Rect : T2DIntRect read FRect write SetRect;
published
property Visible : boolean read FVisible write SetVisible;
property Enabled : boolean read FEnabled write SetEnabled;
end;
procedure MouseLeave; virtual; abstract;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); virtual; abstract;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); virtual; abstract;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); virtual; abstract;
function GetWidth: integer; virtual; abstract;
function GetTableBehaviour: TSpkItemTableBehaviour; virtual; abstract;
function GetGroupBehaviour: TSpkItemGroupBehaviour; virtual; abstract;
function GetSize: TSpkItemSize; virtual; abstract;
procedure Draw(ABuffer: TBitmap; ClipRect: T2DIntRect); virtual; abstract;
property ToolbarDispatch: TSpkBaseToolbarDispatch read FToolbarDispatch write FToolbarDispatch;
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 Rect: T2DIntRect read FRect write SetRect;
published
property Visible: boolean read FVisible write SetVisible;
property Enabled: boolean read FEnabled write SetEnabled;
end;
TSpkBaseItemClass = class of TSpkBaseItem;
type TSpkBaseItemClass = class of TSpkBaseItem;
implementation
{ TSpkBaseItem }
constructor TSpkBaseItem.Create(AOwner : TComponent);
constructor TSpkBaseItem.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{$IFDEF EnhancedRecordSupport}
FRect:=T2DIntRect.create(0, 0, 0, 0);
FRect := T2DIntRect.Create(0, 0, 0, 0);
{$ELSE}
FRect.create(0, 0, 0, 0);
FRect.Create(0, 0, 0, 0);
{$ENDIF}
FToolbarDispatch:=nil;
FAppearance:=nil;
FImages:=nil;
FDisabledImages:=nil;
FLargeImages:=nil;
FDisabledLargeImages:=nil;
FVisible:=true;
FEnabled:=true;
FToolbarDispatch := nil;
FAppearance := nil;
FImages := nil;
FDisabledImages := nil;
FLargeImages := nil;
FDisabledLargeImages := nil;
FVisible := true;
FEnabled := true;
end;
destructor TSpkBaseItem.Destroy;
@ -108,9 +115,8 @@ end;
procedure TSpkBaseItem.SetAppearance(const Value: TSpkToolbarAppearance);
begin
FAppearance := Value;
if assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyMetricsChanged;
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyMetricsChanged;
end;
procedure TSpkBaseItem.SetDisabledImages(const Value: TImageList);
@ -120,17 +126,17 @@ end;
procedure TSpkBaseItem.SetDisabledLargeImages(const Value: TImageList);
begin
FDisabledLargeImages:=Value;
FDisabledLargeImages := Value;
end;
procedure TSpkBaseItem.SetEnabled(const Value: boolean);
begin
if Value<>FEnabled then
begin
FEnabled:=Value;
if FToolbarDispatch<>nil then
FToolbarDispatch.NotifyVisualsChanged;
end;
if Value <> FEnabled then
begin
FEnabled := Value;
if FToolbarDispatch<>nil then
FToolbarDispatch.NotifyVisualsChanged;
end;
end;
procedure TSpkBaseItem.SetImages(const Value: TImageList);
@ -150,12 +156,12 @@ end;
procedure TSpkBaseItem.SetVisible(const Value: boolean);
begin
if Value<>FVisible then
begin
FVisible:=Value;
if FToolbarDispatch<>nil then
FToolbarDispatch.NotifyMetricsChanged;
end;
if Value <> FVisible then
begin
FVisible := Value;
if FToolbarDispatch <> nil then
FToolbarDispatch.NotifyMetricsChanged;
end;
end;
end.

1105
components/spktoolbar/SpkToolbar/spkt_Buttons.pas
View File

File diff suppressed because it is too large Load Diff

55
components/spktoolbar/SpkToolbar/spkt_Checkboxes.pas
View File

@ -12,7 +12,6 @@ type
TSpkCustomCheckbox = class;
TSpkCheckboxActionLink = class(TSpkButtonActionLink)
private
protected
procedure SetChecked(Value: Boolean); override;
public
@ -98,7 +97,8 @@ procedure TSpkCheckboxActionLink.SetChecked(Value: Boolean);
var
cb: TSpkCustomCheckbox;
begin
if IsCheckedLinked then begin
if IsCheckedLinked then
begin
cb := TSpkCustomCheckbox(FClient);
cb.Checked := Value;
end;
@ -120,7 +120,8 @@ end;
procedure TSpkCustomCheckbox.ActionChange(Sender: TObject);
begin
if Sender is TCustomAction then
with TCustomAction(Sender) do begin
with TCustomAction(Sender) do
begin
if (Self.Caption = '') or (Self.Caption = GetDefaultCaption) then
Self.Caption := Caption;
if (Self.Enabled = True) then
@ -148,7 +149,7 @@ end;
procedure TSpkCustomCheckbox.CalcRects;
var
RectVector : T2DIntVector;
RectVector: T2DIntVector;
begin
ConstructRect(FButtonRect);
{$IFDEF EnhancedRecordSupport}
@ -179,12 +180,12 @@ end;
procedure TSpkCustomCheckbox.ConstructRect(var BtnRect: T2DIntRect);
var
BtnWidth : integer;
Bitmap : TBitmap;
BtnWidth: integer;
Bitmap: TBitmap;
TextWidth: Integer;
begin
{$IFDEF EnhancedRecordSupport}
BtnRect:=T2DIntRect.Create(0, 0, 0, 0);
BtnRect := T2DIntRect.Create(0, 0, 0, 0);
{$ELSE}
BtnRect.Create(0, 0, 0, 0);
{$ENDIF}
@ -195,7 +196,7 @@ begin
exit;
Bitmap := FToolbarDispatch.GetTempBitmap;
if not(assigned(Bitmap)) then
if not Assigned(Bitmap) then
exit;
Bitmap.Canvas.Font.Assign(FAppearance.Element.CaptionFont);
@ -246,7 +247,8 @@ begin
end;
// Border
if (FButtonState = bsIdle) and (not(FHideFrameWhenIdle)) then begin
if (FButtonState = bsIdle) and (not(FHideFrameWhenIdle)) then
begin
with FAppearance.Element do
TButtonTools.DrawButton(
ABuffer,
@ -265,7 +267,8 @@ begin
ClipRect
);
end else
if (FButtonState=bsBtnHottrack) then begin
if (FButtonState=bsBtnHottrack) then
begin
with FAppearance.Element do
TButtonTools.DrawButton(
ABuffer,
@ -284,7 +287,8 @@ begin
ClipRect
);
end else
if (FButtonState = bsBtnPressed) then begin
if (FButtonState = bsBtnPressed) then
begin
with FAppearance.Element do
TButtonTools.DrawButton(
ABuffer,
@ -305,11 +309,13 @@ begin
end;
// Checkbox
if ThemeServices.ThemesEnabled then begin
if ThemeServices.ThemesEnabled then
begin
te := ThemeServices.GetElementDetails(tbCheckboxCheckedNormal);
h := ThemeServices.GetDetailSize(te).cy;
end else
h := GetSystemMetrics(SM_CYMENUCHECK);
if (FGroupBehaviour in [gbContinuesGroup, gbEndsGroup]) then
x := FButtonRect.Left + SmallButtonHalfBorderWidth + SmallButtonPadding
else
@ -350,40 +356,40 @@ end;
function TSpkCustomCheckbox.GetChecked: Boolean;
begin
result := (FState = cbChecked);
Result := (FState = cbChecked);
end;
function TSpkCustomCheckbox.GetDefaultCaption: String;
begin
result := 'Checkbox';
Result := 'Checkbox';
end;
function TSpkCustomCheckbox.GetGroupBehaviour: TSpkItemGroupBehaviour;
begin
result := FGroupBehaviour;
Result := FGroupBehaviour;
end;
function TSpkCustomCheckbox.GetSize: TSpkItemSize;
begin
result := isNormal;
Result := isNormal;
end;
function TSpkCustomCheckbox.GetTableBehaviour: TSpkItemTableBehaviour;
begin
result := FTableBehaviour;
Result := FTableBehaviour;
end;
function TSpkCustomCheckbox.GetWidth: integer;
var
BtnRect, DropRect : T2DIntRect;
BtnRect, DropRect: T2DIntRect;
begin
result := -1;
Result := -1;
if FToolbarDispatch = nil then
exit;
if FAppearance = nil then
exit;
ConstructRect(BtnRect);
result := BtnRect.Right + 1;
Result := BtnRect.Right + 1;
end;
procedure TSpkCustomCheckbox.MouseDown(Button: TMouseButton; Shift: TShiftState;
@ -452,7 +458,8 @@ end;
procedure TSpkCustomCheckbox.SetState(AValue:TCheckboxState);
begin
if AValue <> FState then begin
if AValue <> FState then
begin
FState := AValue;
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
@ -477,6 +484,7 @@ end;
{ TSpkRadioButton }
constructor TSpkRadioButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
@ -485,7 +493,7 @@ end;
function TSpkRadioButton.GetDefaultCaption: string;
begin
result := 'RadioButton';
Result := 'RadioButton';
end;
procedure TSpkRadioButton.SetState(AValue: TCheckboxState);
@ -500,7 +508,8 @@ var
i: Integer;
pane: TSpkPane;
begin
if (Parent is TSpkPane) then begin
if (Parent is TSpkPane) then
begin
pane := TSpkPane(Parent);
for i:=0 to pane.Items.Count-1 do
if (pane.items[i] is TSpkRadioButton) and (pane.items[i] <> self) then

9
components/spktoolbar/SpkToolbar/spkt_Const.pas
View File

@ -266,7 +266,6 @@ uses
procedure SpkInitLayoutConsts(FromDPI: Integer; ToDPI: Integer = 0);
begin
if not(DPI_AWARE) then
ToDPI := FromDPI;
@ -391,21 +390,21 @@ initialization
// Sprawdzanie poprawnoœci
// £uk du¿ego przycisku
assert(LARGEBUTTON_RADIUS * 2 <= LARGEBUTTON_DROPDOWN_FIELD_SIZE);
Assert(LARGEBUTTON_RADIUS * 2 <= LARGEBUTTON_DROPDOWN_FIELD_SIZE);
// Tafla, wersja z jednym wierszem
assert(PANE_ROW_HEIGHT +
Assert(PANE_ROW_HEIGHT +
PANE_ONE_ROW_TOPPADDING +
PANE_ONE_ROW_BOTTOMPADDING <= MAX_ELEMENT_HEIGHT);
// Tafla, wersja z dwoma wierszami
assert(2*PANE_ROW_HEIGHT +
Assert(2*PANE_ROW_HEIGHT +
PANE_TWO_ROWS_TOPPADDING +
PANE_TWO_ROWS_VSPACER +
PANE_TWO_ROWS_BOTTOMPADDING <= MAX_ELEMENT_HEIGHT);
// Tafla, wersja z trzema wierszami
assert(3*PANE_ROW_HEIGHT +
Assert(3*PANE_ROW_HEIGHT +
PANE_THREE_ROWS_TOPPADDING +
2*PANE_THREE_ROWS_VSPACER +
PANE_THREE_ROWS_BOTTOMPADDING <= MAX_ELEMENT_HEIGHT);

44
components/spktoolbar/SpkToolbar/spkt_Dispatch.pas
View File

@ -15,32 +15,30 @@ unit spkt_Dispatch;
interface
uses Classes, Controls, Graphics,
SpkMath;
uses
Classes, Controls, Graphics,
SpkMath;
type TSpkBaseDispatch = class abstract(TObject)
private
protected
public
end;
type
TSpkBaseDispatch = class abstract(TObject)
private
protected
public
end;
type TSpkBaseAppearanceDispatch = class abstract(TSpkBaseDispatch)
private
protected
public
procedure NotifyAppearanceChanged; virtual; abstract;
end;
TSpkBaseAppearanceDispatch = class abstract(TSpkBaseDispatch)
public
procedure NotifyAppearanceChanged; virtual; abstract;
end;
type TSpkBaseToolbarDispatch = class abstract(TSpkBaseAppearanceDispatch)
private
protected
public
procedure NotifyItemsChanged; virtual; abstract;
procedure NotifyMetricsChanged; virtual; abstract;
procedure NotifyVisualsChanged; virtual; abstract;
function GetTempBitmap : TBitmap; virtual; abstract;
function ClientToScreen(Point : T2DIntPoint) : T2DIntPoint; virtual; abstract;
end;
TSpkBaseToolbarDispatch = class abstract(TSpkBaseAppearanceDispatch)
public
procedure NotifyItemsChanged; virtual; abstract;
procedure NotifyMetricsChanged; virtual; abstract;
procedure NotifyVisualsChanged; virtual; abstract;
function GetTempBitmap: TBitmap; virtual; abstract;
function ClientToScreen(Point: T2DIntPoint): T2DIntPoint; virtual; abstract;
end;
implementation

12
components/spktoolbar/SpkToolbar/spkt_Exceptions.pas
View File

@ -14,12 +14,14 @@ unit spkt_Exceptions;
interface
uses SysUtils;
uses
SysUtils;
type InternalException = class(Exception);
AssignException = class(Exception);
RuntimeException = class(Exception);
ListException = class(Exception);
type
InternalException = class(Exception);
AssignException = class(Exception);
RuntimeException = class(Exception);
ListException = class(Exception);
implementation

157
components/spktoolbar/SpkToolbar/spkt_Items.pas
View File

@ -15,45 +15,48 @@ unit spkt_Items;
interface
uses Classes, Controls, SysUtils, Dialogs,
spkt_Appearance, spkt_Dispatch, spkt_BaseItem, spkt_Types,
spkt_Buttons, spkt_Checkboxes;
uses
Classes, Controls, SysUtils, Dialogs,
spkt_Appearance, spkt_Dispatch, spkt_BaseItem, spkt_Types,
spkt_Buttons, spkt_Checkboxes;
type TSpkItems = class(TSpkCollection)
private
FToolbarDispatch : TSpkBaseToolbarDispatch;
FAppearance : TSpkToolbarAppearance;
FImages : TImageList;
FDisabledImages : TImageList;
FLargeImages : TImageList;
FDisabledLargeImages : TImageList;
type
TSpkItems = class(TSpkCollection)
private
FToolbarDispatch: TSpkBaseToolbarDispatch;
FAppearance: TSpkToolbarAppearance;
FImages: TImageList;
FDisabledImages: TImageList;
FLargeImages: TImageList;
FDisabledLargeImages: TImageList;
// *** Gettery i settery ***
procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch);
function GetItems(index: integer): TSpkBaseItem; 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);
public
function AddLargeButton : TSpkLargeButton;
function AddSmallButton : TSpkSmallButton;
function AddCheckbox: TSpkCheckbox;
function AddRadioButton: TSpkRadioButton;
// *** Gettery i settery ***
procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch);
function GetItems(AIndex: integer): TSpkBaseItem; 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);
// *** Reakcja na zmiany listy ***
procedure Notify(Item: TComponent; Operation : TOperation); override;
procedure Update; override;
public
function AddLargeButton: TSpkLargeButton;
function AddSmallButton: TSpkSmallButton;
function AddCheckbox: TSpkCheckbox;
function AddRadioButton: TSpkRadioButton;
property Items[index : integer] : TSpkBaseItem 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;
end;
// *** Reakcja na zmiany listy ***
procedure Notify(Item: TComponent; Operation: TOperation); override;
procedure Update; override;
property Items[index: integer]: TSpkBaseItem 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;
end;
implementation
@ -87,47 +90,45 @@ begin
AddItem(Result);
end;
function TSpkItems.GetItems(index: integer): TSpkBaseItem;
function TSpkItems.GetItems(AIndex: integer): TSpkBaseItem;
begin
result:=TSpkBaseItem(inherited Items[index]);
Result := TSpkBaseItem(inherited Items[AIndex]);
end;
procedure TSpkItems.Notify(Item: TComponent;
Operation : TOperation);
procedure TSpkItems.Notify(Item: TComponent; Operation: TOperation);
begin
inherited Notify(Item, Operation);
case Operation of
opInsert: begin
// Ustawienie dyspozytora na nil spowoduje, ¿e podczas
// przypisywania w³asnoœci nie bêd¹ wo³ane metody Notify*
TSpkBaseItem(Item).ToolbarDispatch:=nil;
opInsert:
begin
// Ustawienie dyspozytora na nil spowoduje, ¿e podczas
// przypisywania w³asnoœci nie bêd¹ wo³ane metody Notify*
TSpkBaseItem(Item).ToolbarDispatch := nil;
TSpkBaseItem(Item).Appearance := FAppearance;
TSpkBaseItem(Item).Images := FImages;
TSpkBaseItem(Item).DisabledImages := FDisabledImages;
TSpkBaseItem(Item).LargeImages := FLargeImages;
TSpkBaseItem(Item).DisabledLargeImages := FDisabledLargeImages;
TSpkBaseItem(Item).ToolbarDispatch := FToolbarDispatch;
end;
TSpkBaseItem(Item).Appearance:=FAppearance;
TSpkBaseItem(Item).Images:=FImages;
TSpkBaseItem(Item).DisabledImages:=FDisabledImages;
TSpkBaseItem(Item).LargeImages:=FLargeImages;
TSpkBaseItem(Item).DisabledLargeImages:=FDisabledLargeImages;
TSpkBaseItem(Item).ToolbarDispatch:=FToolbarDispatch;
end;
opRemove: begin
if not(csDestroying in Item.ComponentState) then
begin
TSpkBaseItem(Item).ToolbarDispatch:=nil;
TSpkBaseItem(Item).Appearance:=nil;
TSpkBaseItem(Item).Images:=nil;
TSpkBaseItem(Item).DisabledImages:=nil;
TSpkBaseItem(Item).LargeImages:=nil;
TSpkBaseItem(Item).DisabledLargeImages:=nil;
end;
end;
opRemove:
if not (csDestroying in Item.ComponentState) then
begin
TSpkBaseItem(Item).ToolbarDispatch := nil;
TSpkBaseItem(Item).Appearance := nil;
TSpkBaseItem(Item).Images := nil;
TSpkBaseItem(Item).DisabledImages := nil;
TSpkBaseItem(Item).LargeImages := nil;
TSpkBaseItem(Item).DisabledLargeImages := nil;
end;
end;
end;
procedure TSpkItems.SetAppearance(const Value: TSpkToolbarAppearance);
var i: Integer;
var
i: Integer;
begin
FAppearance := Value;
for i := 0 to Count - 1 do
@ -135,9 +136,8 @@ begin
end;
procedure TSpkItems.SetDisabledImages(const Value: TImageList);
var i: Integer;
var
i: Integer;
begin
FDisabledImages := Value;
for i := 0 to Count - 1 do
@ -145,9 +145,8 @@ begin
end;
procedure TSpkItems.SetDisabledLargeImages(const Value: TImageList);
var i: Integer;
var
i: Integer;
begin
FDisabledLargeImages := Value;
for i := 0 to Count - 1 do
@ -155,9 +154,8 @@ begin
end;
procedure TSpkItems.SetImages(const Value: TImageList);
var i: Integer;
var
i: Integer;
begin
FImages := Value;
for i := 0 to Count - 1 do
@ -165,9 +163,8 @@ begin
end;
procedure TSpkItems.SetLargeImages(const Value: TImageList);
var i: Integer;
var
i: Integer;
begin
FLargeImages := Value;
for i := 0 to Count - 1 do
@ -175,9 +172,8 @@ begin
end;
procedure TSpkItems.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch);
var i : integer;
var
i : integer;
begin
FToolbarDispatch := Value;
for i := 0 to Count - 1 do
@ -187,8 +183,7 @@ end;
procedure TSpkItems.Update;
begin
inherited Update;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyItemsChanged;
end;

1425
components/spktoolbar/SpkToolbar/spkt_Pane.pas
View File

File diff suppressed because it is too large Load Diff

981
components/spktoolbar/SpkToolbar/spkt_Tab.pas
View File

File diff suppressed because it is too large Load Diff

42
components/spktoolbar/SpkToolbar/spkt_Tools.pas
View File

@ -18,25 +18,24 @@ interface
uses
Graphics, SysUtils, SpkMath, SpkGUITools;
type TButtonTools = class sealed(TObject)
private
protected
public
class procedure DrawButton(Bitmap: TBitmap;
Rect: T2DIntRect;
FrameColor,
InnerLightColor,
InnerDarkColor,
GradientFrom,
GradientTo: TColor;
GradientKind: TBackgroundKind;
LeftEdgeOpen,
RightEdgeOpen,
TopEdgeOpen,
BottomEdgeOpen: boolean;
Radius: integer;
ClipRect: T2DIntRect);
end;
type
TButtonTools = class sealed(TObject)
public
class procedure DrawButton(Bitmap: TBitmap;
Rect: T2DIntRect;
FrameColor,
InnerLightColor,
InnerDarkColor,
GradientFrom,
GradientTo: TColor;
GradientKind: TBackgroundKind;
LeftEdgeOpen,
RightEdgeOpen,
TopEdgeOpen,
BottomEdgeOpen: boolean;
Radius: integer;
ClipRect: T2DIntRect);
end;
implementation
@ -46,13 +45,12 @@ class procedure TButtonTools.DrawButton(Bitmap: TBitmap;
Rect: T2DIntRect; FrameColor, InnerLightColor, InnerDarkColor, GradientFrom,
GradientTo: TColor; GradientKind: TBackgroundKind; LeftEdgeOpen,
RightEdgeOpen, TopEdgeOpen, BottomEdgeOpen: boolean; Radius: integer;
ClipRect : T2DIntRect);
ClipRect: T2DIntRect);
var
x1, x2, y1, y2: integer;
LeftClosed, TopClosed, RightClosed, BottomClosed: byte;
begin
if (Rect.Width <6 ) or (Rect.Height < 6) or
if (Rect.Width < 6) or (Rect.Height < 6) or
(Rect.Width < 2*Radius) or (Rect.Height < 2*Radius) then exit;
if LeftEdgeOpen then LeftClosed := 0 else LeftClosed := 1;

191
components/spktoolbar/SpkToolbar/spkt_Types.pas
View File

@ -14,86 +14,104 @@ unit spkt_Types;
interface
uses Controls, Classes, ContNrs, SysUtils, Dialogs,
spkt_Exceptions;
uses
Controls, Classes, ContNrs, SysUtils, Dialogs,
spkt_Exceptions;
type TSpkListState = (lsNeedsProcessing, lsReady);
type
TSpkListState = (lsNeedsProcessing, lsReady);
type TSpkCollection = class(TPersistent)
private
protected
FList : TFPObjectList;
FNames : TStringList;
FListState : TSpkListState;
FRootComponent : TComponent;
TSpkCollection = class(TPersistent)
protected
FList: TFPObjectList;
FNames: TStringList;
FListState: TSpkListState;
FRootComponent: TComponent;
// *** Metody reakcji na zmiany w liœcie ***
// *** Methods responding to changes in list ***
procedure Notify(Item : TComponent; Operation : TOperation); virtual;
procedure Update; virtual;
// *** Metody reakcji na zmiany w liœcie ***
// *** Methods responding to changes in list ***
procedure Notify(Item: TComponent; Operation: TOperation); virtual;
procedure Update; virtual;
// *** Wewnêtrzne metody dodawania i wstawiania elementów ***
// *** Gettery i settery ***
// *** Wewnêtrzne metody dodawania i wstawiania elementów ***
// *** Gettery i settery ***
// *** Internal methods for adding and inserting elements ***
// *** Getters and setters ***
function GetItems(index: integer): TComponent; virtual;
public
// *** Konstruktor, destruktor ***
constructor Create(RootComponent : TComponent); reintroduce; virtual;
destructor Destroy; override;
// *** Internal methods for adding and inserting elements ***
// *** Getters and setters ***
function GetItems(AIndex: integer): TComponent; virtual;
// *** Obs³uga listy ***
// *** List operations ***
procedure AddItem(AItem: TComponent);
procedure InsertItem(index: integer; AItem: TComponent);
procedure Clear;
function Count: integer;
procedure Delete(index: integer); virtual;
function IndexOf(Item: TComponent) : integer;
procedure Remove(Item: TComponent); virtual;
procedure RemoveReference(Item: TComponent);
procedure Exchange(item1, item2: integer);
procedure Move(IndexFrom, IndexTo: integer);
public
// *** Konstruktor, destruktor ***
constructor Create(ARootComponent : TComponent); reintroduce; virtual;
destructor Destroy; override;
// *** Reader, writer i obs³uga designtime i DFM ***
// *** Reader, writer and operation designtime and DFM
procedure WriteNames(Writer: TWriter); virtual;
procedure ReadNames(Reader: TReader); virtual;
procedure ProcessNames(Owner: TComponent); virtual;
// *** Obs³uga listy ***
// *** List operations ***
procedure AddItem(AItem: TComponent);
procedure InsertItem(AIndex: integer; AItem: TComponent);
procedure Clear;
function Count: integer;
procedure Delete(AIndex: integer); virtual;
function IndexOf(Item: TComponent) : integer;
procedure Remove(Item: TComponent); virtual;
procedure RemoveReference(Item: TComponent);
procedure Exchange(item1, item2: integer);
procedure Move(IndexFrom, IndexTo: integer);
property ListState : TSpkListState read FListState;
property Items[index : integer] : TComponent read GetItems; default;
property RootComponent: TComponent read FRootComponent;
end;
// *** Reader, writer i obs³uga designtime i DFM ***
// *** Reader, writer and operation designtime and DFM
procedure WriteNames(Writer: TWriter); virtual;
procedure ReadNames(Reader: TReader); virtual;
procedure ProcessNames(Owner: TComponent); virtual;
type TSpkComponent = class(TComponent)
private
protected
FParent : TComponent;
FCollection: TSpkCollection;
public
// *** Obs³uga parenta ***
// *** Parent operations ***
function HasParent : boolean; override;
function GetParentComponent : TComponent; override;
procedure SetParentComponent(Value : TComponent); override;
property ListState: TSpkListState read FListState;
property Items[index: integer] : TComponent read GetItems; default;
property RootComponent: TComponent read FRootComponent;
end;
TSpkComponent = class(TComponent)
protected
FParent: TComponent;
FCollection: TSpkCollection;
public
// *** Obs³uga parenta ***
// *** Parent operations ***
function HasParent: boolean; override;
function GetParentComponent: TComponent; override;
procedure SetParentComponent(Value: TComponent); override;
property Parent: TComponent read FParent write SetParentComponent;
property Collection: TSpkCollection read FCollection;
end;
property Parent : TComponent read FParent write SetParentComponent;
property Collection: TSpkCollection read FCollection;
end;
implementation
{ TSpkCollection }
constructor TSpkCollection.Create(ARootComponent: TComponent);
begin
inherited Create;
FRootComponent := ARootComponent;
FNames := TStringList.Create;
FList := TFPObjectList.Create(False);
FListState := lsReady;
end;
destructor TSpkCollection.Destroy;
begin
FNames.Free;
FList.Free;
inherited;
end;
procedure TSpkCollection.AddItem(AItem: TComponent);
begin
// Ta metoda mo¿e byæ wywo³ywana bez przetworzenia nazw (w szczególnoœci, metoda
// przetwarzaj¹ca nazwy korzysta z AddItem)
// Ta metoda mo¿e byæ wywo³ywana bez przetworzenia nazw (w szczególnoœci, metoda
// przetwarzaj¹ca nazwy korzysta z AddItem)
// This method can be recalling untreated names (in particular, the method
// uses the name przetwarzaj¹ca AddItem) --- ???
// This method can be recalling untreated names (in particular, the method
// uses the name przetwarzaj¹ca AddItem) --- ???
Notify(AItem, opInsert);
FList.Add(AItem);
@ -112,49 +130,31 @@ end;
function TSpkCollection.Count: integer;
begin
result := FList.Count;
Result := FList.Count;
end;
constructor TSpkCollection.Create(RootComponent : TComponent);
procedure TSpkCollection.Delete(AIndex: integer);
begin
inherited Create;
FRootComponent := RootComponent;
FNames := TStringList.create;
FList := TFPObjectList.create(False);
FListState := lsReady;
end;
procedure TSpkCollection.Delete(index: integer);
begin
if (index < 0) or (index >= FList.count) then
if (AIndex < 0) or (AIndex >= FList.count) then
raise InternalException.Create('TSpkCollection.Delete: Illegal index!');
//raise InternalException.Create('TSpkCollection.Delete: Nieprawid³owy indeks!');
Notify(TComponent(FList[index]), opRemove);
FList.Delete(index);
Notify(TComponent(FList[AIndex]), opRemove);
FList.Delete(AIndex);
Update;
end;
destructor TSpkCollection.Destroy;
begin
FNames.Destroy;
FList.Destroy;
inherited;
end;
procedure TSpkCollection.Exchange(item1, item2: integer);
begin
FList.Exchange(item1, item2);
Update;
end;
function TSpkCollection.GetItems(index: integer): TComponent;
function TSpkCollection.GetItems(AIndex: integer): TComponent;
begin
if (index < 0) or (index >= FList.Count) then
if (AIndex < 0) or (AIndex >= FList.Count) then
raise InternalException.Create('TSpkCollection.Delete: Illegal index!');
//raise InternalException.create('TSpkCollection.GetItems: Nieprawid³owy indeks!');
result := TComponent(FList[index]);
Result := TComponent(FList[AIndex]);
end;
function TSpkCollection.IndexOf(Item: TComponent): integer;
@ -162,14 +162,13 @@ begin
result := FList.IndexOf(Item);
end;
procedure TSpkCollection.InsertItem(index: integer; AItem: TComponent);
procedure TSpkCollection.InsertItem(AIndex: integer; AItem: TComponent);
begin
if (index < 0) or (index > FList.Count) then
if (AIndex < 0) or (AIndex > FList.Count) then
raise InternalException.Create('TSpkCollection.Delete: Illegal index!');
//raise InternalException.Create('TSpkCollection.Insert: Nieprawid³owy indeks!');
Notify(AItem, opInsert);
FList.Insert(index, AItem);
FList.Insert(AIndex, AItem);
if AItem is TSpkComponent then
TSpkComponent(AItem).FCollection := self;
Update;
@ -181,7 +180,6 @@ begin
(indexTo < 0) or (indexTo >= FList.Count)
then
raise InternalException.Create('TSpkCollection.Delete: Illegal index!');
//raise InternalException.Create('TSpkCollection.Move: Nieprawid³owy indeks!');
FList.Move(IndexFrom, IndexTo);
Update;
@ -242,7 +240,7 @@ end;
procedure TSpkCollection.Update;
begin
//
//
end;
procedure TSpkCollection.WriteNames(Writer: TWriter);
@ -255,16 +253,17 @@ begin
Writer.WriteListEnd;
end;
{ TSpkComponent }
function TSpkComponent.GetParentComponent: TComponent;
begin
result := FParent;
Result := FParent;
end;
function TSpkComponent.HasParent: boolean;
begin
result := FParent<>nil;
Result := (FParent <> nil);
end;
procedure TSpkComponent.SetParentComponent(Value: TComponent);

BIN
components/spktoolbar/demos/basic/Project1.res
View File

Binary file not shown.

7
components/spktoolbar/designtime/spkte_AppearanceEditor.pas
View File

@ -5,11 +5,10 @@ unit spkte_AppearanceEditor;
interface
uses
LCLIntf, LCLType, LMessages, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
LCLIntf, LCLType, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, ComCtrls, Buttons, Spin,
SpkGUITools, SpkXMLParser,
spkt_Buttons, spkt_BaseItem, spkt_Pane, spkt_Types, spkt_Tab, SpkToolbar,
spkt_Appearance;
SpkGUITools, SpkXMLParser, SpkToolbar,
spkt_Buttons, spkt_Pane, spkt_Tab, spkt_Appearance;
type