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

MG: fixed apiwidget warnings/criticals

Browse Source 
git-svn-id: trunk@1747 -
This commit is contained in:
lazarus 2002-06-12 12:35:44 +00:00
parent 1892b7d5aa
commit afefd015da
3 changed files with 183 additions and 142 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
designer/controlselection.pp
View File

@ -672,8 +672,8 @@ begin
end; end;
procedure TControlSelection.MoveSelection(dx, dy: integer); procedure TControlSelection.MoveSelection(dx, dy: integer);
var i:integer; var i: integer;
g:TGrabIndex; g: TGrabIndex;
begin begin
if (dx=0) and (dy=0) then exit; if (dx=0) and (dy=0) then exit;
BeginUpdate; BeginUpdate;

313
designer/designer.pp
View File

@ -85,33 +85,40 @@ type
//hint stuff //hint stuff
FHintTimer : TTimer; FHintTimer : TTimer;
FHintWIndow : THintWindow; FHintWIndow : THintWindow;
function GetDisplayGrid: boolean; function GetDisplayGrid: boolean;
function GetGridSizeX: integer; function GetGridSizeX: integer;
function GetGridSizeY: integer; function GetGridSizeY: integer;
function GetIsControl: Boolean; function GetIsControl: Boolean;
function GetSnapToGrid: boolean;
Procedure HintTimer(sender : TObject);
procedure InvalidateWithParent(AComponent: TComponent);
procedure SetDisplayGrid(const AValue: boolean); procedure SetDisplayGrid(const AValue: boolean);
procedure SetGridSizeX(const AValue: integer); procedure SetGridSizeX(const AValue: integer);
procedure SetGridSizeY(const AValue: integer); procedure SetGridSizeY(const AValue: integer);
procedure SetIsControl(Value: Boolean); procedure SetIsControl(Value: Boolean);
procedure InvalidateWithParent(AComponent: TComponent); procedure SetSnapToGrid(const AValue: boolean);
Procedure HintTimer(sender : TObject);
protected protected
MouseDownComponent, MouseDownSender : TComponent; MouseDownComponent: TComponent;
MouseDownPos, MouseUpPos, LastMouseMovePos : TPoint; MouseDownSender: TComponent;
MouseDownPos: TPoint;
MouseUpPos: TPoint;
LastMouseMovePos: TPoint;
function PaintControl(Sender: TControl; Message: TLMPaint):boolean; function PaintControl(Sender: TControl; Message: TLMPaint):boolean;
function SizeControl(Sender: TControl; Message: TLMSize):boolean; function SizeControl(Sender: TControl; Message: TLMSize):boolean;
function MoveControl(Sender: TControl; Message: TLMMove):boolean; function MoveControl(Sender: TControl; Message: TLMMove):boolean;
Procedure MouseDownOnControl(Sender : TControl; Message : TLMMouse); Procedure MouseDownOnControl(Sender: TControl; Message : TLMMouse);
Procedure MouseMoveOnControl(Sender : TControl; var Message : TLMMouse); Procedure MouseMoveOnControl(Sender: TControl; var Message : TLMMouse);
Procedure MouseLeftUpOnControl(Sender : TControl; Message:TLMMouse); Procedure MouseLeftUpOnControl(Sender: TControl; Message:TLMMouse);
Procedure MouseRightUpOnControl(Sender : TControl; Message:TLMMouse); Procedure MouseRightUpOnControl(Sender: TControl; Message:TLMMouse);
Procedure KeyDown(Sender : TControl; Message:TLMKEY); Procedure KeyDown(Sender: TControl; Message:TLMKEY);
Procedure KeyUP(Sender : TControl; Message:TLMKEY); Procedure KeyUp(Sender: TControl; Message:TLMKEY);
Procedure RemoveControl(Control : TComponent); Procedure RemoveControl(Control: TComponent);
Procedure NudgeControl(DiffX, DiffY: Integer); Procedure NudgeControl(DiffX, DiffY: Integer);
Procedure NudgeSize(DiffX, DiffY: Integer); Procedure NudgeSize(DiffX, DiffY: Integer);
procedure MoveSelection(DiffX, DiffY: integer);
procedure BuildPopupMenu; procedure BuildPopupMenu;
procedure OnAlignPopupMenuClick(Sender: TObject); procedure OnAlignPopupMenuClick(Sender: TObject);
@ -163,19 +170,17 @@ type
property OnGetNonVisualCompIconCanvas: TOnGetNonVisualCompIconCanvas property OnGetNonVisualCompIconCanvas: TOnGetNonVisualCompIconCanvas
read FOnGetNonVisualCompIconCanvas write FOnGetNonVisualCompIconCanvas; read FOnGetNonVisualCompIconCanvas write FOnGetNonVisualCompIconCanvas;
property ShowHints: boolean read FShowHints write FShowHints; property ShowHints: boolean read FShowHints write FShowHints;
property SnapToGrid: boolean read GetSnapToGrid write SetSnapToGrid;
property SourceEditor : TSourceEditor read FSourceEditor write FSourceEditor; property SourceEditor : TSourceEditor read FSourceEditor write FSourceEditor;
end; end;
implementation implementation
uses uses
Sysutils, Math; Sysutils, Math;
const const
mk_lbutton = 1; mk_lbutton = 1;
mk_rbutton = 2; mk_rbutton = 2;
@ -202,7 +207,7 @@ begin
FHintWindow := THintWindow.Create(nil); FHintWindow := THintWindow.Create(nil);
FHIntWindow.Visible := False; FHIntWindow.Visible := False;
FHintWindow.Caption := 'This is a hint window'#13#10'NEat huh?'; FHintWindow.Caption := 'This is a hint window'#13#10'Neat huh?';
FHintWindow.HideInterval := 4000; FHintWindow.HideInterval := 4000;
FHintWindow.AutoHide := True; FHintWindow.AutoHide := True;
end; end;
@ -229,7 +234,9 @@ end;
Procedure TDesigner.NudgeControl(DiffX, DiffY : Integer); Procedure TDesigner.NudgeControl(DiffX, DiffY : Integer);
Begin Begin
{$IFDEF VerboseDesigner}
Writeln('[TDesigner.NudgeControl]'); Writeln('[TDesigner.NudgeControl]');
{$ENDIF}
ControlSelection.MoveSelection(DiffX, DiffY); ControlSelection.MoveSelection(DiffX, DiffY);
if ControlSelection.OnlyNonVisualComponentsSelected then if ControlSelection.OnlyNonVisualComponentsSelected then
FCustomForm.Invalidate; FCustomForm.Invalidate;
@ -237,10 +244,25 @@ end;
Procedure TDesigner.NudgeSize(DiffX, DiffY: Integer); Procedure TDesigner.NudgeSize(DiffX, DiffY: Integer);
Begin Begin
{$IFDEF VerboseDesigner}
Writeln('[TDesigner.NudgeSize]'); Writeln('[TDesigner.NudgeSize]');
{$ENDIF}
ControlSelection.SizeSelection(DiffX, DiffY); ControlSelection.SizeSelection(DiffX, DiffY);
end; end;
procedure TDesigner.MoveSelection(DiffX, DiffY: integer);
var
StepX, StepY: integer;
begin
if SnapToGrid then begin
StepX:=GridSizeX;
StepY:=GridSizeY;
DiffX:=DiffX+(StepX div 2)-(DiffX mod StepX);
DiffY:=DiffY+(StepY div 2)-(DiffY mod StepY);
end;
ControlSelection.MoveSelection(DiffX,DiffY);
end;
procedure TDesigner.SelectOnlyThisComponent(AComponent:TComponent); procedure TDesigner.SelectOnlyThisComponent(AComponent:TComponent);
begin begin
ControlSelection.BeginUpdate; ControlSelection.BeginUpdate;
@ -251,7 +273,9 @@ end;
procedure TDesigner.InvalidateWithParent(AComponent: TComponent); procedure TDesigner.InvalidateWithParent(AComponent: TComponent);
begin begin
writeln('INVALIDATEWITHPARENT'); {$IFDEF VerboseDesigner}
writeln('TDesigner.INVALIDATEWITHPARENT ',AComponent.Name,':',AComponent.ClassName);
{$ENDIF}
if AComponent is TControl then begin if AComponent is TControl then begin
if TControl(AComponent).Parent<>nil then if TControl(AComponent).Parent<>nil then
TControl(AComponent).Parent.Invalidate TControl(AComponent).Parent.Invalidate
@ -267,13 +291,13 @@ var OldDuringPaintControl: boolean;
begin begin
Result:=true; Result:=true;
//writeln('*** LM_PAINT A ',Sender.Name,':',Sender.ClassName,' DC=',HexStr(Message.DC,8)); //writeln('*** LM_PAINT A ',Sender.Name,':',Sender.ClassName,' DC=',HexStr(Message.DC,8));
OldDuringPaintControl:=FDuringPaintControl; OldDuringPaintControl:=FDuringPaintControl;
FDuringPaintControl:=true; FDuringPaintControl:=true;
Sender.Dispatch(Message); Sender.Dispatch(Message);
//writeln('*** LM_PAINT B ',Sender.Name,':',Sender.ClassName,' DC=',HexStr(Message.DC,8)); //writeln('*** LM_PAINT B ',Sender.Name,':',Sender.ClassName,' DC=',HexStr(Message.DC,8));
if (ControlSelection.IsSelected(Sender)) then begin if (ControlSelection.IsSelected(Sender)) then begin
// writeln('*** LM_PAINT ',Sender.Name,':',Sender.ClassName,' DC=',HexStr(Message.DC,8)); // writeln('*** LM_PAINT ',Sender.Name,':',Sender.ClassName,' DC=',HexStr(Message.DC,8));
ControlSelection.DrawMarker(Sender,Message.DC); ControlSelection.DrawMarker(Sender,Message.DC);
@ -283,7 +307,7 @@ begin
ControlSelection.DrawGrabbers(Message.DC); ControlSelection.DrawGrabbers(Message.DC);
if ControlSelection.RubberBandActive then if ControlSelection.RubberBandActive then
ControlSelection.DrawRubberBand(Message.DC); ControlSelection.DrawRubberBand(Message.DC);
// end; // end;
FDuringPaintControl:=OldDuringPaintControl; FDuringPaintControl:=OldDuringPaintControl;
end; end;
@ -292,8 +316,8 @@ begin
Result:=true; Result:=true;
Sender.Dispatch(Message); Sender.Dispatch(Message);
if (ControlSelection.IsSelected(Sender)) then begin if (ControlSelection.IsSelected(Sender)) then begin
// writeln('*** LM_Size ',Sender.Name,':',Sender.ClassName,' Type=',Message.SizeType // writeln('*** LM_Size ',Sender.Name,':',Sender.ClassName,' Type=',Message.SizeType
// ,' ',Message.Width,',',Message.Height,' Pos=',Sender.Left,',',Sender.Top); // ,' ',Message.Width,',',Message.Height,' Pos=',Sender.Left,',',Sender.Top);
if not ControlSelection.IsResizing then begin if not ControlSelection.IsResizing then begin
ControlSelection.AdjustSize; ControlSelection.AdjustSize;
if Assigned(FOnPropertiesChanged) then if Assigned(FOnPropertiesChanged) then
@ -307,12 +331,11 @@ begin
Result:=true; Result:=true;
Sender.Dispatch(Message); Sender.Dispatch(Message);
if (ControlSelection.IsSelected(Sender)) then begin if (ControlSelection.IsSelected(Sender)) then begin
// writeln('*** LM_Move ',Sender.Name,':',Sender.ClassName); // writeln('*** LM_Move ',Sender.Name,':',Sender.ClassName);
ControlSelection.AdjustSize; ControlSelection.AdjustSize;
if Assigned(FOnPropertiesChanged) then if Assigned(FOnPropertiesChanged) then
FOnPropertiesChanged(Self); FOnPropertiesChanged(Self);
end; end;
end; end;
procedure TDesigner.MouseDownOnControl(Sender : TControl; Message : TLMMouse); procedure TDesigner.MouseDownOnControl(Sender : TControl; Message : TLMMouse);
@ -338,6 +361,7 @@ Begin
MouseDownPos := Point(MouseX,MouseY); MouseDownPos := Point(MouseX,MouseY);
LastMouseMovePos:=MouseDownPos; LastMouseMovePos:=MouseDownPos;
{$IFDEF VerboseDesigner}
writeln('************************************************************'); writeln('************************************************************');
write('MouseDownOnControl'); write('MouseDownOnControl');
write(' ',Sender.Name,':',Sender.ClassName,' Origin=',SenderOrigin.X,',',SenderOrigin.Y); write(' ',Sender.Name,':',Sender.ClassName,' Origin=',SenderOrigin.X,',',SenderOrigin.Y);
@ -345,7 +369,6 @@ Begin
write(' Mouse=',MouseX,',',MouseY); write(' Mouse=',MouseX,',',MouseY);
writeln(''); writeln('');
if (Message.Keys and MK_Shift) = MK_Shift then if (Message.Keys and MK_Shift) = MK_Shift then
Write(' Shift down') Write(' Shift down')
else else
@ -355,6 +378,7 @@ Begin
Writeln(', CTRL down') Writeln(', CTRL down')
else else
Writeln(', No CTRL down'); Writeln(', No CTRL down');
{$ENDIF}
if (Message.Keys and MK_LButton) > 0 then begin if (Message.Keys and MK_LButton) > 0 then begin
ControlSelection.ActiveGrabber:= ControlSelection.ActiveGrabber:=
@ -373,8 +397,6 @@ Begin
if ControlSelection.ActiveGrabber=nil then begin if ControlSelection.ActiveGrabber=nil then begin
NonVisualComp:=NonVisualComponentAtPos( NonVisualComp:=NonVisualComponentAtPos(
MouseDownPos.X,MouseDownPos.Y); MouseDownPos.X,MouseDownPos.Y);
Writeln('ActiveGrabber = nil');
if NonVisualComp<>nil then Writeln('1') else Writeln('2');
if NonVisualComp<>nil then MouseDownComponent:=NonVisualComp; if NonVisualComp<>nil then MouseDownComponent:=NonVisualComp;
CompIndex:=ControlSelection.IndexOf(MouseDownComponent); CompIndex:=ControlSelection.IndexOf(MouseDownComponent);
if (Message.Keys and MK_SHIFT)>0 then begin if (Message.Keys and MK_SHIFT)>0 then begin
@ -413,14 +435,15 @@ Begin
// mouse down on grabber -> begin sizing // mouse down on grabber -> begin sizing
// grabber is already activated // grabber is already activated
// the sizing is handled in mousemove // the sizing is handled in mousemove
writeln('[TDesigner.MouseDownOnControl] Grabber activated');
end; end;
end else begin end else begin
// add component mode -> handled in mousemove and mouseup // add component mode -> handled in mousemove and mouseup
end; end;
end; end;
writeln('[TDesigner.MouseDownOnControl] END'); {$IFDEF VerboseDesigner}
writeln('[TDesigner.MouseDownOnControl] END');
{$ENDIF}
End; End;
procedure TDesigner.MouseLeftUpOnControl(Sender : TControl; Message:TLMMouse); procedure TDesigner.MouseLeftUpOnControl(Sender : TControl; Message:TLMMouse);
@ -448,8 +471,6 @@ Begin
if (Message.keys and MK_Control) = MK_Control then if (Message.keys and MK_Control) = MK_Control then
Shift := Shift +[ssCTRL]; Shift := Shift +[ssCTRL];
SenderOrigin:=GetFormRelativeControlTopLeft(Sender); SenderOrigin:=GetFormRelativeControlTopLeft(Sender);
MouseX:=Message.Pos.X+SenderOrigin.X; MouseX:=Message.Pos.X+SenderOrigin.X;
MouseY:=Message.Pos.Y+SenderOrigin.Y; MouseY:=Message.Pos.Y+SenderOrigin.Y;
@ -457,13 +478,14 @@ Begin
dec(MouseX,MouseDownPos.X); dec(MouseX,MouseDownPos.X);
dec(MouseY,MouseDownPos.Y); dec(MouseY,MouseDownPos.Y);
{$IFDEF VerboseDesigner}
writeln('************************************************************'); writeln('************************************************************');
write('MouseLeftUpOnControl'); write('MouseLeftUpOnControl');
write(' ',Sender.Name,':',Sender.ClassName,' Origin=',SenderOrigin.X,',',SenderOrigin.Y); write(' ',Sender.Name,':',Sender.ClassName,' Origin=',SenderOrigin.X,',',SenderOrigin.Y);
write(' Msg=',Message.Pos.X,',',Message.Pos.Y); write(' Msg=',Message.Pos.X,',',Message.Pos.Y);
write(' Mouse=',MouseX,',',MouseY); write(' Mouse=',MouseX,',',MouseY);
writeln(''); writeln('');
{$ENDIF}
if Assigned(FOnGetSelectedComponentClass) then if Assigned(FOnGetSelectedComponentClass) then
FOnGetSelectedComponentClass(Self,SelectedCompClass) FOnGetSelectedComponentClass(Self,SelectedCompClass)
@ -537,7 +559,9 @@ Begin
if Assigned(FOnSetDesigning) then if Assigned(FOnSetDesigning) then
FOnSetDesigning(Self,FCustomForm,True); FOnSetDesigning(Self,FCustomForm,True);
Form.Invalidate; Form.Invalidate;
writeln('NEW COMPONENT ADDED: ',Form.ComponentCount,' ',NewCI.Control.Owner.Name); {$IFDEF VerboseDesigner}
writeln('NEW COMPONENT ADDED: ',Form.ComponentCount,' ',NewCI.Control.Owner.Name);
{$ENDIF}
end; end;
ControlSelection.EndUpdate; ControlSelection.EndUpdate;
end; end;
@ -547,7 +571,9 @@ writeln('NEW COMPONENT ADDED: ',Form.ComponentCount,' ',NewCI.Control.Owner.Nam
MouseDownComponent:=nil; MouseDownComponent:=nil;
MouseDownSender:=nil; MouseDownSender:=nil;
writeln('[TDesigner.MouseLeftUpOnControl] END'); {$IFDEF VerboseDesigner}
writeln('[TDesigner.MouseLeftUpOnControl] END');
{$ENDIF}
end; end;
Procedure TDesigner.MouseMoveOnControl(Sender : TControl; var Message : TLMMouse); Procedure TDesigner.MouseMoveOnControl(Sender : TControl; var Message : TLMMouse);
@ -558,98 +584,104 @@ var
MouseX, MouseY :integer; MouseX, MouseY :integer;
UpdateLastMove : Boolean; UpdateLastMove : Boolean;
begin begin
try try
UpdateLastMove := True; UpdateLastMove := True;
if FShowHints then begin if FShowHints then begin
FHintTimer.Enabled := False; FHintTimer.Enabled := False;
{ don't want it enabled when a mouse button is pressed. { don't want it enabled when a mouse button is pressed. }
} FHintTimer.Enabled :=
FHintTimer.Enabled := (Message.keys or (MK_LButton and MK_RButton and MK_MButton) = 0); (Message.keys or (MK_LButton and MK_RButton and MK_MButton) = 0);
if FHintWindow.Visible then if FHintWindow.Visible then
FHintWindow.Visible := False; FHintWindow.Visible := False;
end;
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; 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 MouseDownComponent=nil then exit;
if ControlSelection.ActiveGrabber<>nil then
begin SenderParentForm:=GetParentForm(Sender);
FHasSized:=true; if SenderParentForm=nil then exit;
ControlSelection.SizeSelection(MouseX-LastMouseMovePos.X, MouseY-LastMouseMovePos.Y);
//commented out by sxm 2001-11-21
// if Assigned(FOnPropertiesChanged) then SenderOrigin:=GetFormRelativeControlTopLeft(Sender);
// FOnPropertiesChanged(Self);
end MouseX:=Message.Pos.X+SenderOrigin.X;
else MouseY:=Message.Pos.Y+SenderOrigin.Y;
begin if (Mouse.CursorPos.X < SenderParentForm.Left)
if (not (MouseDownComponent is TCustomForm)) and (ControlSelection.Count>=1) or (Mouse.CursorPos.Y < SenderParentForm.Top)
and not (ControlSelection[0].Component is TCustomForm) then 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 begin
// move selection
FHasSized:=true; FHasSized:=true;
//TODO:create a rubberband looking control to move instead of the components ControlSelection.SizeSelection(MouseX-LastMouseMovePos.X,
//that will speed up to updates. MouseY-LastMouseMovePos.Y);
//commented out by sxm 2001-11-21
ControlSelection.MoveSelection(MouseX-LastMouseMovePos.X, MouseY-LastMouseMovePos.Y); // if Assigned(FOnPropertiesChanged) then
//commented out by sxm 2001-11-21 // FOnPropertiesChanged(Self);
// if Assigned(FOnPropertiesChanged) then
// FOnPropertiesChanged(Self);
end end
else else
begin begin
// rubberband selection/creation if (not (MouseDownComponent is TCustomForm))
ControlSelection.RubberBandBounds:=Rect(MouseDownPos.X,MouseDownPos.Y,MouseX,MouseY); and (ControlSelection.Count>=1)
ControlSelection.RubberBandActive:=true; and not (ControlSelection[0].Component is TCustomForm) then
SenderParentForm.Invalidate; begin
end; // move selection
FHasSized:=true;
//TODO:create a rubberband looking control to move instead of the components
//that will speed up to updates.
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; end;
end else begin
ControlSelection.ActiveGrabber:=nil; finally
end;
finally
SenderOrigin:=GetFormRelativeControlTopLeft(Sender); SenderOrigin:=GetFormRelativeControlTopLeft(Sender);
if UpdateLastMove then if UpdateLastMove then
LastMouseMovePos:=Point(MouseX,MouseY); LastMouseMovePos:=Point(MouseX,MouseY);
end; end;
end; end;
procedure TDesigner.MouseRightUpOnControl(Sender : TControl; Message:TLMMouse); procedure TDesigner.MouseRightUpOnControl(Sender : TControl; Message:TLMMouse);
@ -678,13 +710,14 @@ var
I : Integer; I : Integer;
Shift : TShiftState; Shift : TShiftState;
Begin Begin
Writeln('KEYDOWN'); {$IFDEF VerboseDesigner}
Writeln('TDesigner.KEYDOWN');
with MEssage do with MEssage do
Begin Begin
Writeln('CHARCODE = '+inttostr(charcode)); Writeln('CHARCODE = '+inttostr(charcode));
Writeln('KEYDATA = '+inttostr(KeyData)); Writeln('KEYDATA = '+inttostr(KeyData));
end; end;
{$ENDIF}
Shift := KeyDataToShiftState(Message.KeyData); Shift := KeyDataToShiftState(Message.KeyData);
@ -737,44 +770,36 @@ end;
{-----------------------------------------K E Y U P --------------------------------} {-----------------------------------------K E Y U P --------------------------------}
Procedure TDesigner.KeyUp(Sender : TControl; Message:TLMKEY); Procedure TDesigner.KeyUp(Sender : TControl; Message:TLMKEY);
Begin Begin
Writeln('KEYUp'); {$IFDEF VerboseDesigner}
Writeln('KEYUp');
with MEssage do with MEssage do
Begin Begin
Writeln('CHARCODE = '+inttostr(charcode)); Writeln('CHARCODE = '+inttostr(charcode));
Writeln('KEYDATA = '+inttostr(KeyData)); Writeln('KEYDATA = '+inttostr(KeyData));
end; end;
{$ENDIF}
end; end;
function TDesigner.IsDesignMsg(Sender: TControl; var Message: TLMessage): Boolean; function TDesigner.IsDesignMsg(Sender: TControl; var Message: TLMessage): Boolean;
Begin Begin
Result := false; Result := false;
if csDesigning in Sender.ComponentState then begin if csDesigning in Sender.ComponentState then begin
Result:=true;
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 case Message.Msg of
LM_PAINT: Result:=PaintControl(Sender,TLMPaint(Message)); LM_PAINT: Result:=PaintControl(Sender,TLMPaint(Message));
LM_KEYDOWN: KeyDown(Sender,TLMKey(Message)); LM_KEYDOWN: KeyDown(Sender,TLMKey(Message));
LM_KEYUP: KeyUP(Sender,TLMKey(Message)); LM_KEYUP: KeyUP(Sender,TLMKey(Message));
LM_LBUTTONDOWN,LM_RBUTTONDOWN: MouseDownOnControl(Sender,TLMMouse(Message)); LM_LBUTTONDOWN,
LM_LBUTTONUP: MouseLeftUpOnControl(Sender,TLMMouse(Message)); LM_RBUTTONDOWN: MouseDownOnControl(Sender,TLMMouse(Message));
LM_RBUTTONUP: MouseRightUpOnControl(sender,TLMMouse(Message)); LM_LBUTTONUP: MouseLeftUpOnControl(Sender,TLMMouse(Message));
LM_MOUSEMOVE: MouseMoveOnControl(Sender, TLMMouse(Message)); LM_RBUTTONUP: MouseRightUpOnControl(sender,TLMMouse(Message));
LM_MOUSEMOVE: MouseMoveOnControl(Sender, TLMMouse(Message));
LM_SIZE: Result:=SizeControl(Sender,TLMSize(Message)); LM_SIZE: Result:=SizeControl(Sender,TLMSize(Message));
LM_MOVE: Result:=MoveControl(Sender,TLMMove(Message)); LM_MOVE: Result:=MoveControl(Sender,TLMMove(Message));
LM_ACTIVATE : OnFormActivated; LM_ACTIVATE : OnFormActivated;
// CM_MOUSELEAVE: Writeln('MOUSELEAVE!!!!!!!!!!!!');//Result:=MoveControl(Sender,TLMMove(Message)); // CM_MOUSELEAVE: Writeln('MOUSELEAVE!!!!!!!!!!!!');//Result:=MoveControl(Sender,TLMMove(Message));
else
Result:=false;
end; end;
end; end;
end; end;
@ -789,7 +814,7 @@ procedure TDesigner.Notification(AComponent: TComponent; Operation: TOperation);
Begin Begin
if Operation = opInsert then if Operation = opInsert then
begin begin
Writeln('opInsert'); Writeln('opInsert');
end end
else else
if Operation = opRemove then if Operation = opRemove then
@ -863,6 +888,11 @@ Begin
Result := True; Result := True;
end; end;
function TDesigner.GetSnapToGrid: boolean;
begin
Result:=EnvironmentOptions.SnapToGrid;
end;
procedure TDesigner.SetDisplayGrid(const AValue: boolean); procedure TDesigner.SetDisplayGrid(const AValue: boolean);
begin begin
if DisplayGrid=AValue then exit; if DisplayGrid=AValue then exit;
@ -1122,7 +1152,8 @@ var AComponent : TComponent;
begin begin
if ControlSelection.Count = 1 then begin if ControlSelection.Count = 1 then begin
AComponent:= ControlSelection.Items[0].Component; AComponent:= ControlSelection.Items[0].Component;
if AComponent is TControl then TControl(AComponent).BringToFront; if AComponent is TControl then
TControl(AComponent).BringToFront;
end; end;
end; end;
@ -1131,7 +1162,8 @@ var AComponent : TComponent;
begin begin
if ControlSelection.Count = 1 then begin if ControlSelection.Count = 1 then begin
AComponent:= ControlSelection.Items[0].Component; AComponent:= ControlSelection.Items[0].Component;
if AComponent is TControl then TControl(AComponent).SendToBack; if AComponent is TControl then
TControl(AComponent).SendToBack;
end; end;
end; end;
@ -1181,6 +1213,12 @@ begin
FHintWindow.ActivateHint(Rect,AHint); FHintWindow.ActivateHint(Rect,AHint);
end; end;
procedure TDesigner.SetSnapToGrid(const AValue: boolean);
begin
if SnapToGrid=AValue then exit;
EnvironmentOptions.SnapToGrid:=AValue;
end;
Procedure TDesigner.OnFormActivated; Procedure TDesigner.OnFormActivated;
begin begin
//the form was activated. //the form was activated.
@ -1189,6 +1227,5 @@ begin
end; end;
end. end.

