close
دانلود فیلم
ایجاد یک جورچین از تصویر صفحه نمایش در دلفی
برای شروع یک پروژه جدید ایجاد نمایید سپس یک کامپوننت Image روی فرم قرار دهیم. این کامپوننت را میتوانید در برگ نشان Additional از پنل کامپوننتها پیدا کنید. حالا نوبت به تعریف متغییرها و آبجکتهای مورد نیاز است. در قسمت Var بالای implementation ، بصورت زیر متغییر ها را تعریف میکنیم:

Var

  ...

  DesktopPic:TBitmap;

  OrginalPic:TBitmap;

  WidthPic:Integer;

  HeightPic:Integer;

  BlackRect:TRect;

 

Implementation

...



 

  رویداد OnCreate را برای فرم بصورت زیر بنویسید:

procedure TForm1.FormCreate
  (Sender: TObject);

var i,j:Integer;

  XC,YC:Integer;

  RandomInt:Integer;

  ORect,PRect:TRect;

  TempPic:TBitmap;

begin

  Form1.BorderStyle := bsNone;

  Form1.Width := Screen.Width;

  Form1.Height := Screen.Height;

  Form1.Position := poScreenCenter;

  Form1.FormStyle := fsStayOnTop;

  Image1.Align := alClient;

  DesktopPic := TBitmap.Create;

  with DesktopPic do begin

  Width := Screen.Width;

  Height := Screen.Height;

  end;

  BitBlt(DesktopPic.Canvas.Handle,0,0,
  Screen.Width,Screen.Height,
  GetDC(0),0,0,SRCCOPY);

  image1.Picture.Bitmap:=DesktopPic ;

  WidthPic := Screen.Width div 8 ;

  HeightPic := Screen.Height div 8 ;

  for i:=0 to 8 do begin

  Image1.Canvas.MoveTo
  (i*WidthPic,0);

  image1.Canvas.LineTo
  (i*WidthPic,Screen.Height);

  end;

  for j:=0 to 8 do begin

  Image1.Canvas.MoveTo
  (0,j*HeightPic);

  Image1.Canvas.LineTo
  (Screen.Width,j*HeightPic);

  end;

  Randomize;

  TempPic:=TBitmap.Create;

  TempPic.Width := WidthPic;

  TempPic.Height := HeightPic;

  for i:=1 to 2000 do begin

  XC := Random(8);

  YC := Random(8);

  ORect := Rect(XC*WidthPic,YC*HeightPic,
  (XC+1)*WidthPic,(YC+1)*HeightPic);

  BitBlt(TempPic.Canvas.Handle,0,0,
  WidthPic,HeightPic,
  Image1.Canvas.Handle,
  XC*WidthPic,YC*HeightPic,
  SRCCOPY);

  RandomInt:=Random(4);

  case RandomInt of

  0: begin //change with top

  PRect := Rect(XC*WidthPic,
  (YC-1)*HeightPic,

  (XC+1)*WidthPic,
  YC*HeightPic);

  Image1.Canvas.CopyRect
  (ORect,Image1.Canvas,PRect);

  Image1.Canvas.Draw

  (PRect.Left,PRect.Top,TempPic) end;

  1: begin //change with left

  PRect := Rect((XC-1)*WidthPic,
  YC*HeightPic,

  XC*WidthPic,
  (YC+1)*HeightPic);

  Image1.Canvas.CopyRect
  (ORect,Image1.Canvas,PRect);

  Image1.Canvas.Draw
  (PRect.Left,PRect.Top,TempPic) end;

  2: begin //change with right

  PRect := Rect((XC+1)*WidthPic,
  YC*HeightPic,

  (XC+2)*WidthPic,
  (YC+1)*HeightPic);

  Image1.Canvas.CopyRect
  (ORect,Image1.Canvas,PRect);

  Image1.Canvas.Draw
  (PRect.Left,PRect.Top,TempPic) end;

  3: begin //change with bottom

  PRect := Rect(XC*WidthPic,
  (YC+1)*HeightPic,

  (XC+1)*WidthPic,
  (YC+2)*HeightPic);

  Image1.Canvas.CopyRect
  (ORect,Image1.Canvas,PRect);

  Image1.Canvas.Draw
  (PRect.Left,PRect.Top,TempPic) end;

  end; // end of case

  end; // end of for

  TempPic.Free;

  XC := Random(8);

  YC := Random(8);

  BlackRect := Rect(XC*WidthPic,
  YC*HeightPic,

  (XC+1)*WidthPic,
  (YC+1)*HeightPic);

  Image1.Canvas.Brush.Color:=clBlack;

  Image1.Canvas.Brush.Style:=bsSolid;

  Image1.Canvas.FillRect(BlackRect);

end;

اکنون رویداد OnClick آبجکت Image1 را بصورت زیر مینویسیم:

procedure TForm1.Image1Click
  (Sender: TObject);

var ClickPonit:TPoint;

  XC,YC:Integer;

  ORect,PRect:TRect;

  TempPic:TBitmap;

