TScrollbar created and a lot of code added.

It's cose to working.
Shane

git-svn-id: trunk@163 -

.gitattributes

@@ -48,6 +48,7 @@ examples/notebk.pp svneol=native#text/pascal
 examples/notebku.pp svneol=native#text/pascal
 examples/notebooktest.pp svneol=native#text/pascal
 examples/progressbar.pp svneol=native#text/pascal
+examples/scrollbar.pp svneol=native#text/pascal
 examples/selection.pp svneol=native#text/pascal
 examples/selectionform.pp svneol=native#text/pascal
 examples/speedtest.pp svneol=native#text/pascal

components/synedit/allunits.pp

@@ -13,7 +13,7 @@ interface
 uses
   synedit, syneditautocomplete, synedithighlighter, syneditkeycmds,
   syneditmiscclasses, syneditmiscprocs, syneditsearch, syneditstrconst,
-  synedittextbuffer, synedittypes, synhighlighterpas, syntextdrawer;
+  synedittextbuffer, synedittypes, synhighlighterpas, syntextdrawer,syncompletion;
 	
 implementation
 end.
@@ -21,6 +21,12 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.3  2001/02/01 19:34:50  lazarus
+  TScrollbar created and a lot of code added.
+
+  It's cose to working.
+  Shane
+
   Revision 1.2  2001/01/30 22:55:00  lazarus
   MWE:
     + Added $mode objfpc directive

examples/Makefile

@@ -168,7 +168,7 @@ endif
 
 # Targets
 
-override EXEOBJECTS+=hello notebk comdialogs progressbar trackbar listboxtest bitbutton combobox checkbox selection
+override EXEOBJECTS+=hello notebk comdialogs progressbar trackbar listboxtest bitbutton combobox checkbox selection scrollbar
 
 # Clean
 

examples/scrollbar.pp

@@ -0,0 +1,158 @@
+ {
+ /***************************************************************************
+                          Scrollbar - example
+                          ------------------
+
+                   Initial Revision  : Thursday Feb 01 2001
+
+                   by Shane Miller
+
+ ***************************************************************************/
+
+/***************************************************************************
+ *                                                                         *
+ *   This program is free software; you can redistribute it and/or modify  *
+ *   it under the terms of the GNU General Public License as published by  *
+ *   the Free Software Foundation; either version 2 of the License, or     *
+ *   (at your option) any later version.                                   *
+ *                                                                         *
+ ***************************************************************************/
+}
+{$H+}
+program Scrollbar;
+
+{$mode objfpc}
+
+uses
+  classes, stdctrls,forms,buttons,menus,comctrls,sysutils, extctrls, 
+  controls;
+
+type
+	TForm1 = class(TFORM)
+          Scrollbar1 : TScrollbar;
+          Button1 : TButton;
+          Button2 : TButton;
+          Button3 : TButton;
+          Button4 : TButton;
+          Procedure Button1Clicked(sender : tobject);
+          Procedure Button2Clicked(sender : tobject);
+          Procedure Button3Clicked(sender : tobject);
+          Procedure Button4Clicked(sender : tobject);
+          Procedure scrollbar1Changed(sender : tobject);
+          procedure Scrollbar1OnScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
+	public
+          constructor Create(AOwner: TComponent); override;	
+	  Procedure FormKill(Sender : TObject);
+	protected
+	end;
+
+var
+Form1 : TForm1;
+
+constructor TForm1.Create(AOwner: TComponent);	
+begin
+   inherited Create(AOwner);
+   Caption := 'Scrollbar Demo v0.1';
+
+   ScrollBar1 := TSCrollBar.Create(self);
+   with SCrollbar1 do
+    Begin
+      Parent := self;
+      Kind := sbVertical;
+      Left := 100;
+      Top := 50;
+      Width := 15;
+      Height := 300;
+     // align := alRight;
+      visible := True;
+      OnChange := @scrollbar1Changed;
+      OnScroll := @ScrollBar1OnScroll;
+    end;
+
+  Button1 := TButton.create(self);
+  with Button1 do
+      begin
+     Parent := self;
+     Visible := True;
+     Caption := 'Button1';
+     onclick := @button1clicked;
+      end;
+
+  Button2 := TButton.create(self);
+  with Button2 do
+      begin
+     Parent := self;
+     Left := 25;
+     Visible := True;
+     Caption := 'Button2';
+     onclick := @button2clicked;
+      end;
+  Button3 := TButton.create(self);
+  with Button3 do
+      begin
+     Parent := self;
+     Left := 55;
+     Visible := True;
+     Caption := 'Button3';
+     onclick := @button3clicked;
+      end;
+  Button4 := TButton.create(self);
+  with Button4 do
+      begin
+     Parent := self;
+     Left := 100;
+     Visible := True;
+     Caption := 'Button4';
+     onclick := @button4clicked;
+      end;
+
+end;
+
+
+procedure TForm1.FormKill(Sender : TObject);
+Begin
+
+End;
+
+Procedure TForm1.Button1Clicked(sender : tobject);
+Begin
+{Writeln('[Button1cvlikced]');
+if ScrollBar1.Kind = sbHorizontal then
+    Scrollbar1.Kind := sbVertical else
+    Scrollbar1.kind := sbHorizontal;
+ }
+end;
+
+Procedure TForm1.Button2Clicked(sender : tobject);
+Begin
+ScrollBar1.Min := ScrollBar1.Min + 20;
+end;
+
+Procedure TForm1.Button3Clicked(sender : tobject);
+Begin
+ScrollBar1.Max := ScrollBar1.Max + 25;
+end;
+
+Procedure TForm1.Button4Clicked(sender : tobject);
+Begin
+Scrollbar1.Position := ScrollBar1.Position + 5;
+end;
+
+Procedure TForm1.scrollbar1Changed(sender : tobject);
+Begin
+Caption := 'Scrollbar Demo - Position = '+Inttostr(Scrollbar1.Position);
+End;
+
+
+
+Procedure TForm1.Scrollbar1OnScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
+Begin
+Writeln('.............Scrolled...............');
+End;
+
+begin
+   Application.Initialize; { calls InitProcedure which starts up GTK }
+   Application.CreateForm(TForm1, Form1);
+   Application.Run;
+end.
+

