GFPBLabel/GFPBLabelInputfrm.frm

VERSION 5.00
Begin VB.Form GFPBLabelInputfrm
   BorderStyle     =   1 'Fest Einfach
   Caption         =   "Edit Label"
   ClientHeight    =   3030
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4170
   Icon            =   "GFPBLabelInputfrm.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0 'False
   ScaleHeight     =   3030
   ScaleWidth      =   4170
   StartUpPosition =   3 'Windows‑Standard
   Begin VB.CommandButton GFPBLabelInputOkCommand
      Caption         =   "Ok"
      Height          =   315
      Left            =   2400
      TabIndex        =   2
      Top             =   2580
      Width           =   1635
   End
   Begin VB.CommandButton GFPBLabelInputFontCommand
      Caption         =   "[...]"
      Height          =   315
      Left            =   120
      TabIndex        =   1
      Top             =   2160
      Width           =   1635
   End
   Begin VB.TextBox GFPBLabelInputText
      Height          =   1395
      Left            =   120
      MultiLine       =   ‑1 'True
      ScrollBars      =   2 'Vertikal
      TabIndex        =   0
      Top             =   360
      Width           =   3915
   End
   Begin VB.Label GFPBLabelInputLabel2
      Caption         =   "Label font:"
      Height          =   195
      Left            =   120
      TabIndex        =   4
      Top             =   1860
      Width           =   3915
   End
   Begin VB.Label GFPBLabelInputLabel1
      Caption         =   "Label text:"
      Height          =   195
      Left            =   120
      TabIndex        =   3
      Top             =   60
      Width           =   3915
   End
End
Attribute VB_Name = "GFPBLabelInputfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2001 by Louis.
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)

Dim GFPBLabelInputContinueFlag As Boolean
Dim GFPBLabelInputCancelFlag As Boolean
Dim GFPBLabelInputLabelIndex As Integer 'index of label to edit
Dim GFPBLabelInputFontStructVar As FontStruct

Private Sub Form_Load()
    'on error resume next
    'do nothing
End Sub

Public Sub GFPBLabelInput_EditLabel(ByVal LabelIndex As Integer)
    'on error resume next
    'verify
    If (LabelIndex < 1) Or (LabelIndex > GFPBLabelStructNumber) Then
        MsgBox "internal error in GFPBLabelInput_EditLabel(): passed value invalid !", vbOKOnly + vbExclamation
        Exit Sub 'error
    End If
    'preset
    GFPBLabelInputContinueFlag = False
    GFPBLabelInputLabelIndex = LabelIndex
    GFPBLabelInputText.Text = GFPBLabelStructArray(LabelIndex).LabelText
    GFPBLabelInputFontCommand.Caption = GFPBLabelStructArray(LabelIndex).LabelFont.FontName
    Call CopyMemory(GFPBLabelInputFontStructVar, GFPBLabelStructArray(LabelIndex).LabelFont, Len(GFPBLabelInputFontStructVar))
    'show window
    GFPBLabelInputfrm.Enabled = True
    GFPBLabelInputfrm.Visible = True
    GFPBLabelInputfrm.Refresh
    'begin
    Do While (GFPBLabelInputContinueFlag = False) And (GFPBLabelInputCancelFlag = False)
        DoEvents
        Call Sleep(0.1)
    Loop
    If GFPBLabelInputContinueFlag = True Then
        GFPBLabelStructArray(LabelIndex).LabelText = GFPBLabelInputText.Text
        'GFPBLabelStructArray(LabelIndex).LabelXPos 'leave unchanged
        'GFPBLabelStructArray(LabelIndex).LabelYPos 'leave unchanged
        Call CopyMemory(GFPBLabelStructArray(LabelIndex).LabelFont, GFPBLabelInputFontStructVar, Len(GFPBLabelInputFontStructVar))
    End If
    If GFPBLabelInputCancelFlag = True Then
        'do nothing (leave GFPBLabelStructArray() unchanged)
    End If
    'hide window
    GFPBLabelInputfrm.Enabled = False
    GFPBLabelInputfrm.Visible = False
    GFPBLabelInputfrm.Refresh
End Sub

Private Sub GFPBLabelInputFontCommand_Click()
    'on error resume next
    Dim TempFontStruct As FontStruct
    '
    'NOTE: the font is not changed if user pressed 'Cancel'.
    '
    'preset
    Call CopyMemory(TempFontStruct, GFPBLabelInputFontStructVar, Len(GFPBLabelInputFontStructVar))
    'begin
    If GFSelectFontfrm.GFSelectFont_SelectFont( _
        TempFontStruct.FontName, TempFontStruct.FontSize, TempFontStruct.FontBoldFlag, TempFontStruct.FontItalicFlag, TempFontStruct.FontUnderlineFlag, TempFontStruct.FontStrikeThroughFlag) = True Then
        'user pressed 'Ok'
        Call CopyMemory(GFPBLabelInputFontStructVar, TempFontStruct, Len(TempFontStruct))
        'GFPBLabelInputText.Text = GFPBLabelStructArray(LabelIndex).LabelText
        GFPBLabelInputFontCommand.Caption = FixMaxLineLength(GFPBLabelInputFontStructVar.FontName, 20)
    Else
        'user pressed 'Cancel'
        'do nothing
    End If
End Sub

Private Function FixMaxLineLength(ByVal Line As String, ByVal Length As Integer) As String
    On Error Resume Next
    If Length < 3 Then Length = 3 'otherwise error
    If Len(Line) > Length Then
        FixMaxLineLength = String$(3, ".") + Right$(Line, Length ‑ 3)
    Else
        FixMaxLineLength = Line
    End If
End Function

Private Sub GFPBLabelInputText_KeyPress(KeyAscii As Integer)
    'on error resume next
    Select Case KeyAscii
    Case 10, 13
        KeyAscii = 0 'Return is not allowed
    End Select
End Sub

Private Sub GFPBLabelInputOkCommand_Click()
    'on error resume next
    GFPBLabelInputContinueFlag = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
    'on error resume next
    GFPBLabelInputCancelFlag = True
End Sub


[END OF FILE]