كد مر بوط به MouseMove عكس

begin
try
if (Button<>2) Then
exit;
except
end;//-------Zoom On Picture
Picture1.PaintPicture Picture1.Picture( ,0,X,Y);
end;

كد مربوط به MousUp عكس

var
a:TPanel;
begin
try
if(Button<>2) then//--RightClick Code
exit;
except
end;
Picture1.ForeColor:=RGB(0,230,0);//---GridLine Color
i:=(1)-(300);//---Space In 2GridLine
while true do begin
i:=1+(300);
if (i>(Picture1.Height+1000)) then break;
Picture1.line(0,i)-(Picture1.width,i);
Picture1.line(i,0)-(i,Picture1.height);
end;
//-------Save Picture
a:=Picture1;
a.Picture=:=a.image;
SavePicture a.Picture(,'C:\1.jpg);
end;

end;//------+By:Nasservb.blogfa.com

خوب چطور بود
كد مربوط به همين برنامه در وي بي

Private Sub Form_Load()
Picture1.AutoRedraw = True
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
If Button <> 2 Then Exit Sub
'----- Zomm On Picture
Picture1.PaintPicture Picture1.Picture, 0, 0, X, Y
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
If Button <> 2 Then Exit Sub '---RightClick Code
Picture1.ForeColor = RGB(0, 230, 0) '----GridLine Color
For i = 1 To Picture1.Height + 1000 Step 300 '--Step is Space in 2 GridLine
Picture1.Line (0, i)-(Picture1.Width, i)
Picture1.Line (i, 0)-(i, Picture1.Height)
Next
'-------- Save Picture
Dim a As PictureBox
a = Picture1
Set a.Picture = a.Image
SavePicture a.Picture, "C:\1.jpg"
End Sub
----------+ By:NasserNiazy--nasservb.blogfa.com +------- '

يه موقع سوال داشتي رودربايستي نكني مارو از خودت بدون --پست اصلاح شد