mirror of
				https://gitlab.com/freepascal.org/lazarus/lazarus.git
				synced 2025-11-04 10:19:52 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			173 lines
		
	
	
		
			4.8 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			173 lines
		
	
	
		
			4.8 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
{
 | 
						|
 /***************************************************************************
 | 
						|
                          Scrollbar - example
 | 
						|
                          ------------------
 | 
						|
 | 
						|
                   Initial Revision  : Thursday Feb 01 2001
 | 
						|
 | 
						|
                   by Shane Miller
 | 
						|
 | 
						|
 ***************************************************************************/
 | 
						|
 | 
						|
 ***************************************************************************
 | 
						|
 *                                                                         *
 | 
						|
 *   This source 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.                                   *
 | 
						|
 *                                                                         *
 | 
						|
 *   This code is distributed in the hope that it will be useful, but      *
 | 
						|
 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
 | 
						|
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
 | 
						|
 *   General Public License for more details.                              *
 | 
						|
 *                                                                         *
 | 
						|
 *   A copy of the GNU General Public License is available on the World    *
 | 
						|
 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 | 
						|
 *   obtain it by writing to the Free Software Foundation,                 *
 | 
						|
 *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
 | 
						|
 *                                                                         *
 | 
						|
 ***************************************************************************
 | 
						|
}
 | 
						|
program Scrollbar;
 | 
						|
 | 
						|
{$mode objfpc}{$H+}
 | 
						|
 | 
						|
uses
 | 
						|
  Interfaces, 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 CreateNew(AOwner, 1);
 | 
						|
   Caption := 'Scrollbar Demo v0.1';
 | 
						|
   Height := 350;
 | 
						|
 | 
						|
   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;
 | 
						|
     Width := 65;
 | 
						|
      end;
 | 
						|
 | 
						|
  Button2 := TButton.create(self);
 | 
						|
  with Button2 do
 | 
						|
      begin
 | 
						|
     Parent := self;
 | 
						|
     Left := 65;
 | 
						|
     Visible := True;
 | 
						|
     Caption := 'Button2';
 | 
						|
     onclick := @button2clicked;
 | 
						|
     Width := 65;
 | 
						|
      end;
 | 
						|
  Button3 := TButton.create(self);
 | 
						|
  with Button3 do
 | 
						|
      begin
 | 
						|
     Parent := self;
 | 
						|
     Left := 130;
 | 
						|
     Visible := True;
 | 
						|
     Caption := 'Button3';
 | 
						|
     onclick := @button3clicked;
 | 
						|
     Width := 65;
 | 
						|
      end;
 | 
						|
  Button4 := TButton.create(self);
 | 
						|
  with Button4 do
 | 
						|
      begin
 | 
						|
     Parent := self;
 | 
						|
     Left := 195;
 | 
						|
     Visible := True;
 | 
						|
     Caption := 'Button4';
 | 
						|
     onclick := @button4clicked;
 | 
						|
     Width := 65;
 | 
						|
      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.
 | 
						|
 |