program Project1;

uses
 windows,messages,
 kol;
type  TOnEvent = procedure( Sender: PObj )of object;
       TOnThreadExecute = function(Sender:PThread): Integer of object;
        TObjectMethod = procedure of object;

{$R *.res}
var
form,PBox,Pan,
EB1,B1,B2,L1,
Use_Scroll,Half_pixel:PControl;

Thread1:PThread;

OffsetX: Integer;
//LastTik: DWORD;
Bmp, Bmp2: PBitmap;

TextToScroll: String = 'Sample smooth scrolling text';
   Period: DWORD = 16; // better values = N * (1000 / VSync_in_Hertz)
   useScroll: Boolean = TRUE;
   halfPixel: Boolean = TRUE;
   step: Integer;

//область для процедур
procedure PBoxPaint(dummy:pointer;Sender: PControl; DC: HDC);
var R: TRect;
   Big, B: PBitmap;
   h: Integer;
begin
   if  (Bmp <> nil)
   and (Bmp.Width <> PBox.Width)
   and (Bmp.Height <> PBox.Height) then
       Free_And_Nil( Bmp );
   if  Bmp = nil then
   begin
       Bmp := NewBitmap( PBox.Width, PBox.Height );
       Bmp.Canvas.Brush.Color := clWindow;
       Bmp.Canvas.Font.Assign( PBox.Font );
       Bmp.Canvas.Font.FontQuality := fqAntialiased;
       h := Bmp.Canvas.TextHeight(TextToScroll);
       Bmp.Canvas.TextRect( Bmp.BoundsRect, 0, (Bmp.Height - h) div 2,
           TextToScroll );
       //Bmp.SaveToFile( GetStartDir + 'bmp.bmp' );

       Big := NewDibBitmap( Bmp.Width*2, Bmp.Height, pf32bit );
       Big.Canvas.Brush.Color := clWindow;
       Big.Canvas.FillRect( Big.BoundsRect );
       SetStretchBltMode( Big.Canvas.Handle, halftone );
       Bmp.StretchDraw( Big.Canvas.Handle, MakeRect( 1, 0, Big.Width+1, Big.Height ) );

       Bmp2 := NewDibBitmap( Bmp.Width, Bmp.Height, pf32bit );
       SetStretchBltMode( Bmp2.Canvas.Handle, halftone );
       Big.StretchDraw( Bmp2.Canvas.Handle, Bmp2.BoundsRect );
       //Bmp2.SaveToFile( GetStartDir + 'bmp2.bmp' );
       Big.Free;
   end;

   if  step and 1 = 1 then
       B := Bmp
   else
       B := Bmp2;
   R := PBox.ClientRect;
  //  OffsetRect( R, -OffsetX,0  );
   OffsetRect( R, 0, -OffsetX);
   B.Draw( Sender.Canvas.Handle, R.Left, R.Top );
   // OffsetRect( R, PBox.Width, 0  );
   OffsetRect( R,  0, PBox.Height );
   B.Draw( Sender.Canvas.Handle, R.Left, R.Top );

   if  Thread1.Suspended then
       Thread1.Resume;
end;
procedure FormDestroy(dummy:pointer;Sender: PObj);
begin
   Free_And_Nil( Bmp );
   Free_And_Nil( Bmp2 );
end;

procedure EB1Change(dummy:pointer;Sender: PObj);
var n: Integer;
begin
   n := Str2Int( EB1.Text );
   if  n > 0 then
       Period := n;
end;

procedure B1Click(dummy:pointer;Sender: PObj;var mouse:TMouseEventData);
var n: Integer;
begin
   n := Str2Int( EB1.Text ) - 1;
   if  n > 0 then
       EB1.Text := Int2Str( n );
end;

procedure B2Click(dummy:pointer;Sender: PObj;var mouse:TMouseEventData);
var n: Integer;
begin
   n := Str2Int( EB1.Text ) + 1;
   if  n > 0 then
       EB1.Text := Int2Str( n );
end;

function PBoxMessage(dummy:pointer;var Msg: tagMSG;
 var Rslt: Integer): Boolean;
begin
   Result := FALSE;
   if  Msg.message = WM_ERASEBKGND then
   begin
       Result := TRUE;
       Rslt := 1;
   end;
end;

{procedure TForm1.KOLForm1FormCreate(Sender: PObj);
begin
   //SetThreadPriority( GetCurrentThread, THREAD_PRIORITY_ABOVE_NORMAL );
end; }

procedure Use_ScrollClick(dummy:pointer;Sender: PObj);
begin
   useScroll := Use_Scroll.Checked;
end;

