| 投稿日 | ： 2004/06/03(Thu) 14:11 |
| 投稿者 | ： ken.1 |
| Ｅメール | ： |
| ＵＲＬ | ： |
| タイトル | ： Re^7: PictureBoxでズーム・スクロールする |
お世話になります。
AutoRedrawプロパティの変更でチラつきがいくらか抑えられたように思います。ありがとうございました
ですが結局、スクロール, ズームの度に再描画する設計がおかしい気がむんむんします（笑
またスクロールの制御ですが、Change, Scroll 双方で拾う形でやってみようと思います。
かなり冗長性たっぷりになりましたがマシンパワーに頼ってみます（苦汗
↓こんな感じでいってみます。長々とすいませんでした。
ピクチャボックスを3個・HScrollを2個・VScrollを1個貼り付けてイメージファイルを指定して実行すれば動く…はず
フォームのリサイズに合わせて描画領域のリサイズも行っています。
'画像のオリジナルサイズ
Dim lngOrgHeight As Long
Dim lngOrgWidth As Long
'スクロールバーで一度に進む距離(基本値)
Dim pointHeight As Long
Dim pointWidth As Long
'イニシャライズ中かのFLG
Dim iniFlg As Boolean
'ズーム・移動を一度に処理
Private Sub swichPicture()
Dim p1sw As Long 'picture3.ScaleWidth
Dim p1sh As Long 'picture3.ScaleHeight
Dim newPointWidth As Double
Dim newPointHeight As Double
'イニシャライズ中は逃げる
If iniFlg Then Exit Sub
Zooms = HScroll2 * 10
newPointWidth = pointWidth * (Zooms / 100)
newPointHeight = pointHeight * (Zooms / 100)
'元の画像サイズを取得して、拡大縮小サイズを求める
With Picture3
p1sw = .ScaleWidth * (Zooms / 100)
p1sh = .ScaleHeight * (Zooms / 100)
End With
'コピー先のサイズを設定する
With Picture2
'スクロール表示処理（実際にはコントロールを移動しサイズを変更している）
.Left = Picture1.Left - newPointWidth * (HScroll1.Value - 1)
.Width = Picture1.Width + newPointWidth * (HScroll1.Value - 1)
.Top = Picture1.Top - newPointHeight * (VScroll1.Value - 1)
.Height = Picture1.Height + newPointHeight * (VScroll1.Value - 1)
'元画像を参照しサイズ変更して picture2 を再描画
.Cls
DoEvents
.PaintPicture Picture3.Picture, 0, 0, p1sw, p1sh
End With
End Sub
Private Sub Form_Activate()
Call swichPicture
End Sub
Private Sub Form_Load()
'画像ファイルの設定
Set Picture3.Picture = LoadPicture("イメージファイル")
'--位置等のイニシャライズ------
iniFlg = True
With HScroll1
.Min = 1
.Max = 20
.Value = 1
End With
With HScroll2
.Min = 1
.Max = 20
.Value = 10
End With
With VScroll1
.Min = 1
.Max = 20
.Value = 1
End With
Picture1.BackColor = &HFFFFFF
With Picture2
.BackColor = &HFFFFFF
.AutoRedraw = True
End With
With Picture3
.Visible = False
.AutoSize = True
End With
With Form1
.Height = 7500
.Width = 8500
End With
iniFlg = False
'------------------------------
'オリジナルのサイズを格納
lngOrgHeight = Picture3.ScaleHeight
lngOrgWidth = Picture3.ScaleWidth
'スクロールバーで一度に進む距離を設定
pointHeight = lngOrgHeight / 20
pointWidth = lngOrgWidth / 20
Call swichPicture
End Sub
Private Sub Form_Resize()
'---最小サイズ(4000*4000)以下にできなくする
'最小化をトラップ
If Form1.WindowState = vbMinimized Then
Exit Sub
End If
If Form1.Width < 4000 Then
Form1.Width = 4000
End If
If Form1.Height < 4000 Then
Form1.Height = 4000
End If
'-------------------------------------------
'Picture1 の位置の基本値
With Picture1
.Top = -100
.Left = -100
.Height = Form1.Height - Picture1.Top - 1500
.Width = Form1.Width - Picture1.Left - 500
End With
'HScroll1 横スクロールバーの基本値
With HScroll1
.Top = Picture1.Height + Picture1.Top
.Left = 0
.Height = 300
.Width = Picture1.Width + Picture1.Left
End With
'VScroll1 縦スクロールバーの基本値
With VScroll1
.Top = 0
.Left = Picture1.Width + Picture1.Left
.Height = Picture1.Height + Picture1.Top
.Width = 300
End With
'HScroll2 ズームバー
With HScroll2
.Top = Picture1.Height + Picture1.Top + 700
.Left = 0
.Height = 300
.Width = Picture1.Width + Picture1.Left - 2100
End With
Call swichPicture
End Sub
Private Sub HScroll1_Scroll()
Call swichPicture
End Sub
Private Sub VScroll1_Scroll()
Call swichPicture
End Sub
Private Sub HScroll2_Scroll()
Call swichPicture
End Sub
Private Sub HScroll1_Change()
Call swichPicture
End Sub
Private Sub VScroll1_Change()
Call swichPicture
End Sub
Private Sub HScroll2_Change()
Call swichPicture
End Sub