Keskustelu: Ohjelmointikysymykset: VB6: Kuvan koon skaalaus

Tuplanolla [10.05.2005 22:07:46]

Minulla olisi PictureBox isomman PictureBoxin sisällä.
Tässä pienemmässä PictureBoxissa on AutoSize, ja se mukautuu kuvakoon mukaan.
Ongelmia tulee kun tämä pienempi laatikko suurentuu yli isomman rajojen, ja kuvasta näkyy vain keskikohta.
—
Tarkoitus olisi saada kuvalaatikon suureneminen pysähtymään kun se on isompaa isompi tai samankokoinen (If (PictureBox1.Size > PictureBox2.Size Then blah) tyyliin).
Mutta ongelmia tuottaa se, että kuva pitäisi siististi saada pysymään kokonaisena sen pysäytetyn PictureBoxin sisällä.
Kuva pitäisi skaalata pieneen, thumbnail muotoon ja alempana labelissa näkyisi kuvakoko ja prosenttikoko, jos kuvaa on pienennetty sopiviin mittoihin.
—
Hieman vaikeaa on myös se, että VB6 katsoo pictureboxin koon eri yksikköna kuin pikseli.
Tämä onnistuu jotekin vbPixel funktiolla, tietäisi vain miten.
—
Lyhyesti: Kuvakokoa pitäisi muttaa ja muutokset pitäisi saada näkymään alempana.

esakom [10.05.2005 23:05:22]

entäs jos vain tutkit sen kuvan lataamisen jälkeen onko se pienempi boksi ylittänyt suuremman koon, jos on, niin lataatkin se imageen jonka säädät sen "suuremman" kokoiseksi ja laitat stretch:in trueksi.

kuvakoko löytynee seuraavaan tyyliin:

Dim x As Integer
Dim y As Integer
Picture1.BorderStyle = 0
x = CInt(Picture1.Width / Screen.TwipsPerPixelX)
y = CInt(Picture1.Height / Screen.TwipsPerPixelY)
Label1.Text = "x: " & CStr(x) & "y: " & CStr(y)

Blaze [10.05.2005 23:10:24]

Tuplanolla kirjoitti:

Hieman vaikeaa on myös se, että VB6 katsoo pictureboxin koon eri yksikköna kuin pikseli.

Vaihda lomakkeen ScaleMode-ominaisuus kolmoseksi ("Pixels").

setä [10.05.2005 23:48:35]

Pitääkö kuvasuhteen säilyä ennallaan? Jos korkeus tai leveys ylittyy, voit pienentää kuvan PaintPicture-metodilla, jossa määräät piirrettävän alueen korkeuden ja leveyden isomman boxin mukaiseksi.
Kokeilin oheisella koodilla. pic1 on se isompi boxi. pic2:n AutoRedraw = True.

Dim h As Integer, w As Integer
Dim hh As Integer, ww As Integer

Private Sub Form_Load()
  Me.Show
  h = pic1.ScaleHeight
  w = pic1.ScaleWidth
  pic2.Picture = LoadPicture(App.Path & "\lintu2.jpg")
  DoEvents
  If pic2.Width > w Or pic2.Height > h Then
    pic2.Left = 0
    pic2.Top = 0
    If pic2.Width / w > pic2.Height / h Then
      ww = w
      hh = pic2.Height * w / pic2.Width
    Else
      hh = h
      ww = pic2.Width * h / pic2.Height
    End If
    pic2.PaintPicture pic2.Picture, 0, 0, ww, hh
    pic2.Width = ww
    pic2.Height = hh
  Else
    pic2.Left = (w - pic2.Width) / 2
    pic2.Top = (h - pic2.Height) / 2
  End If
End Sub

Tuplanolla [11.05.2005 22:51:51]

Blaze kirjoitti:

Tuplanolla kirjoitti:

Hieman vaikeaa on myös se, että VB6 katsoo pictureboxin koon eri yksikköna kuin pikseli.

Vaihda lomakkeen ScaleMode-ominaisuus kolmoseksi ("Pixels").