begin

  ClickPonit.X:=0;

  ClickPonit.Y:=0;

  GetCursorPos(ClickPonit);

  XC := (ClickPonit.X) div WidthPic;

  YC := (ClickPonit.Y) div HeightPic;

  ORect := Rect(XC*WidthPic,
  YC*HeightPic,

  (XC+1)*WidthPic,
  (YC+1)*HeightPic);

  TempPic:=TBitmap.Create;

  TempPic.Width := WidthPic;

  TempPic.Height := HeightPic;

  BitBlt(TempPic.Canvas.Handle,0,0,
  WidthPic,HeightPic,

  Image1.Canvas.Handle,
  XC*WidthPic,YC*HeightPic,
  SRCCOPY);

  // left of BlackRect

  if

  (ClickPonit.X>BlackRect.Left-WidthPic)

  and

  (ClickPonit.X

  then begin

  if

  (ClickPonit.Y > BlackRect.Top)

  and
  (ClickPonit.Y < BlackRect.Bottom)

  then begin

  PRect := Rect((XC+1)*WidthPic,
  YC*HeightPic,

  (XC+2)*WidthPic,
  (YC+1)*HeightPic);

  Image1.Canvas.CopyRect
  (ORect,
  Image1.Canvas,
  PRect);

  Image1.Canvas.Draw
  (PRect.Left,
  PRect.Top,
  TempPic);

  BlackRect:=ORect;

  end;

  end;

  // Right of BlackRect

  if
  (ClickPonit.X>BlackRect.Right)

  and
  (ClickPonit.X then

  if

  (ClickPonit.Y > BlackRect.Top)

  And

  (ClickPonit.Y < BlackRect.Bottom)
  then begin

  PRect := Rect
  ((XC-1)*WidthPic,
  YC*HeightPic,

  XC*WidthPic,
  (YC+1)*HeightPic);

  Image1.Canvas.CopyRect
  (ORect,
  Image1.Canvas,
  PRect);

  Image1.Canvas.Draw(PRect.Left,
  PRect.Top,
  TempPic);

  BlackRect:=ORect;

  end;

  // Top of Blackrect

  if

  (ClickPonit.X>BlackRect.Left)

  and
  (ClickPonit.X then

  if

  (ClickPonit.Y>BlackRect.Top-HeightPic)

  and

  (ClickPonit.Y then begin

  PRect := Rect(XC*WidthPic,
  (YC+1)*HeightPic,

  (XC+1)*WidthPic,
  (YC+2)*HeightPic);

  Image1.Canvas.CopyRect
  (ORect,
  Image1.Canvas,
  PRect);

  Image1.Canvas.Draw
  (PRect.Left,

  PRect.Top,

  TempPic);

  BlackRect:=ORect;

  end;

  // Bottom of BlackRect

  if
  (ClickPonit.X>BlackRect.Left)

  and

  (ClickPonit.X then

  if
  (ClickPonit.Y>BlackRect.Bottom)

  and
  (ClickPonit.Y then begin

  PRect := Rect(XC*WidthPic,
  (YC-1)*HeightPic,

  (XC+1)*WidthPic,
  YC*HeightPic);

  Image1.Canvas.CopyRect
  (ORect,
  Image1.Canvas,
  PRect);

  Image1.Canvas.Draw
  (PRect.Left,
  PRect.Top,
  TempPic);

  BlackRect:=ORect;

  end;

  TempPic.Free;

end;

در انتها لازم است آبجکتهای ایجاد شده در زمان اجرا را آزاد کنیم. پس در رویداد OnClose فرم به این صورت کدنویسی میکنیم.


procedure TForm1.FormClose

  (Sender: TObject; var Action: TCloseAction);

begin

  DesktopPic.Free;

  OrginalPic.Free;

end;

حالا میتوانبد برنامه را اجرا نمایید. بدلیل اینکه فرم بدون نوار عنوان است برای بستن فرم از کلیدهای Alt + F4 استفاده کنید. پس از اجرای برنامه میبینید تصویر صفحه نمایش به 64 قسمت در هم ریخته تبدیل میشود. یکی از قسمتها فاقد تصویر بوده و شما با کلیک کردن روی 4 قسمت چسبیده به آن (بالا، پایین، چپ، راست) میتوانید جای تصاویر را عوض کنید. چون برنامه فوق را با عجله زیاد نوشتم، رفع نقایص و خطاهای احتمالی را به عهده شما میگذارم.

 

لینک کوتاه پست
مطالب مرتبط با پست جاری
  • نکات مهم
    1- لطفا نظر خود را با زبان فارسی بیان کنید
    2- رایتم نظرات اسپم و تبلیغی شما را تایید نمی کند
    3- لطفا نظرات شما بدون ابهام و واضح باشد
  • نام
    ایمیل (منتشر نمی‌شود) (لازم)
    وبسایت
    :):(;):D;)):X:?:P:*=((:O@};-:B/:):S
    نظر خصوصی
    مشخصات شما ذخیره شود ؟[حذف مشخصات] [شکلک ها]
    کد امنیتی
به کانال تلگرام سایت ما بپیوندید