paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-05 14:57:57 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: added designer-popupmenu

Browse Source 
git-svn-id: trunk@249 -
This commit is contained in:
lazarus 2001-04-02 14:41:31 +00:00
parent d6756d69bb
commit 74e4ef2d2d
6 changed files with 1005 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -23,6 +23,7 @@ designer/abstractcompiler.pp svneol=native#text/pascal
designer/abstracteditor.pp svneol=native#text/pascal
designer/abstractfilesystem.pp svneol=native#text/pascal
designer/abstractformeditor.pp svneol=native#text/pascal
designer/aligncompsdlg.pp svneol=native#text/pascal
designer/bookmark.lrs svneol=native#text/pascal
designer/controlselection.pp svneol=native#text/pascal
designer/customeditor.pp svneol=native#text/pascal
@ -33,6 +34,8 @@ designer/jitforms.pp svneol=native#text/pascal
designer/lazarus_control_images.lrs svneol=native#text/pascal
designer/objectinspector.pp svneol=native#text/pascal
designer/propedits.pp svneol=native#text/pascal
designer/scalecompsdlg.pp svneol=native#text/pascal
designer/sizecompsdlg.pp svneol=native#text/pascal
designer/widgetstack.pp svneol=native#text/pascal
examples/bitbtnform.pp svneol=native#text/pascal
examples/bitbutton.pp svneol=native#text/pascal

145
designer/aligncompsdlg.pp Normal file
View File

