GFPictureBoxResize/GFPictureBoxResize.frm
VERSION 5.00
Begin VB.Form GFPictureBoxResizefrm
BorderStyle = 1 'Fest Einfach
Caption = "[...]"
ClientHeight = 2370
ClientLeft = 45
ClientTop = 330
ClientWidth = 4650
Enabled = 0 'False
Icon = "GFPictureBoxResize.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 2370
ScaleWidth = 4650
Visible = 0 'False
Begin VB.CommandButton GFPBRCancelCommand
Caption = "Cancel"
Height = 375
Left = 1980
TabIndex = 3
Top = 1860
Width = 1215
End
Begin VB.PictureBox GFPBRPicture
Enabled = 0 'False
Height = 315
Left = 120
ScaleHeight = 255
ScaleWidth = 135
TabIndex = 7
Top = 1860
Visible = 0 'False
Width = 195
End
Begin VB.CommandButton GFPBROkCommand
Caption = "Ok"
Default = ‑1 'True
Height = 375
Left = 3300
TabIndex = 4
Top = 1860
Width = 1215
End
Begin VB.ComboBox GFPBRScaleModeCombo
Height = 315
Left = 3300
Style = 2 'Dropdown‑Liste
TabIndex = 2
Top = 840
Width = 1215
End
Begin VB.TextBox GFPBRHeightText
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1860
TabIndex = 1
Top = 840
Width = 1335
End
Begin VB.TextBox GFPBRWidthText
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 120
TabIndex = 0
Top = 840
Width = 1335
End
Begin VB.Label GFPBRLabel2
Alignment = 2 'Zentriert
Caption = "X"
Height = 195
Left = 1560
TabIndex = 6
Top = 900
Width = 195
End
Begin VB.Label GFPBRPromptLabel
Caption = "[...]"
Height = 375
Left = 120
TabIndex = 5
Top = 240
Width = 4395
End
End
Attribute VB_Name = "GFPictureBoxResizefrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2001 by Louis. Use to let the user enter two size values in different formats (scale modes).
'
'NOTE: call GFPBR_RequstSize() to open the window.
'The calling code will be interrupted until the user pressed the 'Cancel'
'or the 'Ok' command or closed the window by clicking on 'X'.
'If the entered sizes were confirmed, the function changes the passed
'values GFPBR[Width/Height]DefaultAndNew, if the user canceled
'these values are left unchanged.
'
'GFPBRS_RequestSize
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Type ProgramTwoLongVar
LongVar1 As Long
LongVar2 As Long
End Type
Dim GFPBRContinueFlag As Boolean
Dim GFPBRCancelFlag As Boolean
Dim GFPBRScaleMode As Integer
Dim GFPBRScaleModeOld As Integer
Dim GFPBRSizeDefault As ProgramTwoLongVar
Dim GFPBR_RequestSizeCalledFlag As Boolean
Private Sub Form_Load()
'on error resume next
Call DefineStatus
'preset scale modes
GFPBRScaleMode = vbPixels 'default (pixels)
GFPBRScaleModeOld = vbPixels 'default (pixels)
GFPBRScaleModeCombo.Text = GFPBRScaleModeCombo.List(0) 'default (pixels)
'end of presetting scale modes
Call GFPBRScaleModeCombo_Click 'update scale mode
End Sub
Private Sub DefineStatus()
'on error resume next
GFPBRScaleModeCombo.Clear 'reset
GFPBRScaleModeCombo.AddItem "Pixels"
GFPBRScaleModeCombo.AddItem "Centimeters"
GFPBRScaleModeCombo.AddItem "Inches"
End Sub
Private Sub GFPBRCancelCommand_Click()
'on error resume next
GFPBRCancelFlag = True
End Sub
Private Sub GFPBROkCommand_Click()
'on error resume next
GFPBRContinueFlag = True
End Sub
Private Sub GFPBRWidthText_GotFocus()
'on error resume next
GFPBRWidthText.SelStart = 0
GFPBRWidthText.SelLength = Len(GFPBRWidthText.Text)
End Sub
Private Sub GFPBRHeightText_GotFocus()
'on error resume next
GFPBRHeightText.SelStart = 0
GFPBRHeightText.SelLength = Len(GFPBRHeightText.Text)
End Sub
Private Sub GFPBRScaleModeCombo_Click()
'on error resume next 'updates the values in the text boxes
GFPBRScaleModeOld = GFPBRScaleMode
Select Case GFPBRScaleModeCombo.Text
Case "Pixels"
GFPBRScaleMode = vbPixels
Case "Centimeters"
GFPBRScaleMode = vbCentimeters
Case "Inches"
GFPBRScaleMode = vbInches
End Select
'convert values
GFPBRWidthText.Text = LTrim$(Str$(GFPBR_ConvertX(Val(GFPBRWidthText.Text), GFPBRScaleModeOld, GFPBRScaleMode)))
GFPBRHeightText.Text = LTrim$(Str$(GFPBR_ConvertY(Val(GFPBRHeightText.Text), GFPBRScaleModeOld, GFPBRScaleMode)))
End Sub
'***INTERFACE SUB***
Public Sub GFPBR_RequestSize(ByVal GFPBRWindowTitle As String, ByVal GFPBRPromptText As String, ByRef GFPBRWidthDefaultAndNew As Long, ByRef GFPBRHeightDefaultAndNew As Long)
'on error resume next 'makes the user enter some height/width values; function will always return these values in the format pixels
'verify
If GFPBR_RequestSizeCalledFlag = False Then
GFPBR_RequestSizeCalledFlag = True
Else
Exit Sub
End If
'preset
GFPictureBoxResizefrm.Caption = GFPBRWindowTitle
GFPBRPromptLabel.Caption = GFPBRPromptText
'save default values for canceling
GFPBRSizeDefault.LongVar1 = GFPBRWidthDefaultAndNew
GFPBRSizeDefault.LongVar2 = GFPBRHeightDefaultAndNew
'display default values in picture boxes
GFPBRWidthText.Text = GFPBRWidthDefaultAndNew
GFPBRHeightText.Text = GFPBRHeightDefaultAndNew
'reset
GFPBRContinueFlag = False 'reset
GFPBRCancelFlag = False 'reset
'show window
GFPictureBoxResizefrm.Visible = True
GFPictureBoxResizefrm.Enabled = True
GFPictureBoxResizefrm.Refresh
'begin
Do While (GFPBRContinueFlag = False) And (GFPBRCancelFlag = False)
DoEvents
Call Sleep(0.1) 'decreases CPU usage
Loop
If GFPBRContinueFlag = True Then
GFPBR_RequestSizeCalledFlag = False 'reset
GFPBRWidthDefaultAndNew = GFPBR_ConvertX(Val(GFPBRWidthText.Text), GFPBRScaleMode, vbPixels)
GFPBRHeightDefaultAndNew = GFPBR_ConvertY(Val(GFPBRHeightText.Text), GFPBRScaleMode, vbPixels)
End If
If GFPBRCancelFlag = True Then
GFPBR_RequestSizeCalledFlag = False 'reset
GFPBRWidthDefaultAndNew = GFPBRSizeDefault.LongVar1
GFPBRHeightDefaultAndNew = GFPBRSizeDefault.LongVar2
End If
'hide window
GFPictureBoxResizefrm.Visible = False
GFPictureBoxResizefrm.Enabled = False
GFPictureBoxResizefrm.Refresh
End Sub
'***END OF INTERFACE SUB***
Private Function GFPBR_ConvertX(ByVal ConversionXPassed As Single, ByVal ConversionInputMode As Integer, ByVal ConversionOutputMode As Integer) As Single
'on error resume next 'make GFPBRPicture convert an x size value
'verify
Select Case ConversionXPassed
Case Is < 1
ConversionXPassed = 1
Case Is > 32767 'any limit
ConversionXPassed = 32767
End Select
'begin
GFPBR_ConvertX = GFPBRPicture.ScaleX(CSng(ConversionXPassed), ConversionInputMode, ConversionOutputMode)
'verify (2)
Select Case GFPBR_ConvertX
Case Is < 1
GFPBR_ConvertX = 1
Case Is > 32767 'any limit
GFPBR_ConvertX = 32767
End Select
End Function
Private Function GFPBR_ConvertY(ByVal ConversionYPassed As Single, ByVal ConversionInputMode As Integer, ByVal ConversionOutputMode As Integer) As Single
'on error resume next 'make GFPBRPicture convert an y size value
'verify
Select Case ConversionYPassed 'verify
Case Is < 1
ConversionYPassed = 1
Case Is > 32767 'any limit
ConversionYPassed = 32767
End Select
'begin
GFPBR_ConvertY = GFPBRPicture.ScaleY(CSng(ConversionYPassed), ConversionInputMode, ConversionOutputMode)
'verify (2)
Select Case GFPBR_ConvertY 'verify
Case Is < 1
GFPBR_ConvertY = 1
Case Is > 32767 'any limit
GFPBR_ConvertY = 32767
End Select
End Function
Private Sub Form_Unload(Cancel As Integer)
'on error resume next
GFPBRCancelFlag = True
Cancel = True
End Sub
[END OF FILE]