رمز المثال الكامل لتنفيذ تبديل تمرير الصور في دلفي

تقدم هذه المقالة طريقة تنفيذ تبديل تمرير الصورة في دلفي مع مثال. يمكن لهذا البرنامج تحقيق البث المتداول للصور، ومن خلال هذا الرمز، يمكن التحكم في الصورة الموجودة في النافذة للتمرير لأعلى عن طريق ضبط قيمة شريط التمرير السريع، ويمكن أيضًا ضبط سرعة التمرير بالنقر فوق "إيقاف". زر، وسوف تتوقف الصورة عن التمرير.

رمز الوظيفة الكامل هو كما يلي:

 وحدة Unit1؛ واجهات تستخدم Windows، الفئات، الرسومات، النماذج، عناصر التحكم، القوائم، مربعات الحوار، StdCtrls، ExtCtrls، SysUtils، ComCtrls، Buttons؛ : 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(Sender: TObject); الإجراء BitBtn1Click(Sender: TObject); الإجراء BitBtn2Click(Sender: TObject); fإلغاء: منطقي؛ التنفيذ{$R *.DFM} الإجراء TForm1.Open1Click(Sender: TObject);beginif OpenDialog1.Execute ثمbeginImage1.Picture.LoadFromFile (OpenDialog1.FileName);//Import image file Caption := 'التحكم في الحركة الديناميكية للصورة - ' + OpenDialog1. FileName;/ / تغيير عنوان النموذج;end;procedure TForm1.Exit1Click(Sender: TObject);beginClose; // الخروج من النموذج; الإجراء TForm1.AboutImageViewer1Click(Sender: TObject);// حول beginMessageDlg ("التحكم في الحركة الديناميكية للصور لـ"+ #13'Delphi Graphics Studio' , mtInFormation,[mbOk], 0);end;procedure TForm1.ColorDepth1Click(Sender: TObject);varstrDepth: String;begincase Image1.Picture.Bitmap.PixelFormat of // احصل على عمق ألوان الصورة pfDevice: strDepth := 'No image';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);// يعطي معلومات عمق لون الصورة; الإجراء TForm1.ScrollPanel1Click(Sender: TObject);beginPanel1.Visible := not Panel1.Visible;ScrollPanel1.Checked := Panel1.Visible; / تغيير رؤية لوحة التحكم؛ الإجراء 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 ثم // عندما لا يتم فتح الصورة beginMessageDlg ("الصورة غير مفتوحة!") ', mtInFormation, [mbOk], 0); // أعط رسالة خطأ escape; // خروج endelsefCancel := False;BitBtn1.Enabled := False; // تغيير خصائص الزرين BitBtn2.Enabled := True; Bmp := Image1.Picture.Bitmap; // احصل على صورة BMP وحدد حجم الصورة W := Bmp.Width;H := Bmp.Height;LineBytes := Abs (عدد صحيح (Bmp.ScanLine [1]) - عدد صحيح (Bmp.ScanLine [0]));Line := AllocMem (LineBytes); for I := 0 إلى H - 1 dobeginif fCancel ثم // تحقق من علامة المقاطعة قبل كل حلقة (أي حدد ما إذا كان قد تم الضغط على زر الإيقاف) Break; // انقر فوق الزر "إيقاف" لإيقاف تمرير الصورة Move ((Bmp.ScanLine [0])، Line، LineBytes)؛ // انسخ السطر الأول من الصورة لـ J := 1 إلى H - 1 dobeginMove ((Bmp.ScanLine [J])، (Bmp.ScanLine [J] - 1])، LineBytes)؛ إذا (J mod nLines = 0) ثمbeginR := 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 (المقبض, @R, False);UpdateWindow (Handle);Application.ProcessMessages; // السماح بإيقاف الحلقة على الفور لوضع البرنامج في الحالة الأولية؛BitBtn1.Enabled := True; // تنشيط زر "ابدأ" BitBtn2.Enabled := False // "زر" الإيقاف غير صالح ;procedure TForm1.BitBtn2Click(Sender: TObject);beginfCancel := True; // تغيير العلم Fcancel القيمة، إيقاف تمرير الصورة؛ الإجراء TForm1.FormCreate(Sender: TObject);beginTrackBar1Change (self); // اتصل بوظيفة TrackBar1Change;end.