diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/corelib/fpgfx.pas | 20 | ||||
-rw-r--r-- | src/corelib/x11/gfx_x11.pas | 50 | ||||
-rw-r--r-- | src/gui/gui_listbox.pas | 8 |
3 files changed, 68 insertions, 10 deletions
diff --git a/src/corelib/fpgfx.pas b/src/corelib/fpgfx.pas index cb6c0092..3125bef2 100644 --- a/src/corelib/fpgfx.pas +++ b/src/corelib/fpgfx.pas @@ -369,8 +369,17 @@ var ctime: TDateTime; begin ctime := now; - for i := 0 to fpgTimers.Count-1 do - TfpgTimer(fpgTimers[i]).CheckAlarm(ctime); + i := 0; + + while i < fpgTimers.Count do + begin + if fpgTimers[i] = nil then + fpgTimers.Delete(i) + else begin + TfpgTimer(fpgTimers[i]).CheckAlarm(ctime); + Inc(i); + end; + end; end; function fpgClosestTimer(ctime: TDateTime; amaxtime: integer): integer; @@ -387,7 +396,7 @@ begin for i := 0 to fpgTimers.Count-1 do begin t := TfpgTimer(fpgTimers[i]); - if t.Enabled and (t.NextAlarm < dt) then + if (t <> nil) and t.Enabled and (t.NextAlarm < dt) then begin dt := t.NextAlarm; tb := True; @@ -597,7 +606,7 @@ var begin i := fpgTimers.IndexOf(self); if i > -1 then - fpgTimers.Delete(i); + fpgTimers[i] := nil; // we free the item in fpgCheckTimers inherited Destroy; end; @@ -751,7 +760,8 @@ begin fpgCaret.Free; for i := fpgTimers.Count-1 downto 0 do - TfpgTimer(fpgTimers[i]).Free; + if fpgTimers[i] <> nil then + TfpgTimer(fpgTimers[i]).Free; fpgTimers.Free; FDefaultFont.Free; diff --git a/src/corelib/x11/gfx_x11.pas b/src/corelib/x11/gfx_x11.pas index 7fea5804..e505ed1f 100644 --- a/src/corelib/x11/gfx_x11.pas +++ b/src/corelib/x11/gfx_x11.pas @@ -132,6 +132,8 @@ type end; + { TfpgCanvasImpl } + TfpgCanvasImpl = class(TfpgCanvasBase) private FDrawing: boolean; @@ -147,6 +149,8 @@ type FClipRegion: TRegion; FPixHeight, FPixWidth: Integer; + FBufferFreeTimer: TObject; + procedure BufferFreeTimer(Sender: TObject); procedure TryFreePixmap; protected procedure DoSetFontRes(fntres: TfpgFontResourceBase); override; @@ -1688,6 +1692,7 @@ destructor TfpgCanvasImpl.Destroy; begin if FDrawing then DoEndDraw; + FreeAndNil(FBufferFreeTimer); TryFreePixmap; inherited Destroy; end; @@ -1730,13 +1735,41 @@ begin if buffered then begin - if (FastDoubleBuffer = False) or (FBufferPixmap = 0) or (w <> FPixWidth) or (h <> FPixHeight) then + if (FBufferPixmap = 0) + or (FastDoubleBuffer = False) + or (FastDoubleBuffer and (w > FPixWidth) or (h > FPixHeight)) + or ((FastDoubleBuffer = False) and ((w <> FPixWidth) or (h <> FPixHeight))) + then begin + if FastDoubleBuffer and ((w > FPixWidth) or (h > FPixHeight)) then + begin + FPixHeight := h + 30; + FPixWidth := w + 30; + end + else begin + FPixHeight := h; + FPixWidth := w; + end; TryFreePixmap; - FBufferPixmap := XCreatePixmap(xapplication.display, FDrawWindow.FWinHandle, w, h, xapplication.DisplayDepth); + FBufferPixmap := XCreatePixmap(xapplication.display, FDrawWindow.FWinHandle, FPixWidth, FPixHeight, xapplication.DisplayDepth); + end; + if FastDoubleBuffer then + begin + // Rapid paint events reuse the double buffer which resests a delay + // After the delay the double buffer is freed, letting the OS use video + // memory if needed. + // Things like scrolling and resizing are fast + + // Reset the timers next trigger + if FBufferFreeTimer = nil then + begin + FBufferFreeTimer := TfpgTimer.Create(500); + TfpgTimer(FBufferFreeTimer).OnTimer := @BufferFreeTimer; + end + else + TfpgTimer(FBufferFreeTimer).Enabled := False; + TfpgTimer(FBufferFreeTimer).Enabled := True; end; - FPixHeight := h; - FPixWidth := w; FDrawHandle := FBufferPixmap; end else @@ -1836,6 +1869,15 @@ begin Trunc(64 * a1), Trunc(64 * a2)); end; +procedure TfpgCanvasImpl.BufferFreeTimer(Sender: TObject); +begin + {$IFDEF DEBUG} + WriteLn('fpGFX/X11: Freeing Buffer w=', FPixWidth, ' h=', FPixHeight); + {$ENDIF} + TryFreePixmap; + FreeAndNil(FBufferFreeTimer); +end; + procedure TfpgCanvasImpl.TryFreePixmap; begin if FBufferPixmap > 0 then diff --git a/src/gui/gui_listbox.pas b/src/gui/gui_listbox.pas index d3164176..219ced11 100644 --- a/src/gui/gui_listbox.pas +++ b/src/gui/gui_listbox.pas @@ -450,6 +450,8 @@ begin end; procedure TfpgBaseListBox.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); +var + NewFocus: Integer; begin inherited HandleMouseMove(x, y, btnstate, shiftstate); @@ -459,7 +461,11 @@ begin if ((not FMouseDragging) or (btnstate and 1 = 0)) and (not HotTrack) then Exit; //==> - FocusItem := FFirstItem + Trunc((y - FMargin) / RowHeight); + NewFocus := FFirstItem + Trunc((y - FMargin) / RowHeight); + if NewFocus < 1 then + NewFocus := 1; + + FocusItem := NewFocus; end; procedure TfpgBaseListBox.HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); |