Нужно разрезать картинку

[STanli]

НУжна прога для разрезания картинки. Надо чтобы можно было выбрать картинку потом нажимаешь на чёнеть и она разрезается на несколько размером 30 в ширину и 60 в высоту. Потом кнопочка чтобы всё это дело сохранить. Возможно?

[A.A.Z.]

Предположим, что в Picture1 - исходная картинка, а в Picture2 должна быть полученная картинка. Тогда

Код: Выделить всё

Sub Form_Load()
Me.ScaleMode = vbPixels
Picture1.ScaleMode = vbPixels
Picture2.ScaleMode = vbPixels
Picture1.AutoSize = True
Picture1.AutoRedraw = True
Picture2.AutoRedraw = True
Picture2.Width = 30
Picture2.Height = 60
Picture2.PaintPicture Picture1.Picture, 0, 0, 30, 60, 0, 0, 30, 60, vbSrcCopy
SavePicture Picture2.Image, "C:\File.bmp"
End Sub


RTFM, однако!

[STanli]

да вот именно это и надо было , только ещё надо бы чтобы оставшаяся часть таким же обраом резалась

[A.A.Z.]

В разные PictureBox'ы?
Примечание: код будет гораздо длиннее.

[STanli]

да можно даже и не в боксы а просто чтобы он их сохранил разрезанными и усё

[A.A.Z.]

Начальные условия те же (AutoRedraw, ScaleMode и т.п.). Код, правда, немного кривой, но все же...

Код: Выделить всё

Option Explicit

Private Sub Form_Load()
Dim KX As Long, KY As Long, W As Boolean, H As Boolean, X As Long, Y As Long
If Picture1.Width / 30 = Picture1.Width \ 30 Then W = True
If Picture1.Height / 60 = Picture1.Height \ 60 Then H = True
KX = Picture1.Width \ 30 + CLng(W) + 1
KY = Picture1.Height \ 60 + CLng(H) + 1
For X = 0 To KX
For Y = 0 To KY
GetAndSaveRect X * 30, Y * 60
Next
Next
End Sub

Sub GetAndSaveRect(ByVal lLeft As Long, ByVal lTop As Long)
Picture2.Cls
Picture2.PaintPicture Picture1.Picture, 0, 0, 30, 60, lLeft, lTop, 30, 60, vbSrcCopy
SavePicture Picture2.Image, "C:\MMM\" & lLeft / 30 & "-" & lTop / 60 & ".bmp"
End Sub

[STanli]

Ещё бы знать чё такое AutoRedraw, ScaleMode вобще было бы отлично

[A.A.Z.]

Добавь в начало процедуры

Код: Выделить всё

Me.ScaleMode = vbPixels
Picture1.ScaleMode = vbPixels
Picture2.ScaleMode = vbPixels
Picture1.AutoSize = True
Picture1.AutoRedraw = True
Picture2.AutoRedraw = True
Picture2.Width = 30
Picture2.Height = 60

[STanli]

А ты сам попробывал что получается =) он начинает сохранять и получается около 2000 картинок =)
Или это может опять я чтото не допонил

[A.A.Z.]

Я попробовал, получилось ~20 картинок (500х300)

[STanli]

чёто я недогоняю мож примерчик напишеш

[A.A.Z.]

Сейчас...