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

MG: Bugfixes + changed ide closing

Browse Source 
git-svn-id: trunk@233 -
This commit is contained in:
lazarus 2001-03-21 14:26:00 +00:00
parent 6a9c20a154
commit 7d3a2d32ad
6 changed files with 61 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
designer/designer.pp
View File

@ -133,7 +133,7 @@ end;
destructor TDesigner.Destroy;
Begin
Inherited;
Inherited Destroy;
end;
Procedure TDesigner.RemoveControl(Control : TComponent);
@ -188,7 +188,8 @@ begin
Result:=true;
Sender.Dispatch(Message);
if (ControlSelection.IsSelected(Sender)) then begin
//writeln('*** LM_Size ',Sender.Name,':',Sender.ClassName);
// writeln('*** LM_Size ',Sender.Name,':',Sender.ClassName,' Type=',Message.SizeType
// ,' ',Message.Width,',',Message.Height);
ControlSelection.AdjustSize;
if Assigned(FOnPropertiesChanged) then
FOnPropertiesChanged(Self);

16
ide/customformeditor.pp
View File

@ -536,17 +536,13 @@ Begin
Temp := TComponentInterface(FindComponent(Value));
if Temp <> nil then
begin
Writeln('1');
RemoveFromComponentInterfaceList(Temp);
Writeln('2');
if (Value is TCustomForm) then
begin
JITFormList.DestroyJITFOrm(TForm(Value));
Temp.Destroy;
end
else
Temp.Delete;
Writeln('3');
if (Value is TCustomForm) then begin
JITFormList.DestroyJITFOrm(TForm(Value));
Temp.Destroy;
end
else
Temp.Delete;
end;
end;

51
ide/main.pp
View File

