В этой статье на примере представлен метод реализации переключения прокрутки изображений в Delphi. Эта программа может реализовать прокручивающуюся трансляцию изображений, и с помощью этого кода можно управлять прокруткой изображения в окне вверх. Регулируя значение полосы прокрутки, скорость прокрутки также можно регулировать, нажав кнопку «Стоп». кнопку, и изображение перестанет прокручиваться.
Полный код функции выглядит следующим образом:
unit Unit1;interfaceusesWindows, Classes, Graphics, Forms, Controls, Menus,Dialogs, StdCtrls, ExtCtrls, SysUtils, ComCtrls, Buttons;typeTForm1 = class(TForm)MainMenu1: TMainMenu;File1: TMenuItem;Open1: TMenuItem;N1: TMenuItem;Exit1 : TMenuItem;Help1: TMenuItem;AboutImageViewer1: TMenuItem;OpenDialog1: TOpenDialog;Options1: TMenuItem;ColorDepth1: TMenuItem;ScrollPanel1: TMenuItem;Panel1: TPanel;TrackBar1: TTrackBar;BitBtn2: TBitBtn;BitBtn1: TBitBtn;Label1: TLabel;Image1: TImage;N2: TMenuItem;процедура Open1Click(Sender: TObject);процедура Exit1Click(Sender: TObject);процедура AboutImageViewer1Click(Sender: TObject);процедура ColorDepth1Click(Sender: TObject);процедура ScrollPanel1Click(Sender) : TObject); процедура TrackBar1Change (Отправитель: TObject); процедура BitBtn1Click (Отправитель: TObject); процедура BitBtn2Click (Отправитель: TObject); процедура FormCreate (Отправитель: TObject); fCancel: логическое значение;реализация{$R *.DFM}procedure TForm1.Open1Click(Sender: TObject);beginif OpenDialog1.Execute thenbeginImage1.Picture.LoadFromFile (OpenDialog1.FileName);//Импорт файла изображения Caption := 'Управление динамическим перемещением изображения - ' + OpenDialog1. FileName;/ /Изменить заголовок формыend;end;procedure TForm1.Exit1Click(Sender: TObject);beginClose; //Выходим из формы;процедуры TForm1.AboutImageViewer1Click(Sender: TObject);//О BeginMessageDlg('Управление динамическим перемещением изображений для'+ #13'Delphi Graphics Studio' , mtInFormation,[mbOk], 0);конец;процедура TForm1.ColorDepth1Click(Sender: TObject);varstrDepth: String;begincase Image1.Picture.Bitmap.PixelFormat of //Получить глубину цвета изображения pfDevice: strDepth := 'Нет изображения';pf1bit: strDepth := '1-bit'; pf4bit : strDepth := '4-бит';pf8bit: strDepth := '8-бит';pf15bit: strDepth := '15-бит';pf16bit: strDepth := '16-бит';pf24bit: strDepth := '24-бит';pf32bit: strDepth := '32-бит'; pfCustom: strDepth := 'Custom';end;MessageDlg('Глубина цвета изображения:' + strDepth,mtInFormation, [mbOK], 0);//Предоставляет информацию о глубине цвета изображенияend;procedure TForm1.ScrollPanel1Click(Sender: TObject);beginPanel1.Visible := not Panel1.Visible;ScrollPanel1.Checked := Panel1.Visible /; /Изменить видимость панели управленияend;процедура TForm1.TrackBar1Change(Sender: TObject);beginnLines := TrackBar1.Position;TrackBar1.Hint := IntToStr (TrackBar1.Position);//Дает подсказку о текущем ускорении;процедура TForm1.BitBtn1Click(Sender: TObject);varW, H, I, J , LineBytes: Integer;Line: PByteArray; //Определение переменной типа указателя Bmp: Tbitmap;R: TRect;beginif Image1.Picture.Bitmap.PixelFormat=pfDevice then //Когда изображение не открывается,beginMessageDlg('Изображение не открывается! ', mtInFormation, [mbOk], 0); //Выдаем сообщение об ошибке exit; //Выходим endelsefCancel := False;BitBtn1.Enabled := False; //Изменяем свойства двух кнопок BitBtn2.Enabled := True; Bmp := Image1.Picture.Bitmap; //Получаем изображение BMP и определяем его размер W := Bmp.Width;H := Bmp.Height;LineBytes := Abs (Integer (Bmp.ScanLine [1]) -Integer (Bmp.ScanLine [0]));Line := AllocMem (LineBytes);for I := от 0 до H - 1 dobeginif fCancel then //Проверяем флаг прерывания перед каждым циклом (то есть определяем, нажата ли кнопка остановки) Break //Нажимаем кнопку «Стоп», чтобы остановить прокрутку изображения Move; ((Bmp.ScanLine [0]), Line, LineBytes // Копируем первую строку изображения для J := 1 в H - 1 dobeginMove ((Bmp.ScanLine [J]), (Bmp.ScanLine [J]); - 1]), LineBytes);if (J mod nLines = 0) thenbeginR := Rect (0, Panel1.Height + J-nLines,W, Panel1.Height + J);InvalidateRect (Handle, @R, False);UpdateWindow (Handle);end;end;Move (Line, (Bmp.ScanLine [Bmp.Height - 1]), LineBytes);R := Rect (0, Panel1.Height + H - nLines,W, Panel1.Height + H);InvalidateRect (Handle, @R, False);UpdateWindow (Handle);Application.ProcessMessages; //Разрешаем немедленную остановку цикла, чтобы перевести программу в исходное состояниеend;BitBtn1.Enabled := True; //Активируем кнопку "Пуск" BitBtn2.Enabled := False; «Кнопка остановки» недействительна. value, остановить прокрутку изображенияend;procedure TForm1.FormCreate(Sender: TObject);beginTrackBar1Change (self); //Вызов функции TrackBar1Changeend;end.