paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-29 22:12:44 +02:00
Code Issues Packages Projects Releases Wiki Activity

A skeleton implementation for a new component ControlBar

Browse Source 
git-svn-id: trunk@39990 -
This commit is contained in:
juha 2013-01-27 23:28:12 +00:00
parent f0c775cd24
commit 27f76c34f7
3 changed files with 306 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -5697,7 +5697,7 @@ lcl/dynamicarray.pas svneol=native#text/pascal
lcl/dynhasharray.pp svneol=native#text/pascal
lcl/dynqueue.pas svneol=native#text/pascal
lcl/editbtn.pas svneol=native#text/pascal
lcl/extctrls.pp svneol=native#text/pascal
lcl/extctrls.pp svneol=native#text/plain
lcl/extdlgs.pas svneol=native#text/pascal
lcl/extendedstrings.pas svneol=native#text/pascal
lcl/extgraphics.pas svneol=native#text/pascal
@ -5821,6 +5821,7 @@ lcl/include/commondialog.inc svneol=native#text/pascal
lcl/include/containedaction.inc svneol=native#text/pascal
lcl/include/control.inc svneol=native#text/pascal
lcl/include/controlactionlink.inc svneol=native#text/pascal
lcl/include/controlbar.inc svneol=native#text/plain
lcl/include/controlcanvas.inc svneol=native#text/pascal
lcl/include/controlscrollbar.inc svneol=native#text/pascal
lcl/include/controlsproc.inc svneol=native#text/pascal

139
lcl/extctrls.pp
View File

@ -35,7 +35,7 @@ interface
uses
SysUtils, Types, Classes, LCLStrConsts, LCLType, LCLProc, LResources, Controls,
Forms, StdCtrls, lMessages, GraphType, Graphics, LCLIntf, CustomTimer, Themes,
LCLClasses, Menus, popupnotifier, ImgList;
LCLClasses, Menus, PopupNotifier, ImgList, contnrs;
type
@ -1139,6 +1139,140 @@ type
property OnPaint;
end;
{ TControlBar }
TBandPaintOption = (bpoGrabber, bpoFrame);
TBandPaintOptions = set of TBandPaintOption;
TBandDragEvent = procedure (Sender: TObject; Control: TControl; var Drag: Boolean) of object;
TBandInfoEvent = procedure (Sender: TObject; Control: TControl;
var Insets: TRect; var PreferredSize, RowCount: Integer) of object;
TBandMoveEvent = procedure (Sender: TObject; Control: TControl; var ARect: TRect) of object;
TBandPaintEvent = procedure (Sender: TObject; Control: TControl; Canvas: TCanvas;
var ARect: TRect; var Options: TBandPaintOptions) of object;
// TCheckDoAgainEvent = function (cbi: TControlBarInfo; const aPos: TPoint; aWidth: Integer): Boolean; of object;
TRowSize = 1..MaxInt;
{ TCustomControlBar }
TCustomControlBar = class(TCustomPanel)
private
FAutoDrag: Boolean;
FAutoDock: Boolean;
FDockingControl: TControl;
FDragControl: TControl;
FDragOffset: TPoint;
FDrawing: Boolean;
FPicture: TPicture;
FRowSize: TRowSize;
FRowSnap: Boolean;
FOnBandDrag: TBandDragEvent;
FOnBandInfo: TBandInfoEvent;
FOnBandMove: TBandMoveEvent;
FOnBandPaint: TBandPaintEvent;
FOnCanResize: TCanResizeEvent;
FOnPaint: TNotifyEvent;
procedure SetPicture(aValue: TPicture);
protected
procedure AlignControls(aControl: TControl; var aRect: TRect); override;
function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
procedure CreateParams(var aParams: TCreateParams); override;
procedure DoBandMove(aControl: TControl; var aRect: TRect); virtual;
procedure DoBandPaint(aControl: TControl; aCanvas: TCanvas;
var aRect: TRect; var aOptions: TBandPaintOptions); virtual;
function DragControl(aControl: TControl; X, Y: Integer;
KeepCapture: Boolean = False): Boolean; virtual;
procedure GetControlInfo(aControl: TControl; var Insets: TRect;
var PreferredSize, RowCount: Integer); virtual;
function GetPalette: HPALETTE; override;
function DoDragMsg(ADragMessage: TDragMessage; APosition: TPoint; ADragObject: TDragObject;
ATarget: TControl; ADocking: Boolean): LRESULT; override;
procedure DockOver(aSource: TDragDockObject; X, Y: Integer; aState: TDragState;
var Accept: Boolean); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure FlipChildren(AllLevels: Boolean); override;
procedure StickControls; virtual;
property Picture: TPicture read FPicture write SetPicture;
protected
property AutoDock: Boolean read FAutoDock write FAutoDock default True;
property AutoDrag: Boolean read FAutoDrag write FAutoDrag default True;
property AutoSize;
property DockSite default True;
property RowSize: TRowSize read FRowSize write FRowSize default 26;
property RowSnap: Boolean read FRowSnap write FRowSnap default True;
property OnBandDrag: TBandDragEvent read FOnBandDrag write FOnBandDrag;
property OnBandInfo: TBandInfoEvent read FOnBandInfo write FOnBandInfo;
property OnBandMove: TBandMoveEvent read FOnBandMove write FOnBandMove;
property OnBandPaint: TBandPaintEvent read FOnBandPaint write FOnBandPaint;
property OnCanResize: TCanResizeEvent read FOnCanResize write FOnCanResize;
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
end;
TControlBar = class(TCustomControlBar)
public
property Canvas;
published
property Align;
property Anchors;
property AutoDock;
property AutoDrag;
property AutoSize;
property BevelInner;
property BevelOuter;
property BevelWidth;
property BorderWidth;
property Color nodefault;
property Constraints;
property DockSite;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property ParentColor;
property ParentFont;
property ParentShowHint;
// property Picture;
property PopupMenu;
property RowSize;
property RowSnap;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnBandDrag;
property OnBandInfo;
property OnBandMove;
property OnBandPaint;
property OnCanResize;
property OnClick;
property OnConstrainedResize;
property OnContextPopup;
property OnDockDrop;
property OnDockOver;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetSiteInfo;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnPaint;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
end;
procedure Frame3D(ACanvas: TCanvas; var ARect: TRect;
TopColor, BottomColor: TColor; const FrameWidth: integer);
@ -1163,7 +1297,7 @@ procedure Register;
begin
RegisterComponents('Standard',[TRadioGroup,TCheckGroup,TPanel]);
RegisterComponents('Additional',[TImage,TShape,TBevel,TPaintBox,
TNotebook, TLabeledEdit, TSplitter, TTrayIcon]);
TNotebook, TLabeledEdit, TSplitter, TTrayIcon, TControlBar]);
RegisterComponents('System',[TTimer,TIdleTimer]);
RegisterNoIcon([TPage]);
end;
@ -1182,6 +1316,7 @@ end;
{$I bevel.inc}
{$I customimage.inc}
{$I customtrayicon.inc}
{$I controlbar.inc}
initialization
DockSplitterClass := TSplitter;

