Delphi实现图片滚动切换的完整实例代码_Delphi教程-查字典教程网
Delphi实现图片滚动切换的完整实例代码
Delphi实现图片滚动切换的完整实例代码
发布时间:2016-12-28 来源:查字典编辑
摘要:本文以实例介绍了Delphi实现图片滚动切换的方法。该程序可以实现图像的滚动播出,并且通过本代码可控制窗口中的图像向上滚动,通过调节速度滚动...

本文以实例介绍了Delphi实现图片滚动切换的方法。该程序可以实现图像的滚动播出,并且通过本代码可控制窗口中的图像向上滚动,通过调节速度滚动条的值还可以调整滚动的速度;点击“停止”按钮,图像即停止滚动。

完整的功能代码如下:

unit Unit1; interface uses Windows, Classes, Graphics, Forms, Controls, Menus, Dialogs, StdCtrls, ExtCtrls, SysUtils, ComCtrls, Buttons; type TForm1 = 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); private public { Public declarations } end; var Form1: TForm1; nLines: Integer; fCancel: Boolean; implementation {$R *.DFM} procedure TForm1.Open1Click(Sender: TObject); begin if OpenDialog1.Execute then begin Image1.Picture.LoadFromFile (OpenDialog1.FileName);//导入图像文件 Caption := '控制图像动态移动- ' + OpenDialog1.FileName;//改变窗体标题 end; end; procedure TForm1.Exit1Click(Sender: TObject); begin Close; //退出窗体 end; procedure TForm1.AboutImageViewer1Click(Sender: TObject);//关于 begin MessageDlg ('控制图像动态移动为'+ #13'Delphi图形工作室制作', mtInFormation, [mbOk], 0); end; procedure TForm1.ColorDepth1Click(Sender: TObject); var strDepth: String; begin case 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); begin Panel1.Visible := not Panel1.Visible; ScrollPanel1.Checked := Panel1.Visible; //改变控制面板的可见性 end; procedure TForm1.TrackBar1Change(Sender: TObject); begin nLines := TrackBar1.Position; TrackBar1.Hint := IntToStr (TrackBar1.Position);//给出当前速度大小的提示 end; procedure TForm1.BitBtn1Click(Sender: TObject); var W, H, I, J, LineBytes: Integer; Line: PByteArray; //定义指针类型变量 Bmp: Tbitmap; R: TRect; begin if Image1.Picture.Bitmap.PixelFormat=pfDevice then //当没有打开图片时 begin MessageDlg ('没有打开图片!', mtInFormation, [mbOk], 0);//给出出错提示 exit; //退出 end else fCancel := 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 do begin if fCancel then //在每一次循环前均检查中断标志(即确定停止按钮是否按下) Break; //单击“停止”按钮则停止滚动图像 Move ((Bmp.ScanLine [0]), Line, LineBytes); //复制图像的第一行 for J := 1 to H - 1 do begin Move ((Bmp.ScanLine [J]), (Bmp.ScanLine [J-1]), LineBytes); if (J mod nLines = 0) then begin R := 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); begin fCancel := True; //改变标志Fcancel 的值,停止图像滚动 end; procedure TForm1.FormCreate(Sender: TObject); begin TrackBar1Change (self); //调用TrackBar1Change 函数 end; end.

相关阅读
推荐文章
猜你喜欢
附近的人在看
推荐阅读
拓展阅读
  • 大家都在看
  • 小编推荐
  • 猜你喜欢
  • 最新Delphi学习
    热门Delphi学习
    编程开发子分类