lcl: TTrackBar.OnChange should be called after Position change in code, add Changed method for VCL compatibility, fix qt, gtk2 to skip message sending in case of position change through code to prevent double calling of the message (issue #0014545)

git-svn-id: trunk@25161 -

lcl/comctrls.pp

@@ -1840,6 +1840,7 @@ type
   protected
     class procedure WSRegisterClass; override;
     procedure ApplyChanges;
+    procedure Changed; virtual;
     procedure DoChange(var msg); message LM_CHANGED;
     procedure FixParams(var APosition, AMin, AMax: Integer);
     class function GetControlClassDefaultSize: TPoint; override;

lcl/include/customform.inc

@@ -466,9 +466,8 @@ begin
     // only fire event if reason is not some other window hide/showing etc.
     if Message.Status = 0 then
     begin
-      if Message.Show then begin
+      if Message.Show then
         DoShowWindow;
-      end;
     end;
   finally
     Exclude(FFormState, fsShowing);

lcl/include/trackbar.inc

@@ -174,6 +174,7 @@ begin
     FPosition := Value;
     if HandleAllocated then
       TWSTrackBarClass(WidgetSetClass).SetPosition(Self, FPosition);
+    Changed;
   end;
 end;
 
@@ -311,6 +312,12 @@ begin
     TWSTrackBarClass(WidgetSetClass).ApplyChanges(Self);
 end;
 
+procedure TCustomTrackBar.Changed;
+begin
+  if Assigned (FOnChange) then
+    FOnChange(Self);
+end;
+
 {------------------------------------------------------------------------------
   Method: TCustomTrackBar.DoChange
   Params:  Msg  (longint = LM_CHANGE)
@@ -325,8 +332,7 @@ begin
   if [csLoading,csDestroying,csDesigning]*ComponentState<>[] then
     Exit;
   EditingDone;
-  if Assigned (FOnChange) then
-    FOnChange(Self);
+  Changed;
 end;
 
 procedure TCustomTrackBar.FixParams(var APosition, AMin, AMax: Integer);

lcl/interfaces/gtk/gtkcallback.inc

@@ -2283,7 +2283,6 @@ var
 begin
   Result := CallBackDefaultReturn;
   EventTrace('Value changed', data);
-  if (Widget=nil) then ;
   Mess.msg := LM_CHANGED;
   DeliverMessage(Data, Mess);
 end;

lcl/interfaces/gtk2/gtk2wscomctrls.pp

@@ -247,13 +247,22 @@ end;
 
 {$I gtk2wscustomlistview.inc}
 
+procedure GtkWSTrackBar_Changed(AWidget: PGtkWidget; AInfo: PWidgetInfo); cdecl;
+var
+  Msg: TLMessage;
+begin
+  if AInfo^.ChangeLock > 0 then Exit;
+  Msg.Msg := LM_CHANGED;
+  DeliverMessage(AInfo^.LCLObject, Msg);
+end;
+
 { TGtk2WSTrackBar }
 
 class procedure TGtk2WSTrackBar.SetCallbacks(const AWidget: PGtkWidget;
   const AWidgetInfo: PWidgetInfo);
 begin
   TGtk2WSWinControl.SetCallbacks(PGtkObject(AWidget), TComponent(AWidgetInfo^.LCLObject));
-  TGtk2Widgetset(WidgetSet).SetCallback(LM_CHANGED, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
+  SignalConnect(AWidget, 'value_changed', @GtkWSTrackBar_Changed, AWidgetInfo);
 end;
 
 class function TGtk2WSTrackBar.CreateHandle(const AWinControl: TWinControl;
@@ -348,11 +357,17 @@ class procedure TGtk2WSTrackBar.SetPosition(const ATrackBar: TCustomTrackBar;
   const NewPosition: integer);
 var
   Range: PGtkRange;
+  WidgetInfo: PWidgetInfo;
 begin
   if not WSCheckHandleAllocated(ATrackBar, 'SetPosition') then
     Exit;
   Range := PGtkRange(ATrackBar.Handle);
+  WidgetInfo := GetWidgetInfo(Range);
+  // lock Range, so that no OnChange event is not fired
+  Inc(WidgetInfo^.ChangeLock);
   gtk_range_set_value(Range, NewPosition);
+  // unlock Range
+  Dec(WidgetInfo^.ChangeLock);
 end;
 
 { TGtk2WSProgressBar }

lcl/interfaces/qt/qtwidgets.pas

@@ -5760,7 +5760,7 @@ begin
   writeln('TQtTrackBar.SlotValueChanged()');
  {$endif}
 
-  if not SliderPressed and not InUpdate then
+  if not SliderPressed  and (TTrackBar(LCLObject).Position <> p1) and not InUpdate then
   begin
     FillChar(Msg, SizeOf(Msg), #0);
     Msg.Msg := LM_CHANGED;