首页 > 编程 > Delphi > 正文

Delphi实现图片滚动切换的完整实例代码

2020-01-31 20:51:12
字体:
来源:转载
供稿:网友

本文以实例介绍了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;procedure Open1Click(Sender: TObject);procedure Exit1Click(Sender: TObject);procedure AboutImageViewer1Click(Sender: TObject);procedure ColorDepth1Click(Sender: TObject);procedure ScrollPanel1Click(Sender: TObject);procedure TrackBar1Change(Sender: TObject);procedure BitBtn1Click(Sender: TObject);procedure BitBtn2Click(Sender: TObject);procedure FormCreate(Sender: TObject);privatepublic{ Public declarations }end;varForm1: TForm1;nLines: Integer;fCancel: Boolean;implementation{$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; //退出窗体end;procedure TForm1.AboutImageViewer1Click(Sender: TObject);//关于beginMessageDlg ('控制图像动态移动为'+ #13'Delphi图形工作室制作', mtInFormation,[mbOk], 0);end;procedure TForm1.ColorDepth1Click(Sender: TObject);varstrDepth: String;begincase Image1.Picture.Bitmap.PixelFormat of //获得图像颜色深度pfDevice: strDepth := '无图';pf1bit: strDepth := '1-bit';pf4bit: strDepth := '4-bit';pf8bit: strDepth := '8-bit';pf15bit: strDepth := '15-bit';pf16bit: strDepth := '16-bit';pf24bit: strDepth := '24-bit';pf32bit: strDepth := '32-bit';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;procedure TForm1.TrackBar1Change(Sender: TObject);beginnLines := TrackBar1.Position;TrackBar1.Hint := IntToStr (TrackBar1.Position);//给出当前速度大小的提示end;procedure 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 to H - 1 dobeginif fCancel then //在每一次循环前均检查中断标志(即确定停止按钮是否按下)Break; //单击“停止”按钮则停止滚动图像Move ((Bmp.ScanLine [0]), Line, LineBytes); //复制图像的第一行for J := 1 to 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; // 停止“按钮”失效end;procedure TForm1.BitBtn2Click(Sender: TObject);beginfCancel := True; //改变标志Fcancel 的值,停止图像滚动end;procedure TForm1.FormCreate(Sender: TObject);beginTrackBar1Change (self); //调用TrackBar1Change 函数end;end.
发表评论 共有条评论
用户名: 密码:
验证码: 匿名发表

图片精选