@ -118,6 +118,11 @@ type
Label2 : TLabel;
// event handlers
procedure FormShow(Sender : TObject);
procedure FormClose(Sender : TObject; var Action: TCloseAction);
procedure FormCloseQuery(Sender : TObject; var CanClose: boolean);
procedure FormPaint(Sender : TObject);
procedure mnuNewUnitClicked(Sender : TObject);
procedure mnuNewFormClicked(Sender : TObject);
procedure mnuSaveClicked(Sender : TObject);
@ -182,7 +187,6 @@ type
Procedure SetDefaultsForForm(aForm : TCustomForm);
protected
procedure FormShow(Sender : TObject);
procedure ToolButtonClick(Sender : TObject);
// Procedure Paint; override;
@ -233,9 +237,7 @@ type
function DoJumpToCompilerMessage(Index:integer): boolean;
procedure LoadMainMenu;
Procedure FormKill(Sender : TObject);
Procedure SetDesigning(Control : TComponent; Value : Boolean);
procedure FormPaint(Sender : TObject);
procedure LoadFormFromFile(Value : String);
// form editor and designer
@ -564,7 +566,9 @@ begin
Name := 'RunSpeedBtn';
end;
Self.OnShow := @FormShow;
OnShow := @FormShow;
OnClose := @FormClose;
OnCloseQuery := @FormCloseQuery;
// create compiler interface
Compiler1 := TCompiler.Create;
@ -635,8 +639,11 @@ begin
Project.Free;
Project:=nil;
end;
TheControlSelection.OnChange:=nil;
TheControlSelection.Free;
TheControlSelection:=nil;
FormEditor1.Free;
FormEditor1:=nil;
PropertyEditorHook1.Free;
Compiler1.Free;
MacroList.Free;
@ -688,9 +695,22 @@ Begin
end;
procedure TMainIDE.FormKill(Sender : TObject);
procedure TMainIDE.FormClose(Sender : TObject; var Action: TCloseAction);
begin
if TheControlSelection<>nil then TheControlSelection.Clear;
end;
procedure TMainIDE.FormCloseQuery(Sender : TObject; var CanClose: boolean);
Begin
Assert(False, 'Trace:DESTROYING FORM');
CanClose:=true;
if SomethingOfProjectIsModified then begin
if Application.MessageBox('Save changes to project?','Project changed',
MB_OKCANCEL)=mrOk then begin
CanClose:=DoSaveProject(false)<>mrAbort;
if CanClose=false then exit;
end;
end;
CanClose:=(DoCloseProject<>mrAbort);
End;
{------------------------------------------------------------------------------}
@ -1336,17 +1356,11 @@ end;
{------------------------------------------------------------------------------}
procedure TMainIDE.mnuQuitClicked(Sender : TObject);
var CanClose: boolean;
begin
if SomethingOfProjectIsModified then begin
if Application.MessageBox('Save changes to project?','Project changed',
MB_OKCANCEL)=mrOk then begin
if DoSaveProject(false)=mrAbort then exit;
if DoCloseProject=mrAbort then exit;
end;
end;
Project.Free;
Project:=nil;
Close;
CanClose:=true;
OnCloseQuery(Sender, CanClose);
if CanClose then Close;
end;
{------------------------------------------------------------------------------}
@ -1860,6 +1874,7 @@ writeln('TMainIDE.DoCloseEditorUnit 1');
end;
// close form
if ActiveUnitInfo.Form<>nil then begin
TheControlSelection.Remove(TControl(ActiveUnitInfo.Form));
OldDesigner:=TDesigner(TCustomForm(ActiveUnitInfo.Form).Designer);
FormEditor1.DeleteControl(ActiveUnitInfo.Form);
OldDesigner.Free;
@ -2934,8 +2949,8 @@ end.
{ =============================================================================
$Log$
Revision 1.77 2001/03/21 00:20:28 lazarus
MG: fixed memory leaks
Revision 1.78 2001/03/21 14:25:59 lazarus
MG: Bugfixes + changed ide closing
Revision 1.75 2001/03/19 14:00:46 lazarus
MG: fixed many unreleased DC and GDIObj bugs

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

@ -76,8 +76,8 @@ begin
HashItem:=FGDIObjects.FirstHashItem;
for GDIType := Low(GDIType) to High(GDIType) do
GDITypeCount[GDIType] := 0;
while (n<7) and (HashItem<>nil) do begin
write(' ',HexStr(Cardinal(HashItem^.Item),8));
while (HashItem<>nil) do begin
if n<7 then write(' ',HexStr(Cardinal(HashItem^.Item),8));
Inc(GDITypeCount[PGdiObject(HashItem^.Item)^.GDIType]);
HashItem:=HashItem^.Next;
inc(n);
@ -2757,8 +2757,8 @@ end;
{ =============================================================================
$Log$
Revision 1.37 2001/03/21 00:20:29 lazarus
MG: fixed memory leaks
Revision 1.38 2001/03/21 14:26:00 lazarus
MG: Bugfixes + changed ide closing
Revision 1.36 2001/03/19 18:51:57 lazarus
MG: added dynhasharray and renamed tsynautocompletion

7
lcl/interfaces/gtk/gtkproc.inc
View File

@ -465,9 +465,11 @@ begin
// Logging
if Target = nil
then Assert(False, 'Trace:[DeliverMessage] nil')
else Assert(False, Format('Trace:[DeliverMessage] %s --> %d', [TObject(Target).ClassName, TLMessage(Message).msg]));
else Assert(False, Format('Trace:[DeliverMessage] %s --> %d'
, [TObject(Target).ClassName, TLMessage(Message).msg]));
*)
// Assert(False, 'Trace:Delivering message');
if Target=nil then writeln('[DeliverMessage] nil');
if TObject(Target) is TControl
then begin
// Assert(False, 'Trace:Calling TControl');
@ -723,6 +725,9 @@ end;
{ =============================================================================
$Log$
Revision 1.13 2001/03/21 14:26:00 lazarus
MG: Bugfixes + changed ide closing
Revision 1.12 2001/03/19 14:44:22 lazarus
MG: fixed many unreleased DC and GDIObj bugs

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

@ -306,7 +306,7 @@ begin
end;
Result := HBITMAP(GdiObject);
writeln('[TgtkObject.CreateBitmap] ',HexStr(Result,8));
//writeln('[TgtkObject.CreateBitmap] ',HexStr(Result,8));
Assert(False, Format('Trace:< [TgtkObject.CreateBitmap] --> 0x%x', [Integer(Result)]));
end;
@ -2818,16 +2818,20 @@ end;
The function calls the window procedure for the specified window and does
not return until the window procedure has processed the message.
------------------------------------------------------------------------------}
function TGTKObject.SendMessage(hWnd: HWND; Msg: Cardinal; wParam: LongInt; lParam: LongInt): Integer;
function TGTKObject.SendMessage(hWnd: HWND; Msg: Cardinal; wParam: LongInt;
lParam: LongInt): Integer;
var
Message: TLMessage;
Target: TObject;
begin
Message.Msg := Msg;
Message.WParam := WParam;
Message.LParam := LParam;
Message.Result := 0;
Result := DeliverMessage(GetLCLObject(Pointer(hWnd)), Message);
Target := GetLCLObject(Pointer(hWnd));
if Target<>nil then
Result := DeliverMessage(Target, Message);
end;
{------------------------------------------------------------------------------
@ -3419,8 +3423,8 @@ end;
{ =============================================================================
$Log$
Revision 1.28 2001/03/21 00:20:29 lazarus
MG: fixed memory leaks
Revision 1.29 2001/03/21 14:26:00 lazarus
MG: Bugfixes + changed ide closing
Revision 1.26 2001/03/19 18:51:57 lazarus
MG: added dynhasharray and renamed tsynautocompletion