Pilasi koko jutun.
Sain kuvan aiemmin keskelle PictureBox objektia mutta nyt se meni minne sattui.
—
Ja toimiiko esakomin vaihtoehto niin, että se kuvan suhde pysyy samana vaikka kuva mahdutetaan pieneen tilaan ja kuvan koon muutoksen prosentin saa näkyviin (zoomattu koko).
—
Tässä niiden kahden formin lähdekoodit:

VERSION 5.00
Begin VB.Form browseinputform
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Input Image"
   ClientHeight    =   3255
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   2175
   Icon            =   "browseinputform.frx":0000
   LinkTopic       =   "sprguiform"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3255
   ScaleWidth      =   2175
   StartUpPosition =   2  'CenterScreen
   Begin VB.Frame frameinput
      Caption         =   "Input Image (Bitmap)"
      Height          =   2655
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   1935
      Begin VB.CheckBox inputpreview
         Caption         =   "Show Preview"
         Height          =   255
         Left            =   120
         TabIndex        =   3
         Top             =   2280
         Width           =   1695
      End
      Begin VB.FileListBox inputfile
         Height          =   2040
         Left            =   120
         Pattern         =   "*.bmp"
         TabIndex        =   2
         Top             =   240
         Width           =   1695
      End
   End
   Begin VB.CommandButton inputload
      Caption         =   "Load"
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   2880
      Width           =   1935
   End
End
Attribute VB_Name = "browseinputform"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Unload(Cancel As Integer)
    Unload inputpreviewform
End Sub
Private Sub inputfile_Click()
    If (inputpreview.Value = 1) Then
    inputpreviewform.previewpic2.Picture = LoadPicture(App.Path & "\" & inputfile.FileName)
    inputpreviewform.previewpic2.Left = inputpreviewform.previewpic.Width / 2 - inputpreviewform.previewpic2.Width / 2
    inputpreviewform.previewpic2.Top = inputpreviewform.previewpic.Height / 2 - inputpreviewform.previewpic2.Height / 2
    inputpreviewform.previewtext.Caption = inputpreviewform.previewpic2.Picture.Width & "×" & inputpreviewform.previewpic2.Picture.Height
    End If
End Sub
Private Sub inputfile_DblClick()
    sprguiform.inputbmp.Text = inputfile.FileName
    Unload Me
End Sub
Private Sub inputload_Click()
    sprguiform.inputbmp.Text = inputfile.FileName
    Unload Me
End Sub
Private Sub inputpreview_Click()
    On Error GoTo previewerror
    If (inputpreview.Value = 1) Then
    Load inputpreviewform
    inputpreviewform.Show
    inputpreviewform.Left = browseinputform.Left
    inputpreviewform.Left = inputpreviewform.Left + browseinputform.Width
    inputpreviewform.previewpic2.Picture = LoadPicture(App.Path & "\" & inputfile.FileName)
    inputpreviewform.previewpic2.Left = inputpreviewform.previewpic.Width / 2 - inputpreviewform.previewpic2.Width / 2
    inputpreviewform.previewpic2.Top = inputpreviewform.previewpic.Height / 2 - inputpreviewform.previewpic2.Height / 2
    inputpreviewform.previewtext.Caption = inputpreviewform.previewpic2.Picture.Width & "×" & inputpreviewform.previewpic2.Picture.Height
    Else
    Unload inputpreviewform
    End If
previewerror:
    Exit Sub
End Sub

VERSION 5.00
Begin VB.Form inputpreviewform
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "Input Image Preview"
   ClientHeight    =   3615
   ClientLeft      =   5910
   ClientTop       =   4170
   ClientWidth     =   3255
   Icon            =   "inputpreviewform.frx":0000
   LinkTopic       =   "sprguiform"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3615
   ScaleWidth      =   3255
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.PictureBox previewpic
      Height          =   3255
      Left            =   0
      ScaleHeight     =   3195
      ScaleWidth      =   3195
      TabIndex        =   0
      Top             =   0
      Width           =   3255
      Begin VB.PictureBox previewpic2
         AutoSize        =   -1  'True
         Height          =   135
         Left            =   1560
         ScaleHeight     =   75
         ScaleWidth      =   75
         TabIndex        =   1
         Top             =   1560
         Width           =   135
      End
   End
   Begin VB.Label previewtext
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   3360
      Width           =   3135
   End
End
Attribute VB_Name = "inputpreviewform"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Kirjautuminen

Haku