diff options
-rw-r--r-- | examples/gui/command_interface/commands.pas | 1 | ||||
-rw-r--r-- | prototypes/fpgui2/tests/themetest.lpi | 3 | ||||
-rw-r--r-- | src/corelib/fpgfx.pas | 85 | ||||
-rw-r--r-- | src/corelib/gfx_command_intf.pas | 1 | ||||
-rw-r--r-- | src/corelib/gfx_msgqueue.inc | 5 |
5 files changed, 68 insertions, 27 deletions
diff --git a/examples/gui/command_interface/commands.pas b/examples/gui/command_interface/commands.pas index 2824a04d..aa948220 100644 --- a/examples/gui/command_interface/commands.pas +++ b/examples/gui/command_interface/commands.pas @@ -5,7 +5,6 @@ unit commands; {$mode objfpc}{$H+} -{$INTERFACES CORBA} interface diff --git a/prototypes/fpgui2/tests/themetest.lpi b/prototypes/fpgui2/tests/themetest.lpi index b0826d88..ccc40a37 100644 --- a/prototypes/fpgui2/tests/themetest.lpi +++ b/prototypes/fpgui2/tests/themetest.lpi @@ -46,7 +46,8 @@ <Generate Value="Faster"/> </CodeGeneration> <Other> - <CustomOptions Value="-FUunits"/> + <CustomOptions Value="-FUunits +"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/src/corelib/fpgfx.pas b/src/corelib/fpgfx.pas index b002d217..d86897fa 100644 --- a/src/corelib/fpgfx.pas +++ b/src/corelib/fpgfx.pas @@ -165,6 +165,7 @@ type MenuDisabledFont: TfpgFont; public constructor Create; virtual; + destructor Destroy; override; procedure DrawButtonFace(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; AFlags: TFButtonFlags); virtual; procedure DrawControlFrame(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord); virtual; procedure DrawDirectionArrow(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; direction: integer); virtual; @@ -217,9 +218,8 @@ type end; - { Caret or text cursor, inverts painting over text and has blinking - support. } - TfpgCaret = class + { Caret or text cursor, inverts painting over text and has blinking support. } + TfpgCaret = class(TObject) private FEnabled: boolean; FVisible: boolean; @@ -303,6 +303,7 @@ var fpgNamedColors: array[0..255] of TfpgColor; fpgNamedFonts: TList; uApplication: TfpgApplication; + uMsgQueueList: TList; const ONE_MILISEC = 1 / (24 * 60 * 60 * 1000); @@ -333,17 +334,17 @@ end; procedure fpgCheckTimers; var - n: integer; + i: integer; ctime: TDateTime; begin ctime := now; - for n := 1 to fpgTimers.Count do - TfpgTimer(fpgTimers[n - 1]).CheckAlarm(ctime); + for i := 0 to fpgTimers.Count-1 do + TfpgTimer(fpgTimers[i]).CheckAlarm(ctime); end; function fpgClosestTimer(ctime: TDateTime; amaxtime: integer): integer; var - n: integer; + i: integer; t: TfpgTimer; dt: TDateTime; tb: Boolean; @@ -352,9 +353,9 @@ begin dt := ctime + amaxtime * ONE_MILISEC; tb := False; - for n := 1 to fpgTimers.Count do + for i := 0 to fpgTimers.Count-1 do begin - t := TfpgTimer(fpgTimers[n - 1]); + t := TfpgTimer(fpgTimers[i]); if t.Enabled and (t.NextAlarm < dt) then begin dt := t.NextAlarm; @@ -503,7 +504,7 @@ var i: integer; begin i := fpgTimers.IndexOf(self); - if i >= 0 then + if i > -1 then fpgTimers.Delete(i); inherited Destroy; end; @@ -622,10 +623,34 @@ begin fpgNamedFonts.Free; fpgImages.Free; + fpgStyle.Free; + fpgCaret.Free; + + for i := fpgTimers.Count-1 downto 0 do + begin + TfpgTimer(fpgTimers[i]).Free; + fpgTimers.Delete(i); + end; + fpgTimers.Free; - FFontResList.Free; FDefaultFont.Free; + + for i := FFontResList.Count-1 downto 0 do + begin + TfpgFontResource(FFontResList[i]).Free; + FFontResList.Delete(i); + end; + FFontResList.Free; + FreeAndNil(FModalFormStack); + + for i := uMsgQueueList.Count-1 downto 0 do + begin + TMessageListElement(uMsgQueueList[i]).Free; + uMsgQueueList.Delete(i); + end; + uMsgQueueList.Free; + inherited Destroy; end; @@ -661,7 +686,7 @@ begin else begin fr.Free; - writeln('error opening font.'); + writeln('fpGFX: Error opening font.'); end; end; @@ -683,12 +708,12 @@ procedure TfpgApplication.FreeFontRes(afontres: TfpgFontResource); var n: integer; begin - for n := 0 to FFontResList.Count - 1 do + for n := FFontResList.Count-1 downto 0 do if FFontResList[n] = Pointer(afontres) then begin TfpgFontResource(FFontResList[n]).Free; FFontResList.Delete(n); - Exit; + Exit; //==> end; end; @@ -744,7 +769,6 @@ destructor TfpgFont.Destroy; begin if TfpgFontResource(FFontRes).DecRefCount <= 0 then fpgApplication.FreeFontRes(TfpgFontResource(FFontRes)); - inherited; end; @@ -923,6 +947,15 @@ begin MenuDisabledFont := fpgGetFont(fpgGetNamedFontDesc('MenuDisabled')); end; +destructor TfpgStyle.Destroy; +begin + DefaultFont.Free; + MenuFont.Free; + MenuAccelFont.Free; + MenuDisabledFont.Free; + inherited Destroy; +end; + procedure TfpgStyle.DrawButtonFace(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; AFlags: TFButtonFlags); var r: TfpgRect; @@ -1114,15 +1147,16 @@ end; destructor TfpgCaret.Destroy; begin + FCanvas := nil; FTimer.Free; inherited Destroy; end; -procedure TfpgCaret.SetCaret(acanvas: TfpgCanvas; x, y, w, h: TfpgCoord); +procedure TfpgCaret.SetCaret(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord); begin FEnabled := True; FVisible := False; - FCanvas := acanvas; + FCanvas := ACanvas; FLeft := x; FTop := y; FWidth := w; @@ -1134,9 +1168,9 @@ begin FTimer.Enabled := True; end; -procedure TfpgCaret.UnSetCaret(acanvas: TfpgCanvas); +procedure TfpgCaret.UnSetCaret(ACanvas: TfpgCanvas); begin - if (FCanvas = acanvas) or (acanvas = nil) then + if (FCanvas = ACanvas) or (ACanvas = nil) then begin FEnabled := False; FCanvas := nil; @@ -1176,10 +1210,15 @@ end; destructor TfpgImages.Destroy; var - n: integer; + i: integer; + img: TfpgImage; begin - for n := 0 to FImages.Count - 1 do - FImages.Objects[n].Free; + for i := FImages.Count-1 downto 0 do + begin + img := TfpgImage(FImages.Objects[i]); + FImages.Delete(i); + img.Free; + end; FImages.Free; inherited Destroy; end; @@ -1304,13 +1343,13 @@ end; initialization uApplication := nil; + uMsgQueueList := nil; fpgTimers := nil; fpgCaret := nil; fpgImages := nil; fpgInitMsgQueue; finalization; - fpgCaret.Free; uApplication.free; end. diff --git a/src/corelib/gfx_command_intf.pas b/src/corelib/gfx_command_intf.pas index 1313b45e..3e5133de 100644 --- a/src/corelib/gfx_command_intf.pas +++ b/src/corelib/gfx_command_intf.pas @@ -1,7 +1,6 @@ unit gfx_command_intf; {$mode objfpc}{$H+} -{$INTERFACES CORBA} interface diff --git a/src/corelib/gfx_msgqueue.inc b/src/corelib/gfx_msgqueue.inc index 58eeaa16..c60bda2b 100644 --- a/src/corelib/gfx_msgqueue.inc +++ b/src/corelib/gfx_msgqueue.inc @@ -4,7 +4,7 @@ type // a simlpe linked list implementation - TMessageListElement = class + TMessageListElement = class(TObject) protected Next: TMessageListElement; Prev: TMessageListElement; @@ -96,10 +96,13 @@ begin UsedLastMessage := nil; FreeFirstMessage := nil; FreeLastMessage := nil; + + uMsgQueueList := TList.Create; for n := 1 to cMessageQueueSize do begin e := TMessageListElement.Create; + uMsgQueueList.Add(e); // so we can free it off later MsgListInsertElement(e,FreeFirstMessage,FreeLastMessage); end; end; |