8
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -4354,9 +4354,10 @@ begin
{} {}
if (Handle <> 0) then if (Handle <> 0) then
begin begin
if gtk_type_is_a(gtk_object_type(PGTKObject(Handle)), gtk_scrolled_window_get_type) then if gtk_type_is_a(gtk_object_type(PGTKObject(Handle)),
gtk_scrolled_window_get_type) then
begin begin
if SBStyle in [SB_BOTH, SB_HORZ] if SBStyle in [SB_BOTH, SB_HORZ]
then gtk_object_set(PGTKObject(Handle), 'hscrollbar_policy', [POLICY[bRedraw], nil]); then gtk_object_set(PGTKObject(Handle), 'hscrollbar_policy', [POLICY[bRedraw], nil]);
if SBStyle in [SB_BOTH, SB_VERT] if SBStyle in [SB_BOTH, SB_VERT]
then gtk_object_set(PGTKObject(Handle), 'vscrollbar_policy', [POLICY[bRedraw], nil]); then gtk_object_set(PGTKObject(Handle), 'vscrollbar_policy', [POLICY[bRedraw], nil]);
@ -4780,6 +4781,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.78 2002/06/12 12:35:44 lazarus
MG: fixed apiwidget warnings/criticals
Revision 1.77 2002/06/11 13:41:11 lazarus Revision 1.77 2002/06/11 13:41:11 lazarus
MG: fixed mouse coords and fixed mouse clicked thru bug MG: fixed mouse coords and fixed mouse clicked thru bug