View Issue Details

IDProjectCategoryView StatusLast Update
0036046LazarusLCLpublic2019-09-04 19:31
ReporterSerge AnvarovAssigned To 
PrioritynormalSeverityminorReproducibilityalways
Status newResolutionopen 
PlatformWindowsOSWindowsOS VersionWindows 7
Product Version2.0.4Product Build 
Target VersionFixed in Version 
Summary0036046: TTrackBar. Patch. For large ranges (Max - Min) and TickStyle = tsAuto (default) windows hang
DescriptionWindows tries to draw all these ticks, causing itself to hang (don't answer for very long).
The decision is made as in Delphi: with a large range cancels auto drawing ticks.

Steps To ReproduceIn new empty application put TTrackBar on form and add:
procedure TForm1.FormCreate(Sender: TObject);
begin
  TrackBar1.Max := MaxInt;
end;
Additional InformationSee https://forum.lazarus.freepascal.org/index.php/topic,46606.msg332560.html#msg332560
TagsNo tags attached.
Fixed in Revision
LazTarget
WidgetsetWin32/Win64
Attached Files
  • TrackBar.LargeRange.diff (1,091 bytes)
    Index: lcl/interfaces/win32/win32wscomctrls.pp
    ===================================================================
    --- lcl/interfaces/win32/win32wscomctrls.pp	(revision 61813)
    +++ lcl/interfaces/win32/win32wscomctrls.pp	(working copy)
    @@ -969,6 +969,7 @@
     var
       wHandle: HWND;
       NewStyle: integer;
    +  LTicksStyle: DWORD;
     const
       StyleMask = TBS_AUTOTICKS or TBS_NOTICKS or TBS_VERT or TBS_TOP or TBS_BOTH or
         TBS_ENABLESELRANGE or TBS_REVERSED;
    @@ -982,7 +983,10 @@
       begin
         { cache handle }
         wHandle := Handle;
    -    NewStyle := TickStyleStyle[TickStyle] or OrientationStyle[Orientation] or
    +    LTicksStyle := TickStyleStyle[TickStyle];
    +    if (Max - Min) > 10000 then // 10000 - for Delphi compatibility
    +      LTicksStyle := 0; // Skip draw ticks to avoid hanging
    +    NewStyle := LTicksStyle or OrientationStyle[Orientation] or
                     TickMarksStyle[TickMarks] or SelRangeStyle[ShowSelRange] or ReversedStyle[Reversed];
         UpdateWindowStyle(wHandle, NewStyle, StyleMask);
         Windows.SendMessage(wHandle, TBM_SETRANGEMAX, Windows.WPARAM(True), Max);
    
    TrackBar.LargeRange.diff (1,091 bytes)

Activities

Serge Anvarov

2019-09-04 19:31

reporter  

TrackBar.LargeRange.diff (1,091 bytes)
Index: lcl/interfaces/win32/win32wscomctrls.pp
===================================================================
--- lcl/interfaces/win32/win32wscomctrls.pp	(revision 61813)
+++ lcl/interfaces/win32/win32wscomctrls.pp	(working copy)
@@ -969,6 +969,7 @@
 var
   wHandle: HWND;
   NewStyle: integer;
+  LTicksStyle: DWORD;
 const
   StyleMask = TBS_AUTOTICKS or TBS_NOTICKS or TBS_VERT or TBS_TOP or TBS_BOTH or
     TBS_ENABLESELRANGE or TBS_REVERSED;
@@ -982,7 +983,10 @@
   begin
     { cache handle }
     wHandle := Handle;
-    NewStyle := TickStyleStyle[TickStyle] or OrientationStyle[Orientation] or
+    LTicksStyle := TickStyleStyle[TickStyle];
+    if (Max - Min) > 10000 then // 10000 - for Delphi compatibility
+      LTicksStyle := 0; // Skip draw ticks to avoid hanging
+    NewStyle := LTicksStyle or OrientationStyle[Orientation] or
                 TickMarksStyle[TickMarks] or SelRangeStyle[ShowSelRange] or ReversedStyle[Reversed];
     UpdateWindowStyle(wHandle, NewStyle, StyleMask);
     Windows.SendMessage(wHandle, TBM_SETRANGEMAX, Windows.WPARAM(True), Max);
TrackBar.LargeRange.diff (1,091 bytes)

Issue History

Date Modified Username Field Change
2019-09-04 19:31 Serge Anvarov New Issue
2019-09-04 19:31 Serge Anvarov File Added: TrackBar.LargeRange.diff