function Thread1Execute(dummy:pointer;Sender: PThread): Integer;
begin
   step := 0;
   while not AppletTerminated do
   begin
       inc( step );
       if  (step and 1 = 0) or not halfPixel then
       begin
           inc( OffsetX );
           if  OffsetX >= PBox.Height then   // PBox.Width
               OffsetX := 0;
       end;
       if  useScroll
       and (not halfPixel
           or halfPixel and (step and 1 = 0)) then
       begin
           ScrollWindow( PBox.Handle, 0,-1 , nil, nil );
       end
         else
       begin
           PBox.Invalidate;
       end;
       PBox.Update;
       Sleep( Period );

   end;
   Result := 0;
end;

procedure PBoxResize(dummy:pointer;Sender: PObj);
begin
   PBox.Invalidate;
   PBox.Update;
end;

procedure Half_pixelClick(dummy:pointer;Sender: PObj);
begin
   halfPixel := Half_pixel.Checked;
end;

Begin
form:=NewForm(Applet,'Form1').SetClientSize( 431, 71 ).setposition(330,300);
form.Font.FontHeight := 16;
form.Font.FontName := 'Arial';
PBox := NewPaintBox( Form ).SetAlign ( caClient );
{$IFDEF UNICODE_CTRLS}
PBox.SetUnicode(TRUE);
{$ENDIF UNICODE_CTRLS}  //for win7
PBox.Font.FontStyle := [ fsBold ];
Pan := NewPanel(Form, esRaised ).SetAlign ( caBottom ).SetSize( 0, 33 );

{$IFDEF UNICODE_CTRLS}
Panel1.SetUnicode(TRUE);
{$ENDIF UNICODE_CTRLS}

L1 := NewLabel( Pan, 'Period: ' ).SetAlign ( caLeft ).AutoSize( TRUE );

{$IFDEF UNICODE_CTRLS}
L1.SetUnicode(TRUE);
{$ENDIF UNICODE_CTRLS}

L1.VerticalAlign := KOL.vaCenter;

EB1 := NewEditBox( Pan, [  ] ).SetAlign ( caLeft ).SetSize( 108, 0 );
{$IFNDEF UNICODE_CTRLS}EB1.SetUnicode( TRUE );{$ENDIF}
EB1.Text := '16';
EB1.Color := TColor(clWindow);  // Цвет окна
B1 := NewButton( Pan, '<' ).SetAlign ( caLeft ).SetSize( 30, 0 );
{$IFDEF UNICODE_CTRLS}
B1.SetUnicode(TRUE);
{$ENDIF UNICODE_CTRLS}

B2 := NewButton(Pan, '>' ).SetAlign ( caLeft ).SetSize( 30, 0 );
{$IFDEF UNICODE_CTRLS}
B2.SetUnicode(TRUE);
{$ENDIF UNICODE_CTRLS}

Use_Scroll := NewCheckBox( Pan, 'Use Scroll' ).SetAlign ( caLeft ).AutoSize( TRUE );
{$IFDEF UNICODE_CTRLS}
Use_Scroll.SetUnicode(TRUE);
{$ENDIF UNICODE_CTRLS}
Use_Scroll.Checked := TRUE;
   // Result.Half_pixel.TabOrder = 4
Half_pixel := NewCheckBox( Pan, '1/2 pixel' ).SetAlign ( caLeft );

{$IFDEF UNICODE_CTRLS}
Half_pixel.SetUnicode(TRUE);
{$ENDIF UNICODE_CTRLS}
Half_pixel.Checked := TRUE;

//.centeronparent.Tabulate;
//область для работы
form.OnDestroy:=TOnEvent(MakeMethod(nil,@FormDestroy));
Thread1:= NewThreadEx(TOnThreadExecute(MakeMethod(nil,@Thread1Execute)));
Thread1.Resume;

EB1.OnChange :=TOnEvent(MakeMethod(nil,@EB1Change));
B1.OnClick :=TOnEvent(MakeMethod(nil,@B1Click));
B2.OnClick :=TOnEvent(MakeMethod(nil,@B2Click));
PBox.OnMessage :=TOnMessage(MakeMethod(nil,@PBoxMessage));
PBox.OnPaint :=TOnPaint(MakeMethod(nil,@PBoxPaint));
PBox.OnResize :=TOnEvent(MakeMethod(nil,@PBoxResize));
Half_pixel.OnClick :=TOnEvent(MakeMethod(nil,@Half_pixelClick));
Use_Scroll.OnClick :=TOnEvent(MakeMethod(nil,@Use_ScrollClick));
Run(form);
end.

Panel1.SetUnicode(TRUE);

Pan.SetUnicode(TRUE);