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

Added the Nudge feature to the IDE.

Browse Source 
Shane

git-svn-id: trunk@109 -
This commit is contained in:
lazarus 2001-01-10 20:12:29 +00:00
parent 176191f0cf
commit a392379d1d
6 changed files with 180 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
designer/controlselection.pp
View File

@ -91,8 +91,10 @@ type
function IsSelected(AControl: TControl): Boolean;
procedure Remove(AControl: TControl);
procedure MoveSelection(dx, dy: integer);
procedure SizeSelection(dx, dy: integer);
property Visible: Boolean read FVisible write SetVisible;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
procedure SetCaptureGrabber(AGrabber:TGrabber);
@ -250,6 +252,7 @@ end;
procedure TGrabber.PaintWindow(DC: HDC);
begin
// WriteLn(Format('[TGrabber.PaintWindow] 0x%x', [DC]));
// if Visible then
FillRect(DC, Rect(0, 0, Width, Height), GetStockObject(BLACK_BRUSH));
end;
@ -271,6 +274,23 @@ Writeln('**********');
end;
end;
procedure TControlSelection.SizeSelection(dx, dy: integer);
begin
{Writeln('**********');
Writeln('Size Selection');
Writeln(Format('dx,dy = %d,%d',[dx,dy]));
Writeln(Format('FLeft,FTop= %d,%d',[FLeft,FTop]));
Writeln('**********');
}
if (dx<>0) or (dy<>0) then begin
Inc(FWidth,dx);
Inc(FHeight,dy);
SizeContent;
SetGrabbers;
end;
end;
procedure TControlSelection.Add(AControl: TControl);
begin
if AControl <> nil
@ -283,8 +303,8 @@ begin
FControlList.Add(AControl);
end;
AdjustSize(Acontrol, FControlList.Count = 1);
FVisible:=not (AControl is TCustomForm);
SetGrabbers;
Visible:=not (AControl is TCustomForm);
//This is taken care of in SETVISIBLE SetGrabbers;
with TSelectControl(AControl) do
begin
{OnMouseDown := @ControlMouseDown;
@ -367,8 +387,8 @@ begin
end;
FWidth := 0;
FHeight := 0;
FVisible := False;
//SetGrabbers;
Visible := False;
//This is set in SETVISIBLE SetGrabbers;
DoChange;
end;
@ -531,6 +551,7 @@ begin
AdjustSize(TControl(FControlList[n]), n = 0);
end
else FVisible := False;
SetGrabbers;
with TSelectControl(AControl) do
@ -556,6 +577,7 @@ begin
for GrabPos := Low(TGrabIndex) to High(TGrabIndex) do
begin
Grabber := FGrabbers[GrabPos];
if FVisible
then begin
//Write('[TControlSelection.SetGrabbers] Setting grabber ',Ord(GrabPos),' --> ');
@ -594,9 +616,10 @@ begin
end;
Grabber.SetBounds(GrabLeft,GrabTop,GRAB_SIZE,GRAB_SIZE);
//WriteLN(Format('X:%d, Y:%d', [Grabber.Left, Grabber.Top]));
end;
Grabber.Visible := FVisible;
Grabber.Visible := FVisible;
end;
end;

138
designer/designer.pp
View File

@ -44,13 +44,18 @@ type
protected
MouseDownControl : TObject;
MouseDownPos, MouseUpPos, LastMouseMovePos : TPoint;
CTRLDOWN, SHIFTDOWN : Boolean;
Procedure MouseDownOnControl(Sender : TControl; Message : TLMessage);
procedure MouseMoveOnControl(Sender : TControl; var Message : TLMessage);
Procedure MouseUpOnControl(Sender : TControl; Message:TLMessage);
Procedure KeyDown(Sender : TControl; Message:TLMKEY);
Procedure KeyUP(Sender : TControl; Message:TLMKEY);
Procedure RemoveControl(Control : TComponent);
Procedure NudgeControl(Value1,Value2 : Integer);
Procedure NudgeSize(Value1,Value2 : Integer);
public
ControlSelection : TControlSelection;
@ -81,6 +86,14 @@ type
uses
Sysutils, Typinfo,Math;
const
mk_lbutton = 1;
mk_rbutton = 2;
mk_shift = 4;
mk_control = 8;
mk_mbutton = $10;
var
GridPoints : TGridPoint;
@ -116,9 +129,21 @@ Procedure TDesigner.RemoveControl(Control : TComponent);
Begin
Writeln('RemoveControl called');
FSourceEditor.RemoveControlCode(Control);
FCustomForm.Remove(TCOntrol(Control)); //this send a message to notification and removes it from the controlselection
Control.Destroy;
end;
Procedure TDesigner.NudgeControl(Value1,Value2 : Integer);
Begin
Writeln('NudgeControl');
ControlSelection.MoveSelection(Value1,Value2);
end;
Procedure TDesigner.NudgeSize(Value1,Value2 : Integer);
Begin
Writeln('NudgeSize');
ControlSelection.SizeSelection(Value1,Value2);
end;
procedure TDesigner.SelectOnlyThisComponent(AComponent:TComponent);
begin
@ -133,8 +158,10 @@ end;
procedure TDesigner.MouseDownOnControl(Sender : TControl; Message : TLMessage);
var
SHift : TShiftState;
Begin
if assigned(MouseDownControl) and (MOuseDownControl <> Sender) then Exit;
// if assigned(MouseDownControl) and (MOuseDownControl <> Sender) then Exit;
Writeln('Left is '+Inttostr(TCOntrol(Sender).left));
Writeln('Top is '+Inttostr(TCOntrol(Sender).Top));
Writeln('***************************');
@ -156,24 +183,34 @@ Begin
inc(MouseDownPos.Y,TControl(Sender).Top);
end;
Shift := [];
if (TLMMouse(Message).keys and MK_Shift) = MK_Shift then
Writeln('Shift down')
else
Writeln('No Shift down');
if (TLMMouse(Message).keys and MK_Control) = MK_Control then
Writeln('CTRL down')
else
Writeln('No CTRL down');
MouseDownControl:=Sender;
LastMouseMovePos:=MouseDownPos;
Writeln('Sender is '+sender.name);
if FMainIDE.SelectedComponent = nil then
Begin //mouse pointer button pressed.
if not (Sender is TCustomForm) then begin
if (TLMMouse(Message).keys and MK_Shift) = MK_Shift then
ControlSelection.Add(sender)
else
SelectOnlyThisComponent(TComponent(Sender));
end;
end;
End;
procedure TDesigner.MouseUpOnControl(Sender : TControl; Message:TLMessage);
const
mk_lbutton = 1;
mk_rbutton = 2;
mk_shift = 4;
mk_control = 8;
mk_mbutton = $10;
var
ParentCI, NewCI : TComponentInterface;
NewLeft, NewTop, NewWidth, NewHeight : Integer;
@ -240,8 +277,8 @@ Begin
if FMainIDE.SelectedComponent = nil then
Begin //mouse pointer button pressed.
if Sender is TCustomForm then
SelectOnlyThisComponent(TComponent(Sender));
{ if Sender is TCustomForm then
SelectOnlyThisComponent(TComponent(Sender));}
end
else
Begin //add a new control
@ -370,6 +407,15 @@ with MEssage do
Writeln('KEYDATA = '+inttostr(KeyData));
end;
{ CTRLDOWN, SHIFTDOWN : Boolean;
}
if Message.CharCode = 16 then //SHIFT
SHIFTDOWN := True
else
if Message.CharCode = 17 then //CTRL
CTRLDOWN := True
else
if Message.CharCode = 46 then //DEL KEY
begin
for I := 0 to FCustomForm.ComponentCount-1 do
@ -381,17 +427,75 @@ if Message.CharCode = 46 then //DEL KEY
RemoveControl(TControl(FCustomForm.Components[i]));
end;
end;
FFormEditor.ClearSelected;
// this will automatically inform the object inspector
ControlSelection.Add(FCustomForm);
FFormEditor.AddSelected(FCustomForm);
SelectOnlythisComponent(FCustomForm);
end
else
if Message.CharCode = 38 then //UP ARROW
Begin
If CTRLDOWN then
NudgeControl(0,-1)
else
If SHIFTDOWN then
NudgeSize(0,-1);
end
else
if Message.CharCode = 40 then //DOWN ARROW
Begin
If CTRLDOWN then
NudgeControl(0,1)
else
If SHIFTDOWN then
NudgeSize(0,1);
end
else
if Message.CharCode = 39 then //RIGHT ARROW
Begin
If CTRLDOWN then
NudgeControl(1,0)
else
If SHIFTDOWN then
NudgeSize(1,0);
end
else
if Message.CharCode = 37 then //LEFT ARROW
Begin
If CTRLDOWN then
NudgeControl(-1,0)
else
If SHIFTDOWN then
NudgeSize(-1,0);
end;
end;
{-----------------------------------------K E Y U P --------------------------------}
Procedure TDesigner.KeyUp(Sender : TControl; Message:TLMKEY);
var
I : Integer;
Begin
Writeln('KEYUp');
with MEssage do
Begin
Writeln('CHARCODE = '+inttostr(charcode));
Writeln('KEYDATA = '+inttostr(KeyData));
end;
{ CTRLDOWN, SHIFTDOWN : Boolean;
}
if Message.CharCode = 16 then //SHIFT
SHIFTDOWN := False
else
if Message.CharCode = 17 then //CTRL
CTRLDOWN := False
end;
function TDesigner.IsDesignMsg(Sender: TControl; var Message: TLMessage): Boolean;
Begin
result := false;
@ -401,7 +505,9 @@ else
if ((Message.msg >= LM_KeyFIRST) and (Message.msg <= LM_KeyLAST)) then
Begin
Writeln('KEY MESSAGE in IsDesignMsg');
KeyDown(Sender,TLMKey(Message));
if MEssage.MSG = LM_KEYDOWN then KeyDown(Sender,TLMKey(Message))
else
if MEssage.MSG = LM_KEYUP then KeyUP(Sender,TLMKey(Message));
Result := true;
end;

8
lcl/include/custommemo.inc
View File

@ -78,14 +78,18 @@ end;
and the cached propeties are set.
This is the only place where a call to SetCallBack is made.
------------------------------------------------------------------------------}
procedure TCustomMemo.AttachSignals;
{procedure TCustomMemo.AttachSignals;
begin
inherited AttachSignals;
end;
end; }
{ =============================================================================
$Log$
Revision 1.2 2001/01/10 20:12:29 lazarus
Added the Nudge feature to the IDE.
Shane
Revision 1.1 2000/07/13 10:28:25 michael
+ Initial import

15
lcl/interfaces/gtk/gtkcallback.inc
View File

@ -198,8 +198,11 @@ begin
// Assert(False, Format('Trace:[GTKKeyUpDown] Type: %3:d, GTK: 0x%0:x(%0:d) LCL: 0x%1:x(%1:d) VK: 0x%2:x(%2:d)', [Event^.keyval, KeyCode, Msg.CharCode, Event^.theType]));
Flags := 0;
if Extended then Flags := KF_EXTENDED;
if SysKey then Flags := Flags or KF_ALTDOWN;
Msg.KeyData := $00000000; //TODO: OEM char
Msg.KeyData := Msg.KeyData or (Flags shl 16);
@ -211,7 +214,10 @@ begin
if SysKey
then Msg.msg := LM_SYSKEYUP
else Msg.msg := LM_KEYUP;
Msg.KeyData := Msg.KeyData or 0{TODO: previous keystate} or $0001 {TODO: repeatcount};
Flags := KF_UP or KF_REPEAT;
Msg.KeyData := Msg.KeyData or (Flags shl 16) or $0001 {allways};
Result := DeliverPostMessage(data, msg);
end;
@ -222,8 +228,7 @@ begin
then Msg.msg := LM_SYSKEYDOWN
else Msg.msg := LM_KEYDOWN;
Flags := KF_UP or KF_REPEAT;
Msg.KeyData := Msg.KeyData or (Flags shl 16) or $0001 {allways};
Msg.KeyData := Msg.KeyData or 0{TODO: previous keystate} or $0001 {TODO: repeatcount};
Result := DeliverPostMessage(data, msg);
if KeyCode <> $FFFF
@ -1095,6 +1100,10 @@ end;
{ =============================================================================
$Log$
Revision 1.12 2001/01/10 20:12:29 lazarus
Added the Nudge feature to the IDE.
Shane
Revision 1.11 2001/01/09 18:23:21 lazarus
Worked on moving controls. It's just not working with the X and Y coord's I'm getting.
Shane

6
lcl/interfaces/gtk/gtkobject.inc
View File

@ -1282,6 +1282,8 @@ begin
LM_SYSCHAR,
LM_SYSKEYUP:
begin
if (sender is TMemo) then
Writeln('KEY-PRESS-EVENT for TMEmo');
ConnectSignal(gFixed, 'key-press-event', @GTKKeyUpDown, GDK_KEY_PRESS_MASK);
ConnectSignal(gFixed, 'key-release-event', @GTKKeyUpDown, GDK_KEY_RELEASE_MASK);
end;
@ -2703,6 +2705,10 @@ end;
{ =============================================================================
$Log$
Revision 1.17 2001/01/10 20:12:29 lazarus
Added the Nudge feature to the IDE.
Shane
Revision 1.16 2001/01/09 18:23:21 lazarus
Worked on moving controls. It's just not working with the X and Y coord's I'm getting.
Shane

8
lcl/stdctrls.pp
View File

@ -184,6 +184,7 @@ type
protected
Procedure CMTextChanged(Var Message : TLMessage); message CM_TextChanged;
Procedure Change; dynamic;
procedure AttachSignals; override;
property OnChange : TNotifyEvent read FOnChange write FOnChange;
public
@ -196,7 +197,6 @@ type
property Text;
published
property TabStop default true;
procedure AttachSignals; override;
end;
@ -207,7 +207,7 @@ type
FScrollBars: TScrollStyle;
FWordWrap: Boolean;
protected
procedure AttachSignals; override;
// procedure AttachSignals; override;
procedure SetLines(Value : TStrings);
procedure SetWordWrap(Value : Boolean);
@ -493,6 +493,10 @@ end.
{ =============================================================================
$Log$
Revision 1.9 2001/01/10 20:12:29 lazarus
Added the Nudge feature to the IDE.
Shane
Revision 1.8 2001/01/05 17:44:37 lazarus
ViewUnits1, ViewForms1 and MessageDlg are all loaded from their resources and all controls are auto-created on them.
There are still a few problems with some controls so I haven't converted all forms.