@ -0,0 +1,145 @@
{
Author: Mattias Gaertner
Abstract:
Defines TAlignComponentsDialog.
}
unit AlignCompsDlg;
{$mode objfpc}{$H+}
interface
uses
Classes, LCLLinux, Forms, Controls, Buttons, ExtCtrls, LResources;
type
TAlignComponentsDialog = class(TForm)
HorizontalRadioGroup: TRadioGroup;
VerticalRadioGroup: TRadioGroup;
OkButton: TButton;
CancelButton: TButton;
procedure OkButtonClick(Sender: TObject);
procedure CancelButtonClick(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
end;
var AlignComponentsDialog: TAlignComponentsDialog;
function ShowAlignComponentsDialog: TModalResult;
implementation
function ShowAlignComponentsDialog: TModalResult;
begin
if AlignComponentsDialog=nil then
AlignComponentsDialog:=TAlignComponentsDialog.Create(Application);
with AlignComponentsDialog do begin
SetBounds((Screen.Width-365) div 2,(Screen.Height-225) div 2,355,215);
HorizontalRadioGroup.ItemIndex:=0;
VerticalRadioGroup.ItemIndex:=0;
Result:=ShowModal;
end;
end;
{ TAlignComponentsDialog }
constructor TAlignComponentsDialog.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
if LazarusResources.Find(Classname)=nil then begin
SetBounds((Screen.Width-365) div 2,(Screen.Height-225) div 2,355,215);
Caption:='Alignment';
HorizontalRadioGroup:=TRadioGroup.Create(Self);
with HorizontalRadioGroup do begin
Name:='HorizontalRadioGroup';
Parent:=Self;
Left:=5;
Top:=5;
Width:=170;
Height:=165;
Caption:='Horizontal';
with Items do begin
BeginUpdate;
Add('No change');
Add('Left sides');
Add('Centers');
Add('Right sides');
Add('Center in window');
Add('Space equally');
Add('Left space equally');
Add('Right space equally');
EndUpdate;
end;
Show;
end;
VerticalRadioGroup:=TRadioGroup.Create(Self);
with VerticalRadioGroup do begin
Name:='VerticalRadioGroup';
Parent:=Self;
Left:=180;
Top:=5;
Width:=170;
Height:=165;
Caption:='Vertical';
with Items do begin
BeginUpdate;
Add('No change');
Add('Tops');
Add('Centers');
Add('Bottoms');
Add('Center in window');
Add('Space equally');
Add('Top space equally');
Add('Bottom space equally');
EndUpdate;
end;
Show;
end;
OkButton:=TButton.Create(Self);
with OkButton do begin
Name:='OkButton';
Parent:=Self;
Left:=145;
Top:=179;
Width:=75;
Height:=25;
Caption:='Ok';
OnClick:=@OkButtonClick;
Show;
end;
CancelButton:=TButton.Create(Self);
with CancelButton do begin
Name:='CancelButton';
Parent:=Self;
Left:=235;
Top:=OkButton.Top;
Width:=75;
Height:=25;
Caption:='Cancel';
OnClick:=@CancelButtonClick;
Show;
end;
end;
end;
procedure TAlignComponentsDialog.OkButtonClick(Sender: TObject);
begin
ModalResult:=mrOk;
end;
procedure TAlignComponentsDialog.CancelButtonClick(Sender: TObject);
begin
ModalResult:=mrCancel;
end;
initialization
AlignComponentsDialog:=nil;
end.

326
designer/controlselection.pp
View File

@ -98,6 +98,12 @@ type
procedure SaveBounds;
end;
TComponentAlignment = (csaNone, csaSides1, csaCenters, csaSides2,
csaCenterInWindow, csaSpaceEqually, csaSide1SpaceEqually,
csaSide2SpaceEqually);
TComponentSizing = (cssNone, cssShrinkToSmallest, cssGrowToLargest, cssFixed);
TSelectionSortCompare = function(Index1, Index2: integer): integer of object;
TControlSelection = class(TObject)
private
FControls: TList; // list of TSelectedComponent
@ -135,14 +141,21 @@ type
function GetGrabbers(AGrabIndex:TGrabIndex): TGrabber;
procedure SetGrabbers(AGrabIndex:TGrabIndex; const AGrabber: TGrabber);
procedure SetGrabberSize(const NewSize: integer);
procedure AdjustGrabber;
procedure DoChange;
procedure SetVisible(const Value: Boolean);
function GetItems(Index:integer):TSelectedControl;
procedure SetItems(Index:integer; ASelectedControl:TSelectedControl);
procedure SetActiveGrabber(AGrabber:TGrabber);
procedure SetRubberBandBounds(ARect:TRect);
function CompareInts(i1, i2: integer): integer;
function CompareLeft(Index1, Index2: integer): integer;
function CompareTop(Index1, Index2: integer): integer;
function CompareRight(Index1, Index2: integer): integer;
function CompareBottom(Index1, Index2: integer): integer;
function CompareHorCenter(Index1, Index2: integer): integer;
function CompareVertCenter(Index1, Index2: integer): integer;
protected
procedure AdjustGrabber;
public
constructor Create;
destructor Destroy; override;
@ -164,6 +177,12 @@ type
procedure SizeSelection(dx, dy: integer);
// size all controls depending on ActiveGrabber.
// if ActiveGrabber=nil then Right,Bottom
procedure AlignComponents(HorizAlignment, VertAlignment: TComponentAlignment);
procedure MirrorHorizontal;
procedure MirrorVertical;
procedure SizeComponents(HorizSizing: TComponentSizing; AWidth: integer;
VertSizing: TComponentSizing; AHeight: integer);
procedure ScaleComponents(Percent: integer);
property GrabberSize:integer read FGrabberSize write SetGrabberSize;
property GrabberColor: TColor read FGrabberColor write FGrabberColor;
procedure DrawGrabbers(DC: HDC);
@ -184,6 +203,7 @@ type
procedure DrawRubberband(DC: HDC);
function OnlyNonVisualComponentsSelected: boolean;
procedure SelectWithRubberBand(ACustomForm:TCustomForm; ExclusiveOr: boolean);
procedure Sort(SortProc: TSelectionSortCompare);
property Visible:boolean read FVisible write SetVisible;
end;
@ -635,7 +655,7 @@ begin
FIsResizing:=true;
for i:=0 to FControls.Count-1 do begin
with Items[i] do begin
writeln('TControlSelection.MoveSelection ',i,' ',OldLeft,',',OldTop,' d=',dx,',',dy);
//writeln('TControlSelection.MoveSelection ',i,' ',OldLeft,',',OldTop,' d=',dx,',',dy);
SetBounds(OldLeft+dx,OldTop+dy,Width,Height)
end;
end;
@ -949,4 +969,306 @@ begin
end;
end;
function TControlSelection.CompareInts(i1, i2: integer): integer;
begin
if i1<i2 then Result:=-1
else if i1=i2 then Result:=0
else Result:=1;
end;
function TControlSelection.CompareLeft(Index1, Index2: integer): integer;
begin
Result:=CompareInts(Items[Index1].Left,Items[Index2].Left);
end;
function TControlSelection.CompareTop(Index1, Index2: integer): integer;
begin
Result:=CompareInts(Items[Index1].Top,Items[Index2].Top);
end;
function TControlSelection.CompareRight(Index1, Index2: integer): integer;
begin
Result:=CompareInts(Items[Index1].Left+Items[Index1].Width
,Items[Index2].Left+Items[Index2].Width);
end;
function TControlSelection.CompareBottom(Index1, Index2: integer): integer;
begin
Result:=CompareInts(Items[Index1].Top+Items[Index1].Height
,Items[Index2].Top+Items[Index2].Height);
end;
function TControlSelection.CompareHorCenter(Index1, Index2: integer): integer;
begin
Result:=CompareInts(Items[Index1].Left+(Items[Index1].Width div 2)
,Items[Index2].Left+(Items[Index2].Width div 2));
end;
function TControlSelection.CompareVertCenter(Index1, Index2: integer): integer;
begin
Result:=CompareInts(Items[Index1].Top+(Items[Index1].Height div 2)
,Items[Index2].Top+(Items[Index2].Height div 2));
end;
procedure TControlSelection.AlignComponents(
HorizAlignment, VertAlignment: TComponentAlignment);
var i, ALeft, ATop, ARight, ABottom, HorCenter, VertCenter,
HorDiff, VertDiff, TotalWidth, TotalHeight, HorSpacing, VertSpacing,
x, y: integer;
begin
if (FControls.Count=0) or (Items[0].Component is TCustomForm)
or ((HorizAlignment=csaNone) and (VertAlignment=csaNone)) then exit;
BeginUpdate;
FIsResizing:=true;
// initializing
ALeft:=Items[0].Left;
ATop:=Items[0].Top;
ARight:=ALeft+Items[0].Width;
ABottom:=ATop+Items[0].Height;
TotalWidth:=Items[0].Width;
TotalHeight:=Items[0].Height;
for i:=1 to FControls.Count-1 do begin
ALeft:=Min(ALeft,Items[i].Left);
ATop:=Min(ATop,Items[i].Top);
ARight:=Max(ARight,Items[i].Left+Items[i].Width);
ABottom:=Max(ABottom,Items[i].Top+Items[i].Height);
inc(TotalWidth,Items[i].Width);
inc(TotalHeight,Items[i].Height);
end;
// move components horizontally
case HorizAlignment of
csaSides1, csaCenters, csaSides2, csaCenterInWindow:
begin
HorCenter:=(ALeft+ARight) div 2;
HorDiff:=(FCustomForm.Width div 2)-HorCenter;
for i:=0 to FControls.Count-1 do begin
case HorizAlignment of
csaSides1: Items[i].Left:=ALeft;
csaCenters: Items[i].Left:=HorCenter-(Items[i].Width div 2);
csaSides2: Items[i].Left:=ARight-Items[i].Width;
csaCenterInWindow: Items[i].Left:=Items[i].Left+HorDiff;
end;
end;
end;
csaSpaceEqually:
begin
HorSpacing:=(ARight-ALeft-TotalWidth) div (FControls.Count-1);
x:=ALeft;
Sort(@CompareHorCenter);
for i:=0 to FControls.Count-1 do begin
Items[i].Left:=x;
Inc(x,Items[i].Width+HorSpacing);
end;
end;
csaSide1SpaceEqually:
begin
Sort(@CompareLeft);
HorSpacing:=(Items[Count-1].Left-ALeft) div FControls.Count;
x:=ALeft;
for i:=0 to FControls.Count-1 do begin
Items[i].Left:=x;
inc(x,HorSpacing);
end;
end;
csaSide2SpaceEqually:
begin
Sort(@CompareRight);
HorSpacing:=(ARight-ALeft-Items[0].Width) div FControls.Count;
x:=ARight;
for i:=FControls.Count-1 downto 0 do begin
Items[i].Left:=x-Items[i].Width;
dec(x,HorSpacing);
end;
end;
end;
// move components vertically
case VertAlignment of
csaSides1, csaCenters, csaSides2, csaCenterInWindow:
begin
VertCenter:=(ATop+ABottom) div 2;
VertDiff:=(FCustomForm.Height div 2)-VertCenter;
for i:=0 to FControls.Count-1 do begin
case VertAlignment of
csaSides1: Items[i].Top:=ATop;
csaCenters: Items[i].Top:=VertCenter-(Items[i].Height div 2);
csaSides2: Items[i].Top:=ABottom-Items[i].Height;
csaCenterInWindow: Items[i].Top:=Items[i].Top+VertDiff;
end;
end;
end;
csaSpaceEqually:
begin
VertSpacing:=(ABottom-ATop-TotalHeight) div (FControls.Count-1);
y:=ATop;
Sort(@CompareVertCenter);
for i:=0 to FControls.Count-1 do begin
Items[i].Top:=y;
Inc(y,Items[i].Height+VertSpacing);
end;
end;
csaSide1SpaceEqually:
begin
Sort(@CompareTop);
VertSpacing:=(Items[Count-1].Top-ATop) div FControls.Count;
y:=ATop;
for i:=0 to FControls.Count-1 do begin
Items[i].Top:=y;
inc(y,VertSpacing);
end;
end;
csaSide2SpaceEqually:
begin
Sort(@CompareBottom);
VertSpacing:=(ABottom-ATop-Items[0].Height) div FControls.Count;
y:=ABottom;
for i:=FControls.Count-1 downto 0 do begin
Items[i].Top:=y-Items[i].Height;
dec(y,VertSpacing);
end;
end;
end;
FIsResizing:=false;
EndUpdate;
end;
procedure TControlSelection.MirrorHorizontal;
var i, ALeft, ARight, Middle: integer;
begin
if (FControls.Count=0) or (Items[0].Component is TCustomForm) then exit;
BeginUpdate;
FIsResizing:=true;
// initializing
ALeft:=Items[0].Left;
ARight:=ALeft+Items[0].Width;
for i:=1 to FControls.Count-1 do begin
ALeft:=Min(ALeft,Items[i].Left);
ARight:=Max(ARight,Items[i].Left+Items[i].Width);
end;
Middle:=(ALeft+ARight) div 2;
// move components
for i:=0 to FControls.Count-1 do begin
Items[i].Left:=2*Middle-Items[i].Left-Items[i].Width;
end;
FIsResizing:=false;
EndUpdate;
end;
procedure TControlSelection.MirrorVertical;
var i, ATop, ABottom, Middle: integer;
begin
if (FControls.Count=0) or (Items[0].Component is TCustomForm) then exit;
BeginUpdate;
FIsResizing:=true;
// initializing
ATop:=Items[0].Top;
ABottom:=ATop+Items[0].Height;
for i:=1 to FControls.Count-1 do begin
ATop:=Min(ATop,Items[i].Top);
ABottom:=Max(ABottom,Items[i].Top+Items[i].Height);
end;
Middle:=(ATop+ABottom) div 2;
// move components
for i:=0 to FControls.Count-1 do begin
Items[i].Top:=2*Middle-Items[i].Top-Items[i].Height;
end;
FIsResizing:=false;
EndUpdate;
end;
procedure TControlSelection.SizeComponents(
HorizSizing: TComponentSizing; AWidth: integer;
VertSizing: TComponentSizing; AHeight: integer);
var i: integer;
begin
if (FControls.Count=0) or (Items[0].Component is TCustomForm) then exit;
BeginUpdate;
FIsResizing:=true;
// initialize
case HorizSizing of
cssShrinkToSmallest, cssGrowToLargest:
AWidth:=Items[0].Width;
cssFixed:
if AWidth<1 then HorizSizing:=cssNone;
end;
case VertSizing of
cssShrinkToSmallest, cssGrowToLargest:
AHeight:=Items[0].Height;
cssFixed:
if AHeight<1 then VertSizing:=cssNone;
end;
for i:=1 to FControls.Count-1 do begin
case HorizSizing of
cssShrinkToSmallest: AWidth:=Min(AWidth,Items[i].Width);
cssGrowToLargest: AWidth:=Max(AWidth,Items[i].Width);
end;
case VertSizing of
cssShrinkToSmallest: AHeight:=Min(AHeight,Items[i].Height);
cssGrowToLargest: AHeight:=Max(AHeight,Items[i].Height);
end;
end;
// size components
for i:=0 to FControls.Count-1 do begin
if Items[i].Component is TControl then begin
if HorizSizing=cssNone then AWidth:=Items[i].Width;
if VertSizing=cssNone then AHeight:=Items[i].Height;
TControl(Items[i].Component).SetBounds(Items[i].Left,Items[i].Top,
Max(1,AWidth), Max(1,AHeight));
end;
end;
FIsResizing:=false;
EndUpdate;
end;
procedure TControlSelection.ScaleComponents(Percent: integer);
var i: integer;
begin
if (FControls.Count=0) or (Items[0].Component is TCustomForm) then exit;
BeginUpdate;
FIsResizing:=true;
if Percent<1 then Percent:=1;
if Percent>1000 then Percent:=1000;
// size components
for i:=0 to FControls.Count-1 do begin
if Items[i].Component is TControl then begin
TControl(Items[i].Component).SetBounds(Items[i].Left,Items[i].Top,
Max(1,(Items[i].Width*Percent) div 100),
Max(1,(Items[i].Height*Percent) div 100));
end;
end;
FIsResizing:=false;
EndUpdate;
end;
procedure TControlSelection.Sort(SortProc: TSelectionSortCompare);
var a, b: integer;
h: Pointer;
begin
for a:=0 to FControls.Count-1 do begin
for b:=a+1 to FControls.Count-1 do begin
if SortProc(a,b)>0 then begin
h:=FControls[a];
FControls[a]:=FControls[b];
FControls[b]:=h;
end;
end;
end;
DoChange;
end;
end.

266
designer/designer.pp
View File

@ -26,14 +26,10 @@ interface
uses
Classes, LCLLinux, Forms, Controls, LMessages, Graphics, ControlSelection,
CustomFormEditor, FormEditor, UnitEditor, CompReg;
CustomFormEditor, FormEditor, UnitEditor, CompReg, Menus, AlignCompsDlg,
SizeCompsDlg, ScaleCompsDlg;
type
TGridPoint = record
x: integer;
y: integer;
end;
TOnGetSelectedComponentClass = procedure(Sender: TObject;
var RegisteredComponent: TRegisteredComponent) of object;
TOnSetDesigning = procedure(Sender: TObject; Component: TComponent;
@ -41,9 +37,9 @@ type
TOnAddComponent = procedure(Sender: TObject; Component: TComponent;
ComponentClass: TRegisteredComponent) of object;
TOnRemoveComponent = procedure(Sender: TObject; Component: TComponent)
of object;
of object;
TOnGetNonVisualCompIconCanvas = procedure(Sender: TObject;
AComponent: TComponent; var IconCanvas: TCanvas) of object;
AComponent: TComponent; var IconCanvas: TCanvas) of object;
TDesigner = class(TIDesigner)
private
@ -61,12 +57,18 @@ type
FOnRemoveComponent: TOnRemoveComponent;
FOnSetDesigning: TOnSetDesigning;
FOnUnselectComponentClass: TNotifyEvent;
FPopupMenu: TPopupMenu;
FAlignMenuItem: TMenuItem;
FMirrorHorizontalMenuItem: TMenuItem;
FMirrorVerticalMenuItem: TMenuItem;
FScaleMenuItem: TMenuItem;
FSizeMenuItem: TMenuItem;
function GetIsControl: Boolean;
procedure SetIsControl(Value: Boolean);
procedure InvalidateWithParent(AComponent: TComponent);
protected
MouseDownComponent : TComponent;
MouseDownComponent, MouseDownSender : TComponent;
MouseDownPos, MouseUpPos, LastMouseMovePos : TPoint;
function PaintControl(Sender: TControl; Message: TLMPaint):boolean;
@ -74,7 +76,8 @@ type
function MoveControl(Sender: TControl; Message: TLMMove):boolean;
Procedure MouseDownOnControl(Sender : TControl; Message : TLMMouse);
Procedure MouseMoveOnControl(Sender : TControl; var Message : TLMMouse);
Procedure MouseUpOnControl(Sender : TControl; Message:TLMMouse);
Procedure MouseLeftUpOnControl(Sender : TControl; Message:TLMMouse);
Procedure MouseRightUpOnControl(Sender : TControl; Message:TLMMouse);
Procedure KeyDown(Sender : TControl; Message:TLMKEY);
Procedure KeyUP(Sender : TControl; Message:TLMKEY);
@ -82,6 +85,12 @@ type
Procedure NudgeControl(DiffX, DiffY: Integer);
Procedure NudgeSize(DiffX, DiffY: Integer);
procedure BuildPopupMenu;
procedure OnAlignPopupMenuClick(Sender: TObject);
procedure OnMirrorHorizontalPopupMenuClick(Sender: TObject);
procedure OnMirrorVerticalPopupMenuClick(Sender: TObject);
procedure OnScalePopupMenuClick(Sender: TObject);
procedure OnSizePopupMenuClick(Sender: TObject);
public
ControlSelection : TControlSelection;
constructor Create(Customform : TCustomform; AControlSelection: TControlSelection);
@ -114,10 +123,13 @@ type
function NonVisualComponentAtPos(x,y: integer): TComponent;
procedure DrawNonVisualComponents(DC: HDC);
property OnGetNonVisualCompIconCanvas: TOnGetNonVisualCompIconCanvas
read FOnGetNonVisualCompIconCanvas write FOnGetNonVisualCompIconCanvas;
read FOnGetNonVisualCompIconCanvas write FOnGetNonVisualCompIconCanvas;
end;
var GridSizeX, GridSizeY: integer;
implementation
@ -132,8 +144,6 @@ const
mk_control = 8;
mk_mbutton = $10;
var
GridPoints : TGridPoint;
constructor TDesigner.Create(CustomForm : TCustomForm;
AControlSelection: TControlSelection);
@ -148,6 +158,8 @@ end;
destructor TDesigner.Destroy;
Begin
if FPopupMenu<>nil then
FPopupMenu.Free;
Inherited Destroy;
end;
@ -259,6 +271,7 @@ Begin
FHasSized:=false;
if (MouseDownComponent<>nil) or (getParentForm(Sender)=nil) then exit;
MouseDownComponent:=Sender;
MouseDownSender:=Sender;
SenderOrigin:=GetFormRelativeControlTopLeft(Sender);
MouseX:=Message.Pos.X+SenderOrigin.X;
@ -349,7 +362,7 @@ writeln('[TDesigner.MouseDownOnControl] Grabber activated');
writeln('[TDesigner.MouseDownOnControl] END');
End;
procedure TDesigner.MouseUpOnControl(Sender : TControl; Message:TLMMouse);
procedure TDesigner.MouseLeftUpOnControl(Sender : TControl; Message:TLMMouse);
var
ParentCI, NewCI : TComponentInterface;
NewLeft, NewTop, NewWidth, NewHeight,
@ -381,7 +394,7 @@ Begin
dec(MouseY,MouseDownPos.Y);
writeln('************************************************************');
write('MouseUpOnControl');
write('MouseLeftUpOnControl');
write(' ',Sender.Name,':',Sender.ClassName,' Origin=',SenderOrigin.X,',',SenderOrigin.Y);
write(' Msg=',Message.Pos.X,',',Message.Pos.Y);
write(' Mouse=',MouseX,',',MouseY);
@ -396,17 +409,23 @@ Begin
// left mouse button
if SelectedCompClass = nil then begin
// selection mode
ControlSelection.BeginUpdate;
if not FHasSized then begin
ControlSelection.BeginUpdate;
if RubberBandWasActive then begin
if (not (ssShift in Shift))
or ((ControlSelection.Count=1)
and (ControlSelection[0].Component is TCustomForm)) then
ControlSelection.Clear;
ControlSelection.SelectWithRubberBand(SenderParentForm,ssShift in Shift);
ControlSelection.SelectWithRubberBand(
SenderParentForm,ssShift in Shift);
if ControlSelection.Count=0 then
ControlSelection.Add(SenderParentForm);
ControlSelection.RubberbandActive:=false;
end else begin
if (not (ssShift in Shift)) then begin
ControlSelection.Clear;
ControlSelection.Add(Sender);
end;
end;
ControlSelection.EndUpdate;
SenderParentForm.Invalidate;
@ -445,12 +464,13 @@ Begin
FOnAddComponent(Self,NewCI.Control,SelectedCompClass);
SelectOnlyThisComponent(TComponent(NewCI.Control));
Writeln('Calling ControlClick with nil from MouseUpOnControl');
Writeln('Calling ControlClick with nil from MouseLeftUpOnControl');
if not (ssShift in Shift) then
if Assigned(FOnUnselectComponentClass) then
// this resets the component toolbar to the mouse. (= selection tool)
FOnUnselectComponentClass(Self);
if Assigned(FOnSetDesigning) then FOnSetDesigning(Self,FCustomForm,True);
if Assigned(FOnSetDesigning) then
FOnSetDesigning(Self,FCustomForm,True);
Form.Invalidate;
writeln('NEW COMPONENT ADDED: ',Form.ComponentCount,' ',NewCI.Control.Owner.Name);
end;
@ -461,7 +481,8 @@ writeln('NEW COMPONENT ADDED: ',Form.ComponentCount,' ',NewCI.Control.Owner.Nam
FHasSized:=false;
MouseDownComponent:=nil;
writeln('[TDesigner.MouseUpOnControl] END');
MouseDownSender:=nil;
writeln('[TDesigner.MouseLeftUpOnControl] END');
end;
Procedure TDesigner.MouseMoveOnControl(Sender : TControl; var Message : TLMMouse);
@ -470,28 +491,38 @@ var
SenderOrigin:TPoint;
SenderParentForm:TCustomForm;
MouseX, MouseY :integer;
s: string;
Begin
if MouseDownComponent=nil then exit;
SenderParentForm:=GetParentForm(Sender);
if SenderParentForm=nil then exit;
SenderOrigin:=GetFormRelativeControlTopLeft(Sender);
{ if (Message.keys and MK_LButton) = MK_LButton then begin
// MG: workaround for mouse move coordinate bug in gtk-interfaces
s:=lowercase(MouseDownSender.ClassName);
if (s='tbutton') then begin
MouseX:=Message.Pos.X;
MouseY:=Message.Pos.Y;
end else begin}
end else begin
// MG: workaround end
MouseX:=Message.Pos.X+SenderOrigin.X;
MouseY:=Message.Pos.Y+SenderOrigin.Y;
// end;
end;
if MouseDownComponent=nil then exit;
if true then begin
if (Message.keys and MK_LButton) = MK_LButton then begin
Write('MouseMoveOnControl'
,' ',Sender.Name,':',Sender.ClassName
,' ',Sender.ClassName
,' ',GetCaptureControl<>nil
,' ',Sender.Left,',',Sender.Top
,' Origin=',SenderOrigin.X,',',SenderOrigin.Y
,' Msg=',Message.Pos.x,',',Message.Pos.Y
,' Mouse=',MouseX,',',MouseY
);
write(' ',MouseDownComponent is TWinControl);
if (MouseDownComponent is TControl) then begin
write(' ',csCaptureMouse in TWinControl(MouseDownComponent).ControlStyle);
end;
writeln();
end;
@ -509,7 +540,8 @@ Begin
if Assigned(FOnPropertiesChanged) then
FOnPropertiesChanged(Self);
end else begin
if (not (MouseDownComponent is TCustomForm)) and (ControlSelection.Count>=1)
if (not (MouseDownComponent is TCustomForm))
and (ControlSelection.Count>=1)
and not (ControlSelection[0].Component is TCustomForm) then begin
// move selection
FHasSized:=true;
@ -519,7 +551,8 @@ Begin
FOnPropertiesChanged(Self);
end else begin
// rubberband selection/creation
ControlSelection.RubberBandBounds:=Rect(MouseDownPos.X,MouseDownPos.Y,MouseX,MouseY);
ControlSelection.RubberBandBounds:=
Rect(MouseDownPos.X,MouseDownPos.Y,MouseX,MouseY);
ControlSelection.RubberBandActive:=true;
SenderParentForm.Invalidate;
end;
@ -530,6 +563,18 @@ Begin
LastMouseMovePos:=Point(MouseX,MouseY);
end;
procedure TDesigner.MouseRightUpOnControl(Sender : TControl; Message:TLMMouse);
var
MouseX, MouseY : Integer;
SenderOrigin: TPoint;
begin
SenderOrigin:=GetFormRelativeControlTopLeft(Sender);
MouseX:=Message.Pos.X+SenderOrigin.X;
MouseY:=Message.Pos.Y+SenderOrigin.Y;
BuildPopupMenu;
FPopupMenu.Popup(MouseX,MouseY);
end;
{
-----------------------------K E Y D O W N -------------------------------
}
@ -610,21 +655,22 @@ end;
function TDesigner.IsDesignMsg(Sender: TControl; var Message: TLMessage): Boolean;
Begin
result := false;
Result := false;
if csDesigning in Sender.ComponentState then begin
if ((Message.msg >= LM_MOUSEFIRST) and (Message.msg <= LM_MOUSELAST)) then
if ((Message.Msg >= LM_MOUSEFIRST) and (Message.Msg <= LM_MOUSELAST)) then
Result := true
else
if ((Message.msg >= LM_KeyFIRST) and (Message.msg <= LM_KeyLAST)) then
if ((Message.Msg >= LM_KeyFIRST) and (Message.Msg <= LM_KeyLAST)) then
Result:=true;
case Message.MSG of
case Message.Msg of
LM_PAINT: Result:=PaintControl(Sender,TLMPaint(Message));
LM_KEYDOWN: KeyDown(Sender,TLMKey(Message));
LM_KEYUP: KeyUP(Sender,TLMKey(Message));
LM_LBUTTONDOWN,LM_RBUTTONDOWN: MouseDownOnControl(sender,TLMMouse(Message));
LM_LBUTTONUP,LM_RBUTTONUP: MouseUpOnControl(sender,TLMMouse(Message));
LM_LBUTTONDOWN,LM_RBUTTONDOWN: MouseDownOnControl(Sender,TLMMouse(Message));
LM_LBUTTONUP: MouseLeftUpOnControl(Sender,TLMMouse(Message));
LM_RBUTTONUP: MouseRightUpOnControl(sender,TLMMouse(Message));
LM_MOUSEMOVE: MouseMoveOnControl(Sender, TLMMouse(Message));
LM_SIZE: Result:=SizeControl(Sender,TLMSize(Message));
LM_MOVE: Result:=MoveControl(Sender,TLMMove(Message));
@ -648,8 +694,8 @@ Begin
writeln('[TDesigner.Notification] opRemove '+
''''+AComponent.ClassName+'.'+AComponent.Name+'''');
if (AComponent is TControl) then
if ControlSelection.IsSelected(TControl(AComponent)) then
ControlSelection.Remove(TControl(AComponent));
if ControlSelection.IsSelected(AComponent) then
ControlSelection.Remove(AComponent);
end;
end;
@ -666,9 +712,9 @@ begin
//if Controlatpos(Point(x,y),True) = nil then
MoveTo(x,y);
LineTo(x+1,y);
Inc(y, GridPoints.Y);
Inc(y, GridSizeY);
end;
Inc(x, GridPoints.X);
Inc(x, GridSizeX);
end;
end;
end;
@ -766,9 +812,147 @@ begin
Result:=nil;
end;
procedure TDesigner.BuildPopupMenu;
var
ControlSelIsNotEmpty, FormIsSelected, OnlyNonVisualCompsAreSelected,
CompsAreSelected: boolean;
begin
if FPopupMenu<>nil then FPopupMenu.Free;
ControlSelIsNotEmpty:=ControlSelection.Count>0;
FormIsSelected:=ControlSelIsNotEmpty
and (ControlSelection[0].Component is TCustomForm);
OnlyNonVisualCompsAreSelected:=
ControlSelection.OnlyNonVisualComponentsSelected;
CompsAreSelected:=ControlSelIsNotEmpty and not FormIsSelected;
FPopupMenu:=TPopupMenu.Create(nil);
FAlignMenuItem := TMenuItem.Create(nil);
with FAlignMenuItem do begin
Caption := 'Align';
OnClick := @OnAlignPopupMenuClick;
Enabled := CompsAreSelected;
end;
FPopupMenu.Items.Add(FAlignMenuItem);
FMirrorHorizontalMenuItem := TMenuItem.Create(nil);
with FMirrorHorizontalMenuItem do begin
Caption := 'Mirror horizontal';
OnClick := @OnMirrorHorizontalPopupMenuClick;
Enabled := CompsAreSelected;
end;
FPopupMenu.Items.Add(FMirrorHorizontalMenuItem);
FMirrorVerticalMenuItem := TMenuItem.Create(nil);
with FMirrorVerticalMenuItem do begin
Caption := 'Mirror vertical';
OnClick := @OnMirrorVerticalPopupMenuClick;
Enabled := CompsAreSelected;
end;
FPopupMenu.Items.Add(FMirrorVerticalMenuItem);
FScaleMenuItem := TMenuItem.Create(nil);
with FScaleMenuItem do begin
Caption := 'Scale';
OnClick := @OnScalePopupMenuClick;
Enabled := CompsAreSelected and OnlyNonVisualCompsAreSelected;
end;
FPopupMenu.Items.Add(FScaleMenuItem);
FSizeMenuItem := TMenuItem.Create(nil);
with FSizeMenuItem do begin
Caption := 'Size';
OnClick := @OnSizePopupMenuClick;
Enabled := CompsAreSelected and OnlyNonVisualCompsAreSelected;
end;
FPopupMenu.Items.Add(FSizeMenuItem);
end;
procedure TDesigner.OnAlignPopupMenuClick(Sender: TObject);
var HorizAlignment, VertAlignment: TComponentAlignment;
begin
if ShowAlignComponentsDialog=mrOk then begin
case AlignComponentsDialog.HorizontalRadioGroup.ItemIndex of
0: HorizAlignment:=csaNone;
1: HorizAlignment:=csaSides1;
2: HorizAlignment:=csaCenters;
3: HorizAlignment:=csaSides2;
4: HorizAlignment:=csaCenterInWindow;
5: HorizAlignment:=csaSpaceEqually;
6: HorizAlignment:=csaSide1SpaceEqually;
7: HorizAlignment:=csaSide2SpaceEqually;
end;
case AlignComponentsDialog.VerticalRadioGroup.ItemIndex of
0: VertAlignment:=csaNone;
1: VertAlignment:=csaSides1;
2: VertAlignment:=csaCenters;
3: VertAlignment:=csaSides2;
4: VertAlignment:=csaCenterInWindow;
5: VertAlignment:=csaSpaceEqually;
6: VertAlignment:=csaSide1SpaceEqually;
7: VertAlignment:=csaSide2SpaceEqually;
end;
ControlSelection.AlignComponents(HorizAlignment,VertAlignment);
end;
ControlSelection.SaveBounds;
end;
procedure TDesigner.OnMirrorHorizontalPopupMenuClick(Sender: TObject);
begin
ControlSelection.MirrorHorizontal;
ControlSelection.SaveBounds;
end;
procedure TDesigner.OnMirrorVerticalPopupMenuClick(Sender: TObject);
begin
ControlSelection.MirrorVertical;
ControlSelection.SaveBounds;
end;
procedure TDesigner.OnScalePopupMenuClick(Sender: TObject);
begin
if ShowScaleComponentsDialog=mrOk then begin
ControlSelection.ScaleComponents(
StrToIntDef(ScaleComponentsDialog.PercentEdit.Text,100));
end;
ControlSelection.SaveBounds;
end;
procedure TDesigner.OnSizePopupMenuClick(Sender: TObject);
var HorizSizing, VertSizing: TComponentSizing;
AWidth, AHeight: integer;
begin
if ShowSizeComponentsDialog=mrOk then begin
case SizeComponentsDialog.WidthRadioGroup.ItemIndex of
0: HorizSizing:=cssNone;
1: HorizSizing:=cssShrinkToSmallest;
2: HorizSizing:=cssGrowToLargest;
3: HorizSizing:=cssFixed;
end;
case SizeComponentsDialog.HeightRadioGroup.ItemIndex of
0: VertSizing:=cssNone;
1: VertSizing:=cssShrinkToSmallest;
2: VertSizing:=cssGrowToLargest;
3: VertSizing:=cssFixed;
end;
if HorizSizing=cssFixed then
AWidth:=StrToIntDef(SizeComponentsDialog.WidthEdit.Text,0)
else
AWidth:=0;
if VertSizing=cssFixed then
AHeight:=StrToIntDef(SizeComponentsDialog.HeightEdit.Text,0)
else
AHeight:=0;
ControlSelection.SizeComponents(HorizSizing,AWidth,VertSizing,AHeight);
end;
ControlSelection.SaveBounds;
end;
initialization
GridPoints.x := 10;
GridPoints.Y := 10;
GridSizex := 10;
GridSizeY := 10;
end.

147
designer/scalecompsdlg.pp Normal file
View File

@ -0,0 +1,147 @@
{
Author: Mattias Gaertner
Abstract:
Defines TScaleComponentsDialog.
}
unit ScaleCompsDlg;
{$mode objfpc}{$H+}
interface
uses
Classes, LCLLinux, Forms, Controls, Buttons, StdCtrls, ExtCtrls, LResources;
type
TScaleComponentsDialog = class(TForm)
Bevel: TBevel;
ScaleLabel: TLabel;
PercentEdit: TEdit;
PercentLabel: TLabel;
OkButton: TButton;
CancelButton: TButton;
procedure OkButtonClick(Sender: TObject);
procedure CancelButtonClick(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
end;
var ScaleComponentsDialog: TScaleComponentsDialog;
function ShowScaleComponentsDialog: TModalResult;
implementation
function ShowScaleComponentsDialog: TModalResult;
begin
writeln('[ShowScaleComponentsDialog] A');
if ScaleComponentsDialog=nil then
ScaleComponentsDialog:=TScaleComponentsDialog.Create(Application);
writeln('[ShowScaleComponentsDialog] B');
with ScaleComponentsDialog do begin
SetBounds((Screen.Width-270) div 2,(Screen.Height-110) div 2,260,100);
PercentEdit.Text:='100';
Result:=ShowModal;
end;
end;
{ TScaleComponentsDialog }
constructor TScaleComponentsDialog.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
if LazarusResources.Find(Classname)=nil then begin
SetBounds((Screen.Width-270) div 2,(Screen.Height-110) div 2,260,100);
Caption:='Scale';
Bevel:=TBevel.Create(Self);
with Bevel do begin
Name:='Bevel';
Parent:=Self;
Left:=5;
Top:=5;
Width:=250;
Height:=50;
Visible:=true;
end;
ScaleLabel:=TLabel.Create(Self);
with ScaleLabel do begin
Name:='ScaleLabel';
Parent:=Self;
Left:=12;
Top:=15;
Width:=90;
Height:=25;
Caption:='Scaling factor:';
Visible:=true;
end;
PercentEdit:=TEdit.Create(Self);
with PercentEdit do begin
Name:='PercentEdit';
Parent:=Self;
Left:=140;
Top:=20;
Width:=60;
Text:='100';
Visible:=true;
end;
PercentLabel:=TLabel.Create(Self);
with PercentLabel do begin
Name:='PercentLabel';
Parent:=Self;
Left:=PercentEdit.Left+PercentEdit.Width+5;
Top:=ScaleLabel.Top;
Width:=15;
Height:=25;
Caption:='%';
Visible:=true;
end;
OkButton:=TButton.Create(Self);
with OkButton do begin
Name:='OkButton';
Parent:=Self;
Left:=85;
Top:=Bevel.Top+Bevel.Height+10;
Width:=75;
Height:=25;
Caption:='Ok';
OnClick:=@OkButtonClick;
Visible:=true;
end;
CancelButton:=TButton.Create(Self);
with CancelButton do begin
Name:='CancelButton';
Parent:=Self;
Left:=175;
Top:=OkButton.Top;
Width:=75;
Height:=25;
Caption:='Cancel';
OnClick:=@CancelButtonClick;
Visible:=true;
end;
end;
writeln('[TScaleComponentsDialog.Create] END');
end;
procedure TScaleComponentsDialog.OkButtonClick(Sender: TObject);
begin
ModalResult:=mrOk;
end;
procedure TScaleComponentsDialog.CancelButtonClick(Sender: TObject);
begin
ModalResult:=mrCancel;
end;
initialization
ScaleComponentsDialog:=nil;
end.

161
designer/sizecompsdlg.pp Normal file
View File

@ -0,0 +1,161 @@
{
Author: Mattias Gaertner
Abstract:
Defines TSizeComponentsDialog.
}
unit SizeCompsDlg;
{$mode objfpc}{$H+}
interface
uses
Classes, LCLLinux, Forms, Controls, Buttons, ExtCtrls, StdCtrls, LResources;
type
TSizeComponentsDialog = class(TForm)
WidthRadioGroup: TRadioGroup;
WidthEdit: TEdit;
HeightRadioGroup: TRadioGroup;
HeightEdit: TEdit;
OkButton: TButton;
CancelButton: TButton;
procedure OkButtonClick(Sender: TObject);
procedure CancelButtonClick(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
end;
var SizeComponentsDialog: TSizeComponentsDialog;
function ShowSizeComponentsDialog: TModalResult;
implementation
function ShowSizeComponentsDialog: TModalResult;
begin
if SizeComponentsDialog=nil then
SizeComponentsDialog:=TSizeComponentsDialog.Create(Application);
with SizeComponentsDialog do begin
SetBounds((Screen.Width-365) div 2,(Screen.Height-175) div 2,355,165);
WidthRadioGroup.ItemIndex:=0;
HeightRadioGroup.ItemIndex:=0;
Result:=ShowModal;
end;
end;
{ TSizeComponentsDialog }
constructor TSizeComponentsDialog.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
if LazarusResources.Find(Classname)=nil then begin
SetBounds((Screen.Width-365) div 2,(Screen.Height-175) div 2,355,165);
Caption:='Size';
WidthRadioGroup:=TRadioGroup.Create(Self);
with WidthRadioGroup do begin
Name:='WidthRadioGroup';
Parent:=Self;
Left:=5;
Top:=5;
Width:=170;
Height:=115;
Caption:='Width:';
with Items do begin
BeginUpdate;
Add('No change');
Add('Shrink to smallest');
Add('Grow to Largest');
Add('Width:');
EndUpdate;
end;
Show;
end;
WidthEdit:=TEdit.Create(Self);
with WidthEdit do begin
Name:='WidthEdit';
Parent:=Self;
Left:=87;
Top:=90;
Width:=60;
Text:='';
Show;
end;
HeightRadioGroup:=TRadioGroup.Create(Self);
with HeightRadioGroup do begin
Name:='HeightRadioGroup';
Parent:=Self;
Left:=180;
Top:=5;
Width:=170;
Height:=115;
Caption:='Height:';
with Items do begin
BeginUpdate;
Add('No change');
Add('Shrink to smallest');
Add('Grow to Largest');
Add('Height:');
EndUpdate;
end;
Show;
end;
HeightEdit:=TEdit.Create(Self);
with HeightEdit do begin
Name:='HeightEdit';
Parent:=Self;
Left:=262;
Top:=90;
Width:=60;
Text:='';
Show;
end;
OkButton:=TButton.Create(Self);
with OkButton do begin
Name:='OkButton';
Parent:=Self;
Left:=145;
Top:=WidthRadioGroup.Top+WidthRadioGroup.Height+10;
Width:=75;
Height:=25;
Caption:='Ok';
OnClick:=@OkButtonClick;
Show;
end;
CancelButton:=TButton.Create(Self);
with CancelButton do begin
Name:='CancelButton';
Parent:=Self;
Left:=235;
Top:=OkButton.Top;
Width:=75;
Height:=25;
Caption:='Cancel';
OnClick:=@CancelButtonClick;
Show;
end;
end;
end;
procedure TSizeComponentsDialog.OkButtonClick(Sender: TObject);
begin
ModalResult:=mrOk;
end;
procedure TSizeComponentsDialog.CancelButtonClick(Sender: TObject);
begin
ModalResult:=mrCancel;
end;
initialization
SizeComponentsDialog:=nil;
end.