paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-26 14:08:18 +02:00
Code Issues Packages Projects Releases Wiki Activity
b51eaa2182
lazarus/designer/designer.pp
lazarus c9e180acac TPanel implemented. 
Basic graphic primitives split into GraphType package, so that we can
reference it from interface (GTK, Win32) units.
New Frame3d canvas method that uses native (themed) drawing (GTK only).
New overloaded Canvas.TextRect method.
LCLLinux and Graphics was split, so a bunch of files had to be modified.

git-svn-id: trunk@653 -
2002-02-03 00:24:02 +00:00

1125 lines
36 KiB
ObjectPascal
Raw Blame History

{ /***************************************************************************
widgetstack.pp - Designer Widget Stack
-------------------
Implements a widget list created by TDesigner.
Initial Revision : Sat May 10 23:15:32 CST 1999
***************************************************************************/
/***************************************************************************
* *
* This program is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
***************************************************************************/
}
unit designer;
{$mode objfpc}{$H+}
interface
uses
Classes, LCLType, LCLLinux, Forms, Controls, LMessages, Graphics, ControlSelection,
CustomFormEditor, FormEditor, UnitEditor, CompReg, Menus, AlignCompsDlg,
SizeCompsDlg, ScaleCompsDlg, ExtCtrls;
type
TOnGetSelectedComponentClass = procedure(Sender: TObject;
var RegisteredComponent: TRegisteredComponent) of object;
TOnSetDesigning = procedure(Sender: TObject; Component: TComponent;
Value: boolean) of object;
TOnAddComponent = procedure(Sender: TObject; Component: TComponent;
ComponentClass: TRegisteredComponent) of object;
TOnRemoveComponent = procedure(Sender: TObject; Component: TComponent)
of object;
TOnGetNonVisualCompIconCanvas = procedure(Sender: TObject;
AComponent: TComponent; var IconCanvas: TCanvas) of object;
TDesigner = class(TIDesigner)
private
FCustomForm: TCustomForm;
FFormEditor : TFormEditor;
FSourceEditor : TSourceEditor;
FHasSized: boolean;
FGridColor: TColor;
FDuringPaintControl: boolean;
FOnAddComponent: TOnAddComponent;
FOnComponentListChanged: TNotifyEvent;
FOnGetSelectedComponentClass: TOnGetSelectedComponentClass;
FOnGetNonVisualCompIconCanvas: TOnGetNonVisualCompIconCanvas;
FOnModified: TNotifyEvent;
FOnPropertiesChanged: TNotifyEvent;
FOnRemoveComponent: TOnRemoveComponent;
FOnSetDesigning: TOnSetDesigning;
FOnUnselectComponentClass: TNotifyEvent;
FOnActivated: TNotifyEvent;
FPopupMenu: TPopupMenu;
FAlignMenuItem: TMenuItem;
FMirrorHorizontalMenuItem: TMenuItem;
FMirrorVerticalMenuItem: TMenuItem;
FScaleMenuItem: TMenuItem;
FSizeMenuItem: TMenuItem;
FBringToFrontMenuItem: TMenuItem;
FSendToBackMenuItem: TMenuItem;
//hint stuff
FHintTimer : TTimer;
FHintWIndow : THintWindow;
function GetIsControl: Boolean;
procedure SetIsControl(Value: Boolean);
procedure InvalidateWithParent(AComponent: TComponent);
Procedure HintTimer(sender : TObject);
protected
MouseDownComponent, MouseDownSender : TComponent;
MouseDownPos, MouseUpPos, LastMouseMovePos : TPoint;
function PaintControl(Sender: TControl; Message: TLMPaint):boolean;
function SizeControl(Sender: TControl; Message: TLMSize):boolean;
function MoveControl(Sender: TControl; Message: TLMMove):boolean;
Procedure MouseDownOnControl(Sender : TControl; Message : TLMMouse);
Procedure MouseMoveOnControl(Sender : TControl; var 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);
Procedure RemoveControl(Control : TComponent);
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);
procedure OnBringToFrontMenuClick(Sender: TObject);
procedure OnSendToBackMenuClick(Sender: TObject);
Procedure OnFormActivated;
public
ControlSelection : TControlSelection;
constructor Create(Customform : TCustomform; AControlSelection: TControlSelection);
destructor Destroy; override;
function IsDesignMsg(Sender: TControl; var Message: TLMessage): Boolean; override;
procedure Modified; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure PaintGrid; override;
procedure ValidateRename(AComponent: TComponent;
const CurName, NewName: string); override;
Procedure SelectOnlyThisComponent(AComponent:TComponent);
property IsControl: Boolean read GetIsControl write SetIsControl;
property Form: TCustomForm read FCustomForm write FCustomForm;
property FormEditor : TFormEditor read FFormEditor write FFormEditor;
property SourceEditor : TSourceEditor read FSourceEditor write FSourceEditor;
property OnAddComponent: TOnAddComponent read FOnAddComponent write FOnAddComponent;
property OnComponentListChanged: TNotifyEvent
read FOnComponentListChanged write FOnComponentListChanged;
property OnGetSelectedComponentClass: TOnGetSelectedComponentClass
read FOnGetSelectedComponentClass write FOnGetSelectedComponentClass;
property OnModified: TNotifyEvent read FOnModified write FOnModified;
property OnPropertiesChanged: TNotifyEvent
read FOnPropertiesChanged write FOnPropertiesChanged;
property OnRemoveComponent: TOnRemoveComponent
read FOnRemoveComponent write FOnRemoveComponent;
property OnSetDesigning: TOnSetDesigning read FOnSetDesigning write FOnSetDesigning;
property OnUnselectComponentClass: TNotifyEvent
read FOnUnselectComponentClass write FOnUnselectComponentClass;
property OnActivated: TNotifyEvent
read FOnActivated write FOnActivated;
function NonVisualComponentAtPos(x,y: integer): TComponent;
procedure DrawNonVisualComponents(DC: HDC);
property OnGetNonVisualCompIconCanvas: TOnGetNonVisualCompIconCanvas
read FOnGetNonVisualCompIconCanvas write FOnGetNonVisualCompIconCanvas;
end;
var GridSizeX, GridSizeY: integer;
implementation
uses
Sysutils, Typinfo, Math;
const
mk_lbutton = 1;
mk_rbutton = 2;
mk_shift = 4;
mk_control = 8;
mk_mbutton = $10;
constructor TDesigner.Create(CustomForm : TCustomForm;
AControlSelection: TControlSelection);
begin
inherited Create;
FCustomForm := CustomForm;
ControlSelection:=AControlSelection;
FHasSized:=false;
FGridColor:=clGray;
FDuringPaintControl:=false;
FHintTimer := TTimer.Create(nil);
FHintTimer.Interval := 500;
FHintTimer.Enabled := False;
FHintTimer.OnTimer := @HintTimer;
FHintWindow := THintWindow.Create(nil);
FHIntWindow.Visible := False;
FHintWindow.Caption := 'This is a hint window'#13#10'NEat huh?';
FHintWindow.HideInterval := 4000;
FHintWindow.AutoHide := True;
end;
destructor TDesigner.Destroy;
Begin
if FPopupMenu<>nil then
FPopupMenu.Free;
FHintWIndow.Free;
FHintTimer.Free;
Inherited Destroy;
end;
Procedure TDesigner.RemoveControl(Control : TComponent);
Begin
Writeln('[TDesigner.RemoveControl] ',Control.Name,':',Control.ClassName);
if Assigned(FOnRemoveComponent) then
FOnRemoveComponent(Self,Control);
FCustomForm.RemoveControl(TCOntrol(Control));
//this send a message to notification and removes it from the controlselection
FFormEditor.DeleteControl(Control);
end;
Procedure TDesigner.NudgeControl(DiffX, DiffY : Integer);
Begin
Writeln('[TDesigner.NudgeControl]');
ControlSelection.MoveSelection(DiffX, DiffY);
if ControlSelection.OnlyNonVisualComponentsSelected then
FCustomForm.Invalidate;
end;
Procedure TDesigner.NudgeSize(DiffX, DiffY: Integer);
Begin
Writeln('[TDesigner.NudgeSize]');
ControlSelection.SizeSelection(DiffX, DiffY);
end;
procedure TDesigner.SelectOnlyThisComponent(AComponent:TComponent);
begin
ControlSelection.BeginUpdate;
ControlSelection.Clear;
ControlSelection.Add(TControl(AComponent));
ControlSelection.EndUpdate;
end;
procedure TDesigner.InvalidateWithParent(AComponent: TComponent);
begin
writeln('INVALIDATEWITHPARENT');
if AComponent is TControl then begin
if TControl(AComponent).Parent<>nil then
TControl(AComponent).Parent.Invalidate
else
TControl(AComponent).Invalidate;
end else begin
FCustomForm.Invalidate;
end;
end;
function TDesigner.PaintControl(Sender: TControl; Message: TLMPaint):boolean;
var OldDuringPaintControl: boolean;
begin
Result:=true;
//writeln('*** LM_PAINT A ',Sender.Name,':',Sender.ClassName,' DC=',HexStr(Message.DC,8));
OldDuringPaintControl:=FDuringPaintControl;
FDuringPaintControl:=true;
Sender.Dispatch(Message);
//writeln('*** LM_PAINT B ',Sender.Name,':',Sender.ClassName,' DC=',HexStr(Message.DC,8));
if (ControlSelection.IsSelected(Sender)) then begin
// writeln('*** LM_PAINT ',Sender.Name,':',Sender.ClassName,' DC=',HexStr(Message.DC,8));
ControlSelection.DrawMarker(Sender,Message.DC);
end;
//if OldDuringPaintControl=false then begin
DrawNonVisualComponents(Message.DC);
ControlSelection.DrawGrabbers(Message.DC);
if ControlSelection.RubberBandActive then
ControlSelection.DrawRubberBand(Message.DC);
// end;
FDuringPaintControl:=OldDuringPaintControl;
end;
function TDesigner.SizeControl(Sender: TControl; Message: TLMSize):boolean;
begin
Result:=true;
Sender.Dispatch(Message);
if (ControlSelection.IsSelected(Sender)) then begin
// writeln('*** LM_Size ',Sender.Name,':',Sender.ClassName,' Type=',Message.SizeType
// ,' ',Message.Width,',',Message.Height,' Pos=',Sender.Left,',',Sender.Top);
if not ControlSelection.IsResizing then begin
ControlSelection.AdjustSize;
if Assigned(FOnPropertiesChanged) then
FOnPropertiesChanged(Self);
end;
end;
end;
function TDesigner.MoveControl(Sender: TControl; Message: TLMMove):boolean;
begin
Result:=true;
Sender.Dispatch(Message);
if (ControlSelection.IsSelected(Sender)) then begin
// writeln('*** LM_Move ',Sender.Name,':',Sender.ClassName);
ControlSelection.AdjustSize;
if Assigned(FOnPropertiesChanged) then
FOnPropertiesChanged(Self);
end;
end;
procedure TDesigner.MouseDownOnControl(Sender : TControl; Message : TLMMouse);
var i,
MouseX,MouseY,
CompIndex:integer;
SenderOrigin:TPoint;
AControlSelection:TControlSelection;
SelectedCompClass: TRegisteredComponent;
NonVisualComp: TComponent;
Begin
FHintTimer.Enabled := False;
FHasSized:=false;
if (MouseDownComponent<>nil) or (getParentForm(Sender)=nil) then exit;
MouseDownComponent:=Sender;
MouseDownSender:=Sender;
SenderOrigin:=GetFormRelativeControlTopLeft(Sender);
MouseX:=Message.Pos.X+SenderOrigin.X;
MouseY:=Message.Pos.Y+SenderOrigin.Y;
MouseDownPos := Point(MouseX,MouseY);
LastMouseMovePos:=MouseDownPos;
writeln('************************************************************');
write('MouseDownOnControl');
write(' ',Sender.Name,':',Sender.ClassName,' Origin=',SenderOrigin.X,',',SenderOrigin.Y);
write(' Msg=',Message.Pos.X,',',Message.Pos.Y);
write(' Mouse=',MouseX,',',MouseY);
writeln('');
if (Message.Keys and MK_Shift) = MK_Shift then
Write(' Shift down')
else
Write(' No Shift down');
if (Message.Keys and MK_Control) = MK_Control then
Writeln(', CTRL down')
else
Writeln(', No CTRL down');
if (Message.Keys and MK_LButton) > 0 then begin
ControlSelection.ActiveGrabber:=
ControlSelection.GrabberAtPos(MouseDownPos.X,MouseDownPos.Y)
end else
ControlSelection.ActiveGrabber:=nil;
if Assigned(FOnGetSelectedComponentClass) then
FOnGetSelectedComponentClass(Self,SelectedCompClass)
else
SelectedCompClass:=nil;
if (Message.Keys and MK_LButton) > 0 then begin
if SelectedCompClass = nil then begin
// selection mode
if ControlSelection.ActiveGrabber=nil then begin
NonVisualComp:=NonVisualComponentAtPos(
MouseDownPos.X,MouseDownPos.Y);
Writeln('ActiveGrabber = nil');
if NonVisualComp<>nil then Writeln('1') else Writeln('2');
if NonVisualComp<>nil then MouseDownComponent:=NonVisualComp;
CompIndex:=ControlSelection.IndexOf(MouseDownComponent);
if (Message.Keys and MK_SHIFT)>0 then begin
// shift key (multiselection)
if CompIndex<0 then begin
// not selected
// add component to selection
if (ControlSelection.Count=0)
or (not (Sender is TCustomForm)) then begin
ControlSelection.Add(MouseDownComponent);
InvalidateWithParent(MouseDownComponent);
end;
end else begin
// remove from multiselection
ControlSelection.Delete(CompIndex);
InvalidateWithParent(MouseDownComponent);
end;
end else begin
// no shift key (single selection)
if (CompIndex<0) then begin
// select only this component
AControlSelection:=TControlSelection.Create;
AControlSelection.Assign(ControlSelection);
ControlSelection.BeginUpdate;
ControlSelection.Clear;
for i:=0 to AControlSelection.Count-1 do
if AControlSelection[i].Component is TControl then
TControl(AControlSelection[i].Component).Invalidate;
ControlSelection.Add(MouseDownComponent);
ControlSelection.EndUpdate;
InvalidateWithParent(MouseDownComponent);
AControlSelection.Free;
end;
end;
end else begin
// mouse down on grabber -> begin sizing
// grabber is already activated
// the sizing is handled in mousemove
writeln('[TDesigner.MouseDownOnControl] Grabber activated');
end;
end else begin
// add component mode -> handled in mousemove and mouseup
end;
end;
writeln('[TDesigner.MouseDownOnControl] END');
End;
procedure TDesigner.MouseLeftUpOnControl(Sender : TControl; Message:TLMMouse);
var
ParentCI, NewCI : TComponentInterface;
NewLeft, NewTop, NewWidth, NewHeight,
MouseX, MouseY : Integer;
Shift : TShiftState;
SenderParentForm:TCustomForm;
RubberBandWasActive:boolean;
SenderOrigin:TPoint;
SelectedCompClass: TRegisteredComponent;
Begin
FHintTimer.Enabled := False;
SenderParentForm:=GetParentForm(Sender);
if (MouseDownComponent=nil) or (SenderParentForm=nil) then exit;
ControlSelection.ActiveGrabber:=nil;
RubberBandWasActive:=ControlSelection.RubberBandActive;
Shift := [];
if (Message.keys and MK_Shift) = MK_Shift then
Shift := [ssShift];
if (Message.keys and MK_Control) = MK_Control then
Shift := Shift +[ssCTRL];
SenderOrigin:=GetFormRelativeControlTopLeft(Sender);
MouseX:=Message.Pos.X+SenderOrigin.X;
MouseY:=Message.Pos.Y+SenderOrigin.Y;
MouseUpPos := Point(MouseX,MouseY);
dec(MouseX,MouseDownPos.X);
dec(MouseY,MouseDownPos.Y);
writeln('************************************************************');
write('MouseLeftUpOnControl');
write(' ',Sender.Name,':',Sender.ClassName,' Origin=',SenderOrigin.X,',',SenderOrigin.Y);
write(' Msg=',Message.Pos.X,',',Message.Pos.Y);
write(' Mouse=',MouseX,',',MouseY);
writeln('');
if Assigned(FOnGetSelectedComponentClass) then
FOnGetSelectedComponentClass(Self,SelectedCompClass)
else
SelectedCompClass:=nil;
if (Message.Keys and MK_LButton) > 0 then begin
// left mouse button
if SelectedCompClass = nil then begin
// selection mode
ControlSelection.BeginUpdate;
if not FHasSized then begin
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);
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;
end;
end else begin
// add a new control
ControlSelection.RubberbandActive:=false;
ControlSelection.BeginUpdate;
if Assigned(FOnSetDesigning) then FOnSetDesigning(Self,FCustomForm,False);
ParentCI:=TComponentInterface(FFormEditor.FindComponent(Sender));
if (Sender is TWinControl)
and (not (csAcceptsControls in TWinControl(Sender).ControlStyle)) then begin
ParentCI:=TComponentInterface(
FFormEditor.FindComponent(TWinControl(Sender).Parent));
end;
if Assigned(ParentCI) then begin
NewLeft:=Min(MouseDownPos.X,MouseUpPos.X)-SenderOrigin.X;
NewWidth:=Abs(MouseUpPos.X-MouseDownPos.X)-SenderOrigin.Y;
NewTop:=Min(MouseDownPos.Y,MouseUpPos.Y);
NewHeight:=Abs(MouseUpPos.Y-MouseDownPos.Y);
if Abs(NewWidth+NewHeight)<7 then begin
// this very small component is probably only a wag, take default size
NewWidth:=0;
NewHeight:=0;
end;
NewCI := TComponentInterface(FFormEditor.CreateComponent(
ParentCI,SelectedCompClass.ComponentClass
,NewLeft,NewTop,NewWidth,NewHeight));
NewCI.SetPropByName('Visible',True);
NewCI.SetPropByName('Designing',True);
if Assigned(FOnSetDesigning) then
FOnSetDesigning(Self,NewCI.Control,True);
if Assigned(FOnComponentListChanged) then
FOnComponentListChanged(Self);
if Assigned(FOnAddComponent) then
FOnAddComponent(Self,NewCI.Control,SelectedCompClass);
SelectOnlyThisComponent(TComponent(NewCI.Control));
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);
Form.Invalidate;
writeln('NEW COMPONENT ADDED: ',Form.ComponentCount,' ',NewCI.Control.Owner.Name);
end;
ControlSelection.EndUpdate;
end;
end;
LastMouseMovePos.X:=-1;
FHasSized:=false;
MouseDownComponent:=nil;
MouseDownSender:=nil;
writeln('[TDesigner.MouseLeftUpOnControl] END');
end;
Procedure TDesigner.MouseMoveOnControl(Sender : TControl; var Message : TLMMouse);
var
Shift : TShiftState;
SenderOrigin:TPoint;
SenderParentForm:TCustomForm;
MouseX, MouseY :integer;
UpdateLastMove : Boolean;
Begin
try
UpdateLastMove := True;
FHintTimer.Enabled := False;
//don't want it enabled when a mouse button is pressed.
FHintTimer.Enabled := (Message.keys or (MK_LButton and MK_RButton and MK_MButton) = 0);
if FHintWindow.Visible then
FHintWindow.Visible := False;
if MouseDownComponent=nil then exit;
SenderParentForm:=GetParentForm(Sender);
if SenderParentForm=nil then exit;
SenderOrigin:=GetFormRelativeControlTopLeft(Sender);
MouseX:=Message.Pos.X+SenderOrigin.X;
MouseY:=Message.Pos.Y+SenderOrigin.Y;
if (Mouse.CursorPos.X < SenderParentForm.Left) or (Mouse.CursorPos.Y < SenderParentForm.Top) or
(Mouse.CursorPos.X > (SenderParentForm.Left+SenderParentForm.Width+(TForm(senderparentform).borderwidth))) or (Mouse.CursorPos.Y > (SenderParentForm.Top+SenderParentForm.Height+(22))) then
Begin
UpdateLastMove := False;
Exit;
end;
//debugging commented out
{ if (Message.keys and MK_LButton) = MK_LButton then begin
Write('MouseMoveOnControl'
,' ',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;
}
Shift := [];
if (TLMMouse(Message).keys and MK_Shift) = MK_Shift then
Shift := [ssShift];
if (TLMMouse(Message).keys and MK_Control) = MK_Control then
Shift := Shift + [ssCTRL];
if (Message.keys and MK_LButton) = MK_LButton then begin
if ControlSelection.ActiveGrabber<>nil then
begin
FHasSized:=true;
ControlSelection.SizeSelection(MouseX-LastMouseMovePos.X, MouseY-LastMouseMovePos.Y);
//commented out by sxm 2001-11-21
// if Assigned(FOnPropertiesChanged) then
// FOnPropertiesChanged(Self);
end
else
begin
if (not (MouseDownComponent is TCustomForm)) and (ControlSelection.Count>=1)
and not (ControlSelection[0].Component is TCustomForm) then
begin
// move selection
FHasSized:=true;
//TODO:create a rubberband looking control to move instead of the components
//that will speed up to updates.
ControlSelection.MoveSelection(MouseX-LastMouseMovePos.X, MouseY-LastMouseMovePos.Y);
//commented out by sxm 2001-11-21
// if Assigned(FOnPropertiesChanged) then
// FOnPropertiesChanged(Self);
end
else
begin
// rubberband selection/creation
ControlSelection.RubberBandBounds:=Rect(MouseDownPos.X,MouseDownPos.Y,MouseX,MouseY);
ControlSelection.RubberBandActive:=true;
SenderParentForm.Invalidate;
end;
end;
end else begin
ControlSelection.ActiveGrabber:=nil;
end;
finally
SenderOrigin:=GetFormRelativeControlTopLeft(Sender);
if UpdateLastMove then
LastMouseMovePos:=Point(MouseX,MouseY);
end;
end;
procedure TDesigner.MouseRightUpOnControl(Sender : TControl; Message:TLMMouse);
var
MouseX, MouseY : Integer;
SenderOrigin: TPoint;
begin
FHintTimer.Enabled := False;
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 -------------------------------
}
{
Handles the keydown messages. DEL deletes the selected controls, CTRL-ARROR
moves the selection up one, SHIFT-ARROW resizes, etc.
}
Procedure TDesigner.KeyDown(Sender : TControl; Message:TLMKEY);
var
I : Integer;
Shift : TShiftState;
Begin
Writeln('KEYDOWN');
with MEssage do
Begin
Writeln('CHARCODE = '+inttostr(charcode));
Writeln('KEYDATA = '+inttostr(KeyData));
end;
Shift := KeyDataToShiftState(Message.KeyData);
if (Message.CharCode = 46) then //DEL KEY
begin
if (ControlSelection.Count = 1) and (ControlSelection.Items[0].Component = FCustomForm) then
Exit;
ControlSelection.BeginUpdate;
for I := ControlSelection.Count-1 downto 0 do Begin
Writeln('I = '+inttostr(i));
RemoveControl(ControlSelection.Items[I].Component);
End;
SelectOnlythisComponent(FCustomForm);
ControlSelection.EndUpdate;
end
else
if Message.CharCode = 38 then //UP ARROW
Begin
if (ssCtrl in Shift) then
NudgeControl(0,-1)
else if (ssShift in Shift) then
NudgeSize(0,-1);
end
else if Message.CharCode = 40 then //DOWN ARROW
Begin
if (ssCtrl in Shift) then
NudgeControl(0,1)
else if (ssShift in Shift) then
NudgeSize(0,1);
end
else
if Message.CharCode = 39 then //RIGHT ARROW
Begin
if (ssCtrl in Shift) then
NudgeControl(1,0)
else if (ssShift in Shift) then
NudgeSize(1,0);
end
else
if Message.CharCode = 37 then //LEFT ARROW
Begin
if (ssCtrl in Shift) then
NudgeControl(-1,0)
else if (ssShift in Shift) then
NudgeSize(-1,0);
end;
end;
{-----------------------------------------K E Y U P --------------------------------}
Procedure TDesigner.KeyUp(Sender : TControl; Message:TLMKEY);
Begin
Writeln('KEYUp');
with MEssage do
Begin
Writeln('CHARCODE = '+inttostr(charcode));
Writeln('KEYDATA = '+inttostr(KeyData));
end;
end;
function TDesigner.IsDesignMsg(Sender: TControl; var Message: TLMessage): Boolean;
Begin
Result := false;
if csDesigning in Sender.ComponentState then begin
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
Result:=true
else
if (Message.Msg = LM_ACTIVATE) then
Result := True;
// else
// if ((Message.Msg >= CM_MOUSEENTER) and (Message.Msg <= CM_MOUSELEAVE)) then
// Result:=true;
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: 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));
LM_ACTIVATE : OnFormActivated;
// CM_MOUSELEAVE: Writeln('MOUSELEAVE!!!!!!!!!!!!');//Result:=MoveControl(Sender,TLMMove(Message));
end;
end;
end;
procedure TDesigner.Modified;
Begin
ControlSelection.SaveBounds;
if Assigned(FOnModified) then FOnModified(Self);
end;
procedure TDesigner.Notification(AComponent: TComponent; Operation: TOperation);
Begin
if Operation = opInsert then
begin
Writeln('opInsert');
end
else
if Operation = opRemove then
begin
writeln('[TDesigner.Notification] opRemove '+
''''+AComponent.ClassName+'.'+AComponent.Name+'''');
if (AComponent is TControl) then
if ControlSelection.IsSelected(AComponent) then
ControlSelection.Remove(AComponent);
end;
end;
procedure TDesigner.PaintGrid;
var
x,y : integer;
begin
with FCustomForm.Canvas do begin
Pen.Color := FGridColor;
x := 0;
while x <= FCustomForm.Width do begin
y := 0;
while y <= FCustomForm.Height do begin
MoveTo(x,y);
LineTo(x+1,y);
// Pixels[X,Y]:=FGridColor;
Inc(y, GridSizeY);
end;
Inc(x, GridSizeX);
end;
end;
end;
procedure TDesigner.ValidateRename(AComponent: TComponent;
const CurName, NewName: string);
Begin
writeln('ToDo: TDesigner.ValidateRename ',CurName,', ',NewName);
end;
function TDesigner.GetIsControl: Boolean;
Begin
Result := True;
end;
procedure TDesigner.SetIsControl(Value: Boolean);
Begin
end;
procedure TDesigner.DrawNonVisualComponents(DC: HDC);
var i, j, ItemLeft, ItemTop, ItemRight, ItemBottom: integer;
FormOrigin, DCOrigin, Diff: TPoint;
SaveIndex: HDC;
IconRect: TRect;
IconCanvas: TCanvas;
begin
GetWindowOrgEx(DC, DCOrigin);
FormOrigin:=FCustomForm.ClientOrigin;
Diff.X:=FormOrigin.X-DCOrigin.X;
Diff.Y:=FormOrigin.Y-DCOrigin.Y;
SaveIndex:=SaveDC(DC);
FCustomForm.Canvas.Handle:=DC;
for i:=0 to FCustomForm.ComponentCount-1 do begin
if not (FCustomForm.Components[i] is TControl) then begin
// non-visual component
ItemLeft:=LongRec(FCustomForm.Components[i].DesignInfo).Lo+Diff.X;
ItemTop:=LongRec(FCustomForm.Components[i].DesignInfo).Hi+Diff.Y;
ItemRight:=ItemLeft+NonVisualCompWidth;
ItemBottom:=ItemTop+NonVisualCompWidth;
with FCustomForm.Canvas do begin
Brush.Color:=clWhite;
for j:=0 to NonVisualCompBorder-1 do begin
MoveTo(ItemLeft+j,ItemBottom-j);
LineTo(ItemLeft+j,ItemTop+j);
LineTo(ItemRight-j,ItemTop+j);
end;
Brush.Color:=clBlack;
for j:=0 to NonVisualCompBorder-1 do begin
MoveTo(ItemLeft+j,ItemBottom-j);
LineTo(ItemRight-j,ItemBottom-j);
MoveTo(ItemRight-j,ItemTop+j);
LineTo(ItemRight-j,ItemBottom-j+1);
end;
IconRect:=Rect(ItemLeft+NonVisualCompBorder,ItemTop+NonVisualCompBorder,
ItemRight-NonVisualCompBorder,ItemBottom-NonVisualCompBorder);
Brush.Color:=clBtnFace;
FillRect(Rect(IconRect.Left,IconRect.Top,
IconRect.Right+1,IconRect.Bottom+1));
end;
if Assigned(FOnGetNonVisualCompIconCanvas) then begin
IconCanvas:=nil;
FOnGetNonVisualCompIconCanvas(Self,FCustomForm.Components[i]
,IconCanvas);
if IconCanvas<>nil then
FCustomForm.Canvas.CopyRect(IconRect, IconCanvas,
Rect(0,0,NonVisualCompIconWidth,NonVisualCompIconWidth));
end;
if (ControlSelection.Count>1)
and (ControlSelection.IsSelected(FCustomForm.Components[i])) then
ControlSelection.DrawMarkerAt(FCustomForm.Canvas,
ItemLeft,ItemTop,NonVisualCompWidth,NonVisualCompWidth);
end;
end;
FCustomForm.Canvas.Handle:=0;
RestoreDC(DC,SaveIndex);
end;
function TDesigner.NonVisualComponentAtPos(x,y: integer): TComponent;
var i, ALeft, ATop: integer;
begin
for i:=FCustomForm.ComponentCount-1 downto 0 do begin
Result:=FCustomForm.Components[i];
if (Result is TControl)=false then begin
with Result do begin
ALeft:=LongRec(DesignInfo).Lo;
ATop:=LongRec(DesignInfo).Hi;
if (ALeft<=x) and (ATop<=y)
and (ALeft+NonVisualCompWidth>x)
and (ATop+NonVisualCompWidth>y) then
exit;
end;
end;
end;
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);
FBringToFrontMenuItem := TMenuItem.Create(nil);
with FBringToFrontMenuItem do begin
Caption:= 'Bring to front';
OnClick:= @OnBringToFrontMenuClick;
Enabled:= CompsAreSelected;
end;
FPopupMenu.Items.Add(FBringToFrontMenuItem);
FSendToBackMenuItem:= TMenuItem.Create(nil);
with FSendToBackMenuItem do begin
Caption:= 'Send to back';
OnClick:= @OnSendToBackMenuClick;
Enabled:= CompsAreSelected;
end;
FPopupMenu.Items.Add(FSendToBackMenuItem);
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;
procedure TDesigner.OnBringToFrontMenuClick(Sender: TObject);
var AComponent : TComponent;
begin
if ControlSelection.Count = 1 then begin
AComponent:= ControlSelection.Items[0].Component;
if AComponent is TControl then TControl(AComponent).BringToFront;
end;
end;
procedure TDesigner.OnSendToBackMenuClick(Sender: TObject);
var AComponent : TComponent;
begin
if ControlSelection.Count = 1 then begin
AComponent:= ControlSelection.Items[0].Component;
if AComponent is TControl then TControl(AComponent).SendToBack;
end;
end;
Procedure TDesigner.HintTimer(sender : TObject);
var
Rect : TRect;
AHint : String;
Control : TControl;
Position : TPoint;
BW : Integer;
Window : TWInControl;
begin
FHintTimer.Enabled := False;
Position := Mouse.CursorPos;
Window := FindLCLWindow(Position);
if not(Assigned(window)) then Exit;
//get the parent until parent is nil
While Window.Parent <> nil do
Window := Window.Parent;
if (window <> FCustomForm) then Exit;
BW := 0;
if (FCustomForm is TForm) then
BW := TForm(FCustomForm).BorderWidth;
if ((Position.X < (FCustomForm.LEft +BW)) or (Position.X > (FCustomForm.Left+FCustomForm.Width - BW)) or (Position.Y < FCustomForm.Top+22) or (Position.Y > (FCustomForm.Top+FCustomForm.Height - BW))) then Exit;
Position := FCustomForm.ScreenToClient(Position);
Control := FCustomForm.ControlAtPos(Position,True);
if not Assigned(Control) then
Control := FCustomForm;
AHint := Control.Name + ' : '+Control.ClassName;
AHint := AHint + #10+'Left : '+Inttostr(Control.Left)+ ' Top : '+Inttostr(Control.Top)+
#10+'Width : '+Inttostr(Control.Width)+ ' Height : '+Inttostr(Control.Height);
Rect := FHintWindow.CalcHintRect(0,AHint,nil); //no maxwidth
Rect.Left := Mouse.CursorPos.X+10;
Rect.Top := Mouse.CursorPos.Y+5;
Rect.Right := Rect.Left + Rect.Right;
Rect.Bottom := Rect.Top + Rect.Bottom;
FHintWindow.ActivateHint(Rect,AHint);
end;
Procedure TDesigner.OnFormActivated;
begin
//the form was activated.
if Assigned(FOnActivated) then
FOnActivated(Form);
end;
initialization
GridSizex := 10;
GridSizeY := 10;
end.
Reference in New Issue View Git Blame Copy Permalink