diff options
author | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2008-01-21 11:18:44 +0000 |
---|---|---|
committer | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2008-01-21 11:18:44 +0000 |
commit | 8d23789d877af358edb1aeca75e42e6953f0179f (patch) | |
tree | 9a4c6e10c001b782d38b63446f02e4073f2f9e33 | |
parent | aa2a6e1dac26b8813891b23f14dccbc476329fec (diff) | |
download | fpGUI-8d23789d877af358edb1aeca75e42e6953f0179f.tar.xz |
* Fixed some memory leaks in TfpgComboBox.
* Fixed the destruction order of TfpgComboBox.
* Introduced DoRemoveWindowLookup() in gfxbase.pas so that we
can offload some of the responsibility from DoReleaseWindowHandle()
* Add two new debug methods to help debug fpGUI and fpGUI based
applications. They are PrintCallTrace() and PrintCallTraceDbgln().
* Fixed 'Index out of bounds' error when quiting your application.
* I included lots of debug output in this revision, so I can test
under Windows. As soon as I confirmed everything works, I'll
remove the debug output again.
-rw-r--r-- | src/corelib/fpgfx.pas | 57 | ||||
-rw-r--r-- | src/corelib/gdi/gfx_gdi.pas | 8 | ||||
-rw-r--r-- | src/corelib/gfx_popupwindow.pas | 20 | ||||
-rw-r--r-- | src/corelib/gfx_widget.pas | 7 | ||||
-rw-r--r-- | src/corelib/gfxbase.pas | 2 | ||||
-rw-r--r-- | src/corelib/x11/gfx_x11.pas | 30 | ||||
-rw-r--r-- | src/gui/fpgui_package.lpk | 13 | ||||
-rw-r--r-- | src/gui/gui_combobox.pas | 73 | ||||
-rw-r--r-- | src/gui/gui_form.pas | 9 | ||||
-rw-r--r-- | src/gui/gui_gauge.pas | 12 | ||||
-rw-r--r-- | src/gui/gui_listbox.pas | 12 | ||||
-rw-r--r-- | src/gui/gui_listview.pas | 3 |
12 files changed, 193 insertions, 53 deletions
diff --git a/src/corelib/fpgfx.pas b/src/corelib/fpgfx.pas index 6d770c69..497ecd39 100644 --- a/src/corelib/fpgfx.pas +++ b/src/corelib/fpgfx.pas @@ -290,6 +290,8 @@ function fpgRect(ALeft, ATop, AWidth, AHeight: integer): TfpgRect; procedure PrintRect(var Rect: TRect); procedure PrintRect(var Rect: TfpgRect); procedure PrintCoord(const x, y: TfpgCoord); +function PrintCallTrace(const AClassName, AMethodName: string): IInterface; +procedure PrintCallTraceDbgLn(const AMessage: string); procedure DumpStack; @@ -477,6 +479,58 @@ begin writeln('x=', x, ' y=', y); end; +var + iCallTrace: integer; + +type + TPrintCallTrace = class(TInterfacedObject) + private + FClassName: string; + FMethodName: string; + spacing: string; + public + constructor Create(const AClassName, AMethodName: string); + destructor Destroy; override; + end; + +{ TPrintCallTrace } + +constructor TPrintCallTrace.Create(const AClassname, AMethodName: string); +var + i: integer; +begin + inherited Create; + spacing := ''; + inc(iCallTrace); + for i := 0 to iCallTrace do + spacing := spacing + ' '; + FClassName := AClassName; + FMethodName := AMethodName; + Writeln(Format('%s>> %s.%s', [spacing, FClassName, FMethodName])); +end; + +destructor TPrintCallTrace.Destroy; +begin + Writeln(Format('%s<< %s.%s', [spacing, FClassName, FMethodName])); + dec(iCallTrace); + inherited Destroy; +end; + +function PrintCallTrace(const AClassName, AMethodName: string): IInterface; +begin + Result := TPrintCallTrace.Create(AClassName, AMethodName); +end; + +procedure PrintCallTraceDbgLn(const AMessage: string); +var + i: integer; + s: string; +begin + for i := 0 to iCallTrace+1 do + s := s + ' '; + writeln(s + AMessage); +end; + procedure DumpStack; begin writeln(' Stack trace:'); @@ -1357,10 +1411,11 @@ initialization fpgTimers := nil; fpgCaret := nil; fpgImages := nil; + iCallTrace := -1; fpgInitMsgQueue; finalization; - uApplication.free; + uApplication.Free; end. diff --git a/src/corelib/gdi/gfx_gdi.pas b/src/corelib/gdi/gfx_gdi.pas index 4892c8bc..bb89c8d2 100644 --- a/src/corelib/gdi/gfx_gdi.pas +++ b/src/corelib/gdi/gfx_gdi.pas @@ -132,6 +132,7 @@ type FParentWinHandle: TfpgWinHandle; procedure DoAllocateWindowHandle(AParent: TfpgWindowBase); override; procedure DoReleaseWindowHandle; override; + procedure DoRemoveWindowLookup; override; procedure DoSetWindowVisible(const AValue: Boolean); override; function HandleIsValid: boolean; override; procedure DoUpdateWindowPosition(aleft, atop, awidth, aheight: TfpgCoord); override; @@ -429,7 +430,7 @@ begin if not Assigned(w) then begin - {$IFDEF DEBUG} writeln('Unable to detect Windows - using DefWindowProc'); {$ENDIF} + {$IFDEF DEBUG} writeln('fpGFX/GDI: Unable to detect Window - using DefWindowProc'); {$ENDIF} Result := Windows.DefWindowProc(hwnd, uMsg, wParam, lParam); Exit; //==> end; @@ -1046,6 +1047,11 @@ begin FWinHandle := 0; end; +procedure TfpgWindowImpl.DoRemoveWindowLookup; +begin + // Nothing to do here +end; + procedure TfpgWindowImpl.DoSetWindowVisible(const AValue: Boolean); var r: TRect; diff --git a/src/corelib/gfx_popupwindow.pas b/src/corelib/gfx_popupwindow.pas index 3c7c9c44..5dafb5fd 100644 --- a/src/corelib/gfx_popupwindow.pas +++ b/src/corelib/gfx_popupwindow.pas @@ -1,7 +1,27 @@ +{ + fpGUI - Free Pascal GUI Library + + Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + Description: + Defines a PopupWindow control. It gets used for things like PopupMenu, + ComboBox and Calendar controls. +} + unit gfx_popupwindow; {$mode objfpc}{$H+} +{.$Define DEBUG} + interface uses diff --git a/src/corelib/gfx_widget.pas b/src/corelib/gfx_widget.pas index 7ee14ca9..6f2d0f78 100644 --- a/src/corelib/gfx_widget.pas +++ b/src/corelib/gfx_widget.pas @@ -132,6 +132,7 @@ uses { Double click support } const DOUBLECLICK_MS = 320; // the max time between left-clicks for doubleclick + var uLastClickWidget: TfpgWidget; uLastClickTime: DWord; @@ -176,7 +177,6 @@ end; procedure TfpgWidget.SetVisible(const AValue: boolean); begin -// Writeln(Classname, ' TfpgWidget.SetVisible AValue = ', AValue); if FVisible = AValue then Exit; //==> FVisible := AValue; @@ -202,7 +202,7 @@ end; constructor TfpgWidget.Create(AOwner: TComponent); begin - { TODO -oGraeme -cRelease Blocker : ComponentState is read-only. I'm + { TODO: -oGraeme -cRelease_Blocker ComponentState is read-only. I'm exploiting a FPC <= 2.2.0 bug. I need to fix this! } Include(ComponentState, csLoading); FOnScreen := False; @@ -517,7 +517,8 @@ begin end; FOnScreen := False; - ReleaseWindowHandle; + if HasHandle then + ReleaseWindowHandle; end; procedure TfpgWidget.RePaint; diff --git a/src/corelib/gfxbase.pas b/src/corelib/gfxbase.pas index 07b8fe7b..ebd20e99 100644 --- a/src/corelib/gfxbase.pas +++ b/src/corelib/gfxbase.pas @@ -326,6 +326,7 @@ type procedure DoUpdateWindowPosition(aleft, atop, awidth, aheight: TfpgCoord); virtual; abstract; procedure DoAllocateWindowHandle(AParent: TfpgWindowBase); virtual; abstract; procedure DoReleaseWindowHandle; virtual; abstract; + procedure DoRemoveWindowLookup; virtual; abstract; procedure DoSetWindowVisible(const AValue: Boolean); virtual; abstract; procedure DoMoveWindow(const x: TfpgCoord; const y: TfpgCoord); virtual; abstract; function DoWindowToScreen(ASource: TfpgWindowBase; const AScreenPos: TPoint): TPoint; virtual; abstract; @@ -787,6 +788,7 @@ begin Canvas.FreeResources; DoReleaseWindowHandle; end; + DoRemoveWindowLookup; end; procedure TfpgWindowBase.SetWindowTitle(const ATitle: string); diff --git a/src/corelib/x11/gfx_x11.pas b/src/corelib/x11/gfx_x11.pas index a7b37812..a8cbe44a 100644 --- a/src/corelib/x11/gfx_x11.pas +++ b/src/corelib/x11/gfx_x11.pas @@ -134,6 +134,7 @@ type FModalForWin: TfpgWindowImpl; procedure DoAllocateWindowHandle(AParent: TfpgWindowBase); override; procedure DoReleaseWindowHandle; override; + procedure DoRemoveWindowLookup; override; procedure DoSetWindowVisible(const AValue: Boolean); override; function HandleIsValid: boolean; override; procedure DoSetWindowTitle(const ATitle: string); override; @@ -734,8 +735,10 @@ begin Popup := PopupListFirst; -// WriteLn('Event ',GetXEventName(ev._type),': ', ev._type,' window: ', ev.xany.window); + {$IFDEF DEBUG} + WriteLn('Event ',GetXEventName(ev._type),': ', ev._type,' window: ', ev.xany.window); // PrintKeyEvent(ev); { debug purposes only } + {$ENDIF} case ev._type of X.KeyPress, @@ -1182,17 +1185,30 @@ begin end; procedure TfpgWindowImpl.DoReleaseWindowHandle; +var + lCallTrace: IInterface; begin - if FWinHandle <= 0 then - Exit; - - XDestroyWindow(xapplication.Display, FWinHandle); - // RemoveWindowLookup is now deferred to DestroyNotify event. -// RemoveWindowLookup(self); + lCallTrace := PrintCallTrace(Classname, 'DoReleaseWindowHandle: ' + Name); + if HandleIsValid then + begin + PrintCallTraceDbgLn('XDestroyWindow'); + XDestroyWindow(xapplication.Display, FWinHandle); + end + else + begin + PrintCallTraceDbgLn(' RemoveWindowLookup'); + RemoveWindowLookup(self); + end; FWinHandle := 0; end; +procedure TfpgWindowImpl.DoRemoveWindowLookup; +begin + PrintCallTraceDbgLn('RemoveWindowLookup ' + Name + ' [' + Classname + ']'); + RemoveWindowLookup(self); +end; + procedure TfpgWindowImpl.DoSetWindowVisible(const AValue: Boolean); begin if AValue then diff --git a/src/gui/fpgui_package.lpk b/src/gui/fpgui_package.lpk index a9716935..54ded6b2 100644 --- a/src/gui/fpgui_package.lpk +++ b/src/gui/fpgui_package.lpk @@ -17,6 +17,11 @@ <CodeGeneration> <Generate Value="Faster"/> </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="True"/> + </Debugging> + </Linking> <Other> <CompilerPath Value="$(CompPath)"/> </Other> @@ -143,12 +148,12 @@ <LazDoc Paths="../../docs/xml/gui/"/> <RequiredPkgs Count="2"> <Item1> - <PackageName Value="FCL"/> - <MinVersion Major="1" Valid="True"/> - </Item1> - <Item2> <PackageName Value="fpgfx_package"/> <MinVersion Minor="5" Valid="True"/> + </Item1> + <Item2> + <PackageName Value="FCL"/> + <MinVersion Major="1" Valid="True"/> </Item2> </RequiredPkgs> <UsageOptions> diff --git a/src/gui/gui_combobox.pas b/src/gui/gui_combobox.pas index 0c9b4282..cfe2c966 100644 --- a/src/gui/gui_combobox.pas +++ b/src/gui/gui_combobox.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Library - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -19,6 +19,8 @@ unit gui_combobox; {$mode objfpc}{$H+} +{.$Define DEBUG} + { TODO: When combobox Items changes, the combobox needs to refresh. We need a custom StringItems class to notify us of changes. See TfpgListBox for an example. } @@ -56,6 +58,7 @@ type procedure SetFocusItem(const AValue: integer); procedure SetFontDesc(const AValue: string); procedure CalculateInternalButtonRect; + procedure MsgPopupClose(var msg: TfpgMessageRec); message FPGM_POPUPCLOSE; protected FMargin: integer; FBtnPressed: Boolean; @@ -114,7 +117,6 @@ var OriginalFocusRoot: TfpgWidget; type - { This is the class representing the dropdown window of the combo box. } TDropDownWindow = class(TfpgPopupWindow) private @@ -131,12 +133,13 @@ type property CallerWidget: TfpgWidget read FCallerWidget write FCallerWidget; end; + { TDropDownWindow } procedure TDropDownWindow.HandlePaint; begin Canvas.BeginDraw; - inherited HandlePaint; +// inherited HandlePaint; Canvas.Clear(clWhite); Canvas.EndDraw; end; @@ -186,8 +189,10 @@ begin end; destructor TDropDownWindow.Destroy; +var + tmp: IInterface; begin - ListBox.Free; + tmp := PrintCallTrace(ClassName, 'Destroy'); inherited Destroy; end; @@ -228,6 +233,7 @@ end; function TfpgAbstractComboBox.GetText: string; begin + PrintCallTraceDbgLn('FocusItem = ' + IntToStr(FocusItem)); if (FocusItem > 0) and (FocusItem <= FItems.Count) then Result := FItems.Strings[FocusItem-1] else @@ -241,15 +247,19 @@ end; procedure TfpgAbstractComboBox.DoDropDown; var + tmp: IInterface; ddw: TDropDownWindow; rowcount: integer; begin + tmp := PrintCallTrace(Classname, 'DoDropDown'); if (not Assigned(FDropDown)) or (not FDropDown.HasHandle) then begin + PrintCallTraceDbgLn('DoDropDown - Part 1'); + FreeAndNil(FDropDown); OriginalFocusRoot := FocusRootWidget; - FDropDown := TDropDownWindow.Create(nil); - ddw := TDropDownWindow(FDropDown); - ddw.Width := Width; + FDropDown := TDropDownWindow.Create(nil); + ddw := TDropDownWindow(FDropDown); + ddw.Width := Width; // adjust the height of the dropdown rowcount := FItems.Count; if rowcount > FDropDownCount then @@ -264,15 +274,16 @@ begin ddw.ListBox.Items.Assign(FItems); ddw.ListBox.FocusItem := FFocusItem; - FDropDown.ShowAt(Parent, Left, Top+Height); - FDropDown.DontCloseWidget := self; // now we can control when the popup window closes -// FDropDown.ActiveWidget := ddw.ListBox; +// ddw.DontCloseWidget := self; // now we can control when the popup window closes + ddw.ShowAt(Parent, Left, Top+Height); ddw.ListBox.SetFocus; end else begin + PrintCallTraceDbgLn('DoDropDown - Part 2'); FBtnPressed := False; - FDropDown.Close; + ddw := TDropDownWindow(FDropDown); + ddw.Close; FreeAndNil(FDropDown); end; end; @@ -285,13 +296,16 @@ end; procedure TfpgAbstractComboBox.InternalListBoxSelect(Sender: TObject); var msgp: TfpgMessageParams; + tmp: IInterface; begin + tmp := PrintCallTrace(ClassName, 'InternalListBoxSelect'); FFocusItem := TDropDownWindow(FDropDown).ListBox.FocusItem; { Don't use .Close because this method is called by FDropDown.ListBox and - causes issues if it's freed to quickly. } -// FDropDown.Close; - fpgSendMessage(self, FDropDown, FPGM_CLOSE, msgp); + causes issues if it's freed to quickly. We can't destroy the ListBox while + it's still executing it's event handler - instead we send a message to self. } + FDropDown.Close; +// fpgSendMessage(self, self, FPGM_POPUPCLOSE, msgp); // request to close the dropdown. if HasHandle then Repaint; @@ -357,6 +371,14 @@ begin FInternalBtnRect.SetRect(Width - Min(Height, 20), 2, Min(Height, 20)-2, Height-4); end; +procedure TfpgAbstractComboBox.MsgPopupClose(var msg: TfpgMessageRec); +var + tmp: IInterface; +begin + tmp := PrintCallTrace(Classname, 'MsgPopupClose'); + DoDropDown; +end; + procedure TfpgAbstractComboBox.SetHeight(const AValue: TfpgCoord); begin inherited; @@ -365,10 +387,10 @@ begin end; procedure TfpgAbstractComboBox.HandleLMouseDown(x, y: integer; shiftstate: TShiftState); +var + tmp: IInterface; begin - {$IFDEF DEBUG} - writeln('TfpgAbstractComboBox.HandleLMouseDown [', Classname, ']'); - {$ENDIF} + tmp := PrintCallTrace(Classname, 'HandleLMouseDown'); inherited HandleLMouseDown(x, y, shiftstate); // button state is down only if user clicked in the button rectangle. if PtInRect(FInternalBtnRect, Point(x, y)) then @@ -377,10 +399,10 @@ begin end; procedure TfpgAbstractComboBox.HandleLMouseUp(x, y: integer; shiftstate: TShiftState); +var + tmp: IInterface; begin - {$IFDEF DEBUG} - writeln('TfpgAbstractComboBox.HandleLMouseUp [', Classname, ']'); - {$ENDIF} + tmp := PrintCallTrace(Classname, 'HandleLMouseUp'); inherited HandleLMouseUp(x, y, shiftstate); FBtnPressed := False; DoDropDown; @@ -495,11 +517,12 @@ begin end; destructor TfpgAbstractComboBox.Destroy; +var + tmp: IInterface; begin - { Todo: Double check FDropDown.Free call, because we are closing FDropDown - via a fpgSendMessage call. This needs improving. } - if Assigned(FDropDown) and (FDropDown.HasHandle) then - FDropDown.Free; + tmp := PrintCallTrace(ClassName, 'Destroy'); + FDropDown.Free; + PrintCallTraceDbgLn('**** Freeing off the ComboBox items'); FItems.Free; FFont.Free; inherited Destroy; @@ -507,7 +530,7 @@ end; procedure TfpgAbstractComboBox.Update; begin - FFocusItem := 1; + FFocusItem := 0; Repaint; end; diff --git a/src/gui/gui_form.pas b/src/gui/gui_form.pas index bf2ae6bc..0828c927 100644 --- a/src/gui/gui_form.pas +++ b/src/gui/gui_form.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Library - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -244,10 +244,13 @@ begin end; procedure TfpgForm.MsgClose(var msg: TfpgMessageRec); +var + tmp: IInterface; begin - HandleClose; + tmp := PrintCallTrace(Classname, 'MsgClose'); if Assigned(FOnClose) then FOnClose(self); + HandleClose; end; procedure TfpgForm.HandleClose; @@ -257,9 +260,9 @@ end; procedure TfpgForm.HandleHide; begin - inherited HandleHide; if Assigned(FOnHide) then FOnHide(self); + inherited HandleHide; end; procedure TfpgForm.HandleShow; diff --git a/src/gui/gui_gauge.pas b/src/gui/gui_gauge.pas index 3d0317c8..52ac9df3 100644 --- a/src/gui/gui_gauge.pas +++ b/src/gui/gui_gauge.pas @@ -45,7 +45,7 @@ type FPosition: Longint; FKind: TGaugeKind; FShowText: Boolean; - {TODO _ Implement Border style } + { TODO: Implement Border style } FBorderStyle: TBorderStyle; FColor: TfpgColor; // Background color { Currently little used colors, should be derived from style and possibly @@ -53,7 +53,7 @@ type or give pair? } FFirstColor: TfpgColor; // Text and Needle color FSecondColor: TfpgColor; // Bar, Pie etc. main color - { Currently unused - TODO - Implement Low Watermark and High Watermark } + { TODO: Currently unused. Implement Low Watermark and High Watermark } FLWMColor: TfpgColor; // Low Watermark Color FLWMValue: Longint; // Low Watermark Value FHWMColor: TfpgColor; // High Watermark Color @@ -448,7 +448,7 @@ begin if AValue <> FBorderStyle then begin FBorderStyle := AValue; - {TODO - Implement Border style } + { TODO: Implement Border style } // Graeme: Wouldn't descending from TfpgBevel give you this functionality already? // It could be a option. //RePaint; @@ -460,7 +460,7 @@ begin if AValue <> FFirstColor then begin FFirstColor := AValue; - {TODO - allow user colors} + { TODO: allow user colors} //RePaint; end; end; @@ -470,7 +470,7 @@ begin if AValue <> FSecondColor then begin FSecondColor := AValue; - {TODO - allow user colors} + { TODO: allow user colors} //RePaint; end; end; @@ -525,7 +525,7 @@ begin FPosition := AValue; if CurrPercentage <> Percentage then // Visible value has changed MustRepaint := True; - { TODO Check against low and high watermarks } + { TODO: Check against low and high watermarks } end; if MustRepaint then RePaint; diff --git a/src/gui/gui_listbox.pas b/src/gui/gui_listbox.pas index a7c7e740..4e2a2f39 100644 --- a/src/gui/gui_listbox.pas +++ b/src/gui/gui_listbox.pas @@ -388,7 +388,10 @@ begin end; procedure TfpgBaseListBox.HandleLMouseDown(x, y: integer; shiftstate: TShiftState); +var + tmp: IInterface; begin + tmp := PrintCallTrace(ClassName, 'HandleLMouseDown'); inherited HandleLMouseDown(x, y, shiftstate); if ItemCount < 1 then @@ -593,7 +596,7 @@ begin FScrollBar := TfpgScrollBar.Create(self); FScrollBar.OnScroll := @ScrollBarMove; - FScrollBar.Visible := False; +// FScrollBar.Visible := False; FFocusable := True; FFocusItem := 1; @@ -659,7 +662,11 @@ begin end; destructor TfpgTextListBox.Destroy; +var + tmp: IInterface; begin + tmp := PrintCallTrace(ClassName, 'Destroy'); + PrintCallTraceDbgLn('**** Freeing off the listbox items'); TfpgListBoxStrings(FItems).Free; inherited Destroy; end; @@ -670,7 +677,10 @@ begin end; function TfpgTextListBox.Text: string; +var + tmp: IInterface; begin + tmp := PrintCallTrace(Classname, 'Text'); if (FocusItem > 0) and (FocusItem <= FItems.Count) then result := FItems.Strings[FocusItem-1] else diff --git a/src/gui/gui_listview.pas b/src/gui/gui_listview.pas index a3eaba43..0a2ff4f8 100644 --- a/src/gui/gui_listview.pas +++ b/src/gui/gui_listview.pas @@ -572,7 +572,6 @@ procedure TfpgListView.ItemChanged(AIndex: Integer); begin if FUpdateCount = 0 then DoRePaint; - // TODO end; procedure TfpgListView.ItemsUpdated; @@ -1374,7 +1373,7 @@ begin if lvppIcon in PaintPart then begin - // TODO paint icon + { TODO: paint icon } end; if lvppFocused in PaintPart then |