lcl/include/customradiogroup.inc

@@ -139,7 +139,7 @@ end;
  ------------------------------------------------------------------------------}
 procedure TCustomRadioGroup.ItemsChanged (Sender : TObject);
 begin
-   RecreateWnd;
+//   RecreateWnd;
 end;
 
 {------------------------------------------------------------------------------
@@ -243,6 +243,12 @@ end;
 
 {
   $Log$
+  Revision 1.3  2001/02/01 19:34:50  lazarus
+  TScrollbar created and a lot of code added.
+
+  It's cose to working.
+  Shane
+
   Revision 1.2  2000/12/29 15:04:07  lazarus
   Added more images to the resource.
   Shane

lcl/include/scrollbar.inc

@@ -11,6 +11,7 @@ begin
   fCompStyle := csScrollBar;
   Width := 121;
   Height := GetSystemMetrics(SM_CYHSCROLL);
+  SetBounds(0,0,width,height);
   TabStop := True;
   ControlStyle := [csFramed, csDoubleClicks, csOpaque];
   FKind := sbHorizontal;
@@ -56,6 +57,7 @@ end;
 
 procedure TScrollBar.SetKind(Value: TScrollBarKind);
 begin
+  Writeln('setkind');
   if FKind <> Value then
   begin
     FKind := Value;
@@ -87,6 +89,8 @@ begin
         SetScrollPos(Handle, SB_CTL, FMax - FPosition, True);
     Change;
   end;
+
+  CNSendMEssage(LM_SetProperties,self,nil);
 end;
 
 procedure TScrollBar.SetPosition(Value: Integer);

lcl/include/wincontrol.inc

@@ -317,9 +317,13 @@ end;
 {------------------------------------------------------------------------------}
 Procedure TWinControl.ReCreateWnd;
 Begin
-//TODO: 
-//  if HandleAllocated
-//  then sendmessage
+//send a message to inform the interface that we need to destroy and recreate this control
+Writeln(Format('[TWinControl.RecreateWnd] %s ', [Classname]));
+if FHandle <> 0 then
+  Begin
+   CNSendMessage(LM_RECREATEWND,Self,Nil);
+   AttachSignals;
+  end;
 end;
 
 {------------------------------------------------------------------------------}
@@ -1889,6 +1893,12 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.14  2001/02/01 19:34:50  lazarus
+  TScrollbar created and a lot of code added.
+
+  It's cose to working.
+  Shane
+
   Revision 1.13  2001/01/30 18:15:02  lazarus
   Added code for TStatusBar
   I'm now capturing WMPainT and doing the drawing myself.

lcl/interfacebase.pp

@@ -59,6 +59,7 @@ type
     procedure SetCallback(Msg : LongInt; Sender : TObject); virtual; abstract;
     procedure RemoveCallbacks(Sender : TObject); virtual; abstract;
     function UpdateHint(Sender: TObject): Integer; virtual; abstract;
+    function RecreateWnd(Sender: TObject): Integer; virtual; abstract;
 
     
     {$DEFINE IF_BASE_MEMBER}
@@ -80,6 +81,12 @@ end.
 
 {
   $Log$
+  Revision 1.2  2001/02/01 19:34:50  lazarus
+  TScrollbar created and a lot of code added.
+
+  It's cose to working.
+  Shane
+
   Revision 1.1  2000/07/13 10:28:24  michael
   + Initial import
 

lcl/interfaces/gtk/gtkint.pp

@@ -96,7 +96,8 @@ type
       procedure AppTerminate; override;
       procedure Init; override;
       function  UpdateHint(Sender: TObject): Integer; override;
-      
+      function  RecreateWnd(Sender: TObject): Integer; override;
+
       {$I gtkwinapih.inc}
 
    end;
@@ -238,6 +239,12 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.5  2001/02/01 19:34:50  lazarus
+  TScrollbar created and a lot of code added.
+
+  It's cose to working.
+  Shane
+
   Revision 1.4  2001/01/24 23:26:40  lazarus
   MWE:
     = moved some types to gtkdef

lcl/interfaces/gtk/gtkobject.inc

@@ -180,6 +180,27 @@ begin
    
 end;
 
+function  TgtkObject.RecreateWnd(Sender: TObject): Integer;
+var
+ aParent : TWinControl;
+Begin
+//could we just call IntSendMessage??
+
+//destroy old widget
+gtk_widget_destroy(PgtkWidget(TWinControl(sender).HANDLE));
+
+aParent := TWinControl(sender).Parent;
+aParent.RemoveControl(TControl(sender));
+
+TWincontrol(sender).parent := nil;
+TWincontrol(sender).parent := aParent;
+
+ResizeChild(Sender,TWinControl(sender).Left,TWinControl(sender).Top,TWinControl(sender).Width,TWinControl(sender).Height);
+ShowHide(sender);
+
+End;
+
+
 {------------------------------------------------------------------------------
   Method: TGtkObject.IntSendMessage3
   Params:  LM_Message - message to be processed by GTK
@@ -244,6 +265,8 @@ begin
       LM_SETVALUE  : Result := SetValue (Sender, data);
      
       LM_SETPROPERTIES: Result := SetProperties(Sender);
+
+      LM_RECREATEWND : Result := RecreateWnd(sender);
       
       LM_ATTACHMENU: AttachMenu(Sender);
    else begin
@@ -1824,6 +1847,25 @@ begin
          end;
       end;
 
+      csScrollBar :
+      begin
+            if (TScrollBar(sender).kind = sbHorizontal) then
+               begin
+                Writeln('[Creating TScrollbar]  Horiz');
+                 P := gtk_hscrollbar_new(PgtkAdjustment(gtk_adjustment_new(1,TScrollBar(sender).min, TScrollBar(sender).max,
+                                                                     TScrollBar(sender).SmallChange, TScrollBar(sender).LargeChange,
+                                                                     TScrollBar(sender).Pagesize)));
+               end
+              else
+               Begin
+                Writeln('[Creating TScrollbar]  Vertical');
+                 P := gtk_vscrollbar_new(PgtkAdjustment(gtk_adjustment_new(1,TScrollBar(sender).min, TScrollBar(sender).max,
+                                                                     TScrollBar(sender).SmallChange, TScrollBar(sender).LargeChange,
+                                                                     TScrollBar(sender).Pagesize)));
+               end;
+
+      end;
+
       csScrolledWindow :
       begin
          P := gtk_scrolled_window_new(nil,nil);
@@ -2279,6 +2321,19 @@ begin
             else
                gtk_progress_set_show_text (GTK_PROGRESS (handle), 0);
          end;
+
+
+      csScrollBar:
+         with (TScrollBar (Sender)) do
+             begin
+               //set properties for the range
+               Widget := PGtkWidget (gtk_range_get_adjustment (GTK_RANGE (handle)));
+               PGtkAdjustment(Widget)^.lower := Min;
+               PGtkAdjustment(Widget)^.Upper := Max;
+               PGtkAdjustment(Widget)^.Value := Position;
+               PGtkAdjustment(Widget)^.step_increment := SmallChange;
+               PGtkAdjustment(Widget)^.page_increment := LargeChange;
+             end;
    
       csTrackbar   : 
          with (TTrackBar (Sender)) do
@@ -2606,6 +2661,12 @@ end;
  { =============================================================================
 
   $Log$
+  Revision 1.25  2001/02/01 19:34:50  lazarus
+  TScrollbar created and a lot of code added.
+
+  It's cose to working.
+  Shane
+
   Revision 1.24  2001/01/31 21:16:45  lazarus
   Changed to TCOmboBox focusing.
   Shane

lcl/interfaces/gtk/gtkwinapi.inc

@@ -2784,11 +2784,17 @@ begin
   then begin
     case SBStyle of
       SB_HORZ:
-        if gtk_type_is_a(gtk_object_type(PGTKObject(Handle)), gtk_scrolled_window_get_type)
-        then Adjustment := gtk_scrolled_window_get_hadjustment(PGTKScrolledWindow(Handle));
+        if gtk_type_is_a(gtk_object_type(PGTKObject(Handle)), gtk_scrolled_window_get_type) then
+           Adjustment := gtk_scrolled_window_get_hadjustment(PGTKScrolledWindow(Handle))
+        else
+        if gtk_type_is_a(gtk_object_type(PGTKObject(Handle)), gtk_hscrollbar_get_type) then
+           Adjustment :=  PgtkhScrollBar(handle)^.Scrollbar.Range.Adjustment;
       SB_VERT:
-        if gtk_type_is_a(gtk_object_type(PGTKObject(Handle)), gtk_scrolled_window_get_type)
-        then Adjustment := gtk_scrolled_window_get_vadjustment(PGTKScrolledWindow(Handle));
+        if gtk_type_is_a(gtk_object_type(PGTKObject(Handle)), gtk_scrolled_window_get_type) then
+           Adjustment := gtk_scrolled_window_get_vadjustment(PGTKScrolledWindow(Handle))
+        else
+        if gtk_type_is_a(gtk_object_type(PGTKObject(Handle)), gtk_vscrollbar_get_type) then
+           Adjustment :=  PgtkvScrollBar(handle)^.Scrollbar.Range.Adjustment;
       SB_CTL:
         if gtk_type_is_a(gtk_object_type(PGTKObject(Handle)), gtk_range_get_type)
         then Adjustment := gtk_range_get_adjustment(PGTKRange(Handle));
@@ -3149,6 +3155,12 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.17  2001/02/01 19:34:50  lazarus
+  TScrollbar created and a lot of code added.
+
+  It's cose to working.
+  Shane
+
   Revision 1.16  2001/01/23 23:33:55  lazarus
   MWE:
     - Removed old LM_InvalidateRect

lcl/lmessages.pp

@@ -83,6 +83,9 @@ LM_DRAGINFOCHANGED = LM_COMUSER+53;
 LM_BRINGTOFRONT = LM_COMUSER+55;
 LM_POPUPSHOW = LM_COMUSER+56;
 
+
+LM_RECREATEWND = LM_COMUSER+57;
+
 //end of messages that are sent to the interface
 
 
@@ -765,6 +768,12 @@ end.
 
 {
   $Log$
+  Revision 1.9  2001/02/01 19:34:50  lazarus
+  TScrollbar created and a lot of code added.
+
+  It's cose to working.
+  Shane
+
   Revision 1.8  2001/01/23 23:33:54  lazarus
   MWE:
     - Removed old LM_InvalidateRect