167
lcl/include/controlbar.inc Normal file
View File

@ -0,0 +1,167 @@
{%MainUnit ../extctrls.pp}
{******************************************************************************
TControlBar
******************************************************************************
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
}
{ TCustomControlBar }
constructor TCustomControlBar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
csDoubleClicks, csOpaque, csParentBackground];
FAutoDrag := True;
FAutoDock := True;
DragMode := dmAutomatic;
FPicture := TPicture.Create;
// FPicture.OnChange := @PictureChanged;
FRowSize := 26;
FRowSnap := True;
DoubleBuffered := True;
DockSite := True;
Width := 100;
Height := 50;
end;
destructor TCustomControlBar.Destroy;
begin
FPicture.Free;
inherited Destroy;
end;
procedure TCustomControlBar.AlignControls(aControl: TControl; var aRect: TRect);
begin
// ToDo: The layout algorithm must be implemented here.
DebugLn('TCustomControlBar.AlignControls');
end;
function TCustomControlBar.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
Result := inherited CanAutoSize(NewWidth, NewHeight);
DebugLn('TCustomControlBar.CanAutoSize');
end;
procedure TCustomControlBar.SetPicture(aValue: TPicture);
begin
FPicture.Assign(aValue);
end;
procedure TCustomControlBar.CreateParams(var aParams: TCreateParams);
begin
inherited CreateParams(aParams);
end;
procedure TCustomControlBar.DoBandMove(aControl: TControl; var aRect: TRect);
begin
DebugLn('TCustomControlBar.DoBandMove');
if Assigned(FOnBandMove) then
FOnBandMove(Self, aControl, aRect);
end;
procedure TCustomControlBar.DoBandPaint(aControl: TControl; aCanvas: TCanvas;
var aRect: TRect; var aOptions: TBandPaintOptions);
begin
if Assigned(FOnBandPaint) then
FOnBandPaint(Self, aControl, aCanvas, aRect, aOptions);
end;
procedure TCustomControlBar.DockOver(aSource: TDragDockObject; X, Y: Integer;
aState: TDragState; var Accept: Boolean);
begin
inherited DockOver(aSource, X, Y, aState, Accept);
DebugLn('TCustomControlBar.DockOver');
end;
function TCustomControlBar.DragControl(aControl: TControl; X, Y: Integer;
KeepCapture: Boolean): Boolean;
begin
DebugLn('TCustomControlBar.DragControl');
Result := True;
if Assigned(aControl) and Assigned(FOnBandDrag) then
FOnBandDrag(Self, aControl, Result);
if Result then
aControl.BeginDrag(True);
end;
procedure TCustomControlBar.GetControlInfo(aControl: TControl;
var Insets: TRect; var PreferredSize, RowCount: Integer);
begin
if RowCount = 0 then
RowCount := 1;
if Assigned(FOnBandInfo) then
FOnBandInfo(Self, aControl, Insets, PreferredSize, RowCount);
end;
function TCustomControlBar.GetPalette: HPALETTE;
begin
if FPicture.Graphic <> nil then
Result := FPicture.Graphic.Palette
else
Result := 0;
end;
function TCustomControlBar.DoDragMsg(ADragMessage: TDragMessage; APosition: TPoint;
ADragObject: TDragObject; ATarget: TControl; ADocking: Boolean): LRESULT;
begin
DebugLn('TCustomControlBar.DoDragMsg');
Result:=inherited DoDragMsg(ADragMessage, APosition, ADragObject, ATarget, ADocking);
end;
procedure TCustomControlBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
DebugLn('TCustomControlBar.MouseDown_1');
inherited MouseDown(Button, Shift, X, Y);
// ToDo
end;
procedure TCustomControlBar.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
DebugLn('TCustomControlBar.MouseMove_1');
inherited MouseMove(Shift, X, Y);
// ToDo
end;
procedure TCustomControlBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
Cntrl: TControl;
begin
DebugLn('TCustomControlBar.MouseUp');
// ToDo
if Assigned(FDragControl) then
begin
end;
inherited MouseUp(Button, Shift, X, Y);
end;
procedure TCustomControlBar.Paint;
begin
// ToDo
end;
procedure TCustomControlBar.FlipChildren(AllLevels: Boolean);
begin
// Do nothing
end;
procedure TCustomControlBar.StickControls;
begin
// ToDo
end;