实现图片滚动浏览代码滚动源代码

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143

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 .