USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Fórum

  Visual Basic
Voltar
Autor Assunto:  Redimencionar Controles em um Form
RicoCardozo
não registrado
Postada em 28/04/2006 15:07 hs   
Olá pessoal queria saber se alguém conhece uma função pra redimensionar os controles dentro do form.
É que tenho 2 micros que utilizan resolução 1024X768 e 4 que usa 800X600.
eu achei uma mas eu não consegui utiliza-la, pra dizer a verdade não consegui chamar a função no form.
 
Segue a funçao.
 
Public Function ResizeForm(Fator As Double, frm As Form)
'*** redimenciona tela com controles
'*** ALTERA DIMENSÕES DOS CONTROLES DO FORM
'*** FATOR DE 1024x768 PARA 800x600 = 0.78125
'*** FATOR DE 800x600 PARA 1024x768 = 1.28
    Dim ctl
    frm.Top = 0
    frm.Left = 0
    frm.Width = frm.Width * Fator
    frm.Height = frm.Height * Fator
    On Error Resume Next
    For Each ctl In frm.Controls
        ctl.Top = ctl.Top * Fator
        ctl.Width = ctl.Width * Fator
        If Left(ctl.Name, 3) <> "cbo" Then ctl.Height = ctl.Height * Fator
        ctl.Left = ctl.Left * Fator
        ctl.FontSize = ctl.FontSize * Fator  1
    Next
End Function

     
Armando Gioia
Pontos: 2843
SÃO PAULO
SP - BRASIL
Postada em 28/04/2006 15:33 hs            
cara eu achei essa dica ve se dah para fazer alguma coisa com ela
 
'para aumentar o tamanho de uma TextBox ou ListBox quando o Form for redimensionado utilize o seguinte código:

'em declarações:

Dim W As Integer
Dim H As Integer

'na Sub Form_Load:
Private Sub Form_Load()
    
    W = Me.Width - list.Width
    H = Me.Height - list.Height
    
End Sub

'e no evento resize do formulario:
Private Sub Form_Resize()
  
    If Me.WindowState <> 1 Then
    
        list.Width = Me.Width - W
        list.Height = Me.Height - H - 20 'no caso da altura coloca-se -20 pois desconta-se a altura do Caption do formulario
    
    End If
    
End Sub
     
LCRamos
Pontos: 2843
GOIANIA
GO - BRASIL
Postada em 29/04/2006 07:36 hs            
Tenho este problema e resolvi, fiz uma função (até parece ser esta), que resolveu meu problema, ela tem que ser publica, e chamada de cada form no evento Load.
Primeiro, voce usa a referencia 800x600 e pega a resolução da tela, o Form voce altera no carregamento com Me.
Tenha uma variavel publica sRECIZE As Form
 
No Form Load
 Set sRECIZE = Me
 RECFORM
Agora a função no módulo, sendo publica a variavel do fator da resolução não envie parametros.
Public Function RECFORM()
 Dim sSTR As String
 Dim I As Integer
 Dim nCOL As Column
 If lHEIGHT <> 1 Then
  For Each oOBJ In sRESIZE.Controls
   sCONTROL = oOBJ.Name
   sSTR = UCase$(Left(sCONTROL, 3))
   If sSTR <> "MNU" Then
    If oOBJ.Top >= 30 Then
     oOBJ.Top = (oOBJ.Top * lWIDTH)
    End If
    If oOBJ.Left >= 30 Then
     oOBJ.Left = (oOBJ.Left * lHEIGHT)
    End If
    ' SE FOR UMA COMBO OU DATA OU DRIVELIST
    If sSTR <> "CBO" And sSTR <> "DTA" And sSTR <> "DRI" Then
     oOBJ.Height = (oOBJ.Height * lHEIGHT)
    End If
    If sSTR <> "DTA" Then
     oOBJ.Width = (oOBJ.Width * lWIDTH)
    End If
    Se for um DbGrid refaz o tamanho das colunas
    If sSTR = "DBG" Then
     I = 0
     For Each nCOL In oOBJ.Columns
      nCOL.Width = oOBJ.Columns(I).Width
      oOBJ.Columns(I).Width = (nCOL.Width * lWIDTH)
      I = I + 1
     Next
    End If
   End If
  Next
 End If
End Function
Posso garantir que funciona
 
vlu//
     
Geronimo
Pontos: 2843
JOINVILLE
SC - BRASIL
Postada em 29/04/2006 09:40 hs            
: Como eu faço para ajustar os forms e os objetos 
: que estão contido nele para qualquer que seja a resolução 
: do monitor.
: Por exemplo, faço uma aplicação para uma resolução de 
: 640x480 e quando executo em um máquina que a resolução
: do monitor é de 800x600 ou superior, os forms ficam encolhidos.

Tem varias formas de se fazer isso. 
Contudo para ser bastante especifico, vou lhe enviar o code abaixo o qual regula o 
tamanho dos objetos no seu form.
veja ai:

'Adicione o code abaixo em um module.bas
Option Explicit

Public Type ctrObj
Name As String
Index As Long
Parrent As String
Top As Long
Left As Long
Height As Long
Width As Long
ScaleHeight As Long
ScaleWidth As Long
End Type

Private FormRecord() As ctrObj
Private ControlRecord() As ctrObj
Private bRunning As Boolean
Private MaxForm As Long
Private MaxControl As Long

Private Function ActualPos(plLeft As Long) As Long


If plLeft < 0 Then
ActualPos = plLeft + 75000
Else
ActualPos = plLeft
End If

End Function


Private Function FindForm(pfrmIn As Form) As Long

Dim i As Long
FindForm = -1

If MaxForm > 0 Then

For i = 0 To (MaxForm - 1)

If FormRecord(i).Name = pfrmIn.Name Then
FindForm = i
Exit Function
End If

Next i

End If

End Function


Private Function AddForm(pfrmIn As Form) As Long

Dim FormControl As Control
Dim i As Long
ReDim Preserve FormRecord(MaxForm + 1)

FormRecord(MaxForm).Name = pfrmIn.Name

FormRecord(MaxForm).Top = pfrmIn.Top

FormRecord(MaxForm).Left = pfrmIn.Left

FormRecord(MaxForm).Height = pfrmIn.Height

FormRecord(MaxForm).Width = pfrmIn.Width

FormRecord(MaxForm).ScaleHeight = pfrmIn.ScaleHeight

FormRecord(MaxForm).ScaleWidth = pfrmIn.ScaleWidth
AddForm = MaxForm
MaxForm = MaxForm + 1

For Each FormControl In pfrmIn
i = FindControl(FormControl, pfrmIn.Name)

If i < 0 Then
i = AddControl(FormControl, pfrmIn.Name)
End If

Next FormControl

End Function


Private Function FindControl(inControl As Control, inName As String) As Long

Dim i As Long
FindControl = -1

For i = 0 To (MaxControl - 1)

If ControlRecord(i).Parrent = inName Then

If ControlRecord(i).Name = inControl.Name Then
On Error Resume Next

If ControlRecord(i).Index = inControl.Index Then
FindControl = i
Exit Function
End If

On Error GoTo 0
End If

End If

Next i

End Function


Private Function AddControl(inControl As Control, inName As String) As Long

ReDim Preserve ControlRecord(MaxControl + 1)
On Error Resume Next
ControlRecord(MaxControl).Name = inControl.Name
ControlRecord(MaxControl).Index = inControl.Index
ControlRecord(MaxControl).Parrent = inName

If TypeOf inControl Is Line Then
ControlRecord(MaxControl).Top = inControl.Y1
ControlRecord(MaxControl).Left = ActualPos(inControl.X1)
ControlRecord(MaxControl).Height = inControl.Y2
ControlRecord(MaxControl).Width = ActualPos(inControl.X2)
Else
ControlRecord(MaxControl).Top = inControl.Top
ControlRecord(MaxControl).Left = ActualPos(inControl.Left)
ControlRecord(MaxControl).Height = inControl.Height
ControlRecord(MaxControl).Width = inControl.Width
End If

inControl.IntegralHeight = False
On Error GoTo 0
AddControl = MaxControl
MaxControl = MaxControl + 1
End Function


Private Function PerWidth(pfrmIn As Form) As Long

Dim i As Long
i = FindForm(pfrmIn)

If i < 0 Then
i = AddForm(pfrmIn)
End If

PerWidth = (pfrmIn.ScaleWidth * 100)  FormRecord(i).ScaleWidth
End Function


Private Function PerHeight(pfrmIn As Form) As Single

Dim i As Long
i = FindForm(pfrmIn)

If i < 0 Then
i = AddForm(pfrmIn)
End If

PerHeight = (pfrmIn.ScaleHeight * 100)  FormRecord(i).ScaleHeight
End Function


Private Sub ResizeControl(inControl As Control, pfrmIn As Form)

On Error Resume Next
Dim i As Long
Dim widthfactor As Single, heightfactor As Single
Dim minFactor As Single
Dim yRatio, xRatio, lTop, lLeft, lWidth, lHeight As Long
yRatio = PerHeight(pfrmIn)
xRatio = PerWidth(pfrmIn)
i = FindControl(inControl, pfrmIn.Name)

If inControl.Left < 0 Then
lLeft = CLng(((ControlRecord(i).Left * xRatio)  100) - 75000)
Else
lLeft = CLng((ControlRecord(i).Left * xRatio)  100)
End If

lTop = CLng((ControlRecord(i).Top * yRatio)  100)
lWidth = CLng((ControlRecord(i).Width * xRatio)  100)
lHeight = CLng((ControlRecord(i).Height * yRatio)  100)

If TypeOf inControl Is Line Then

If inControl.X1 < 0 Then
inControl.X1 = CLng(((ControlRecord(i).Left * xRatio)  100) - 75000)
Else
inControl.X1 = CLng((ControlRecord(i).Left * xRatio)  100)
End If

inControl.Y1 = CLng((ControlRecord(i).Top * yRatio)  100)

If inControl.X2 < 0 Then
inControl.X2 = CLng(((ControlRecord(i).Width * xRatio)  100) - 75000)
Else
inControl.X2 = CLng((ControlRecord(i).Width * xRatio)  100)
End If

inControl.Y2 = CLng((ControlRecord(i).Height * yRatio)  100)
Else
inControl.Move lLeft, lTop, lWidth, lHeight
inControl.Move lLeft, lTop, lWidth
inControl.Move lLeft, lTop
End If

End Sub


Public Sub ResizeForm(pfrmIn As Form)

Dim FormControl As Control
Dim isVisible As Boolean
Dim StartX, StartY, MaxX, MaxY As Long
Dim bNew As Boolean

If Not bRunning Then
bRunning = True

If FindForm(pfrmIn) < 0 Then
bNew = True
Else
bNew = False
End If


If pfrmIn.Top < 30000 Then
isVisible = pfrmIn.Visible
On Error Resume Next

If Not pfrmIn.MDIChild Then
On Error GoTo 0
' ' pfrmIn.Visible = False
Else

If bNew Then
StartY = pfrmIn.Height
StartX = pfrmIn.Width
On Error Resume Next

For Each FormControl In pfrmIn

If FormControl.Left + FormControl.Width + 200 > MaxX Then
MaxX = FormControl.Left + FormControl.Width + 200
End If


If FormControl.Top + FormControl.Height + 500 > MaxY Then
MaxY = FormControl.Top + FormControl.Height + 500
End If


If FormControl.X1 + 200 > MaxX Then
MaxX = FormControl.X1 + 200
End If


If FormControl.Y1 + 500 > MaxY Then
MaxY = FormControl.Y1 + 500
End If


If FormControl.X2 + 200 > MaxX Then
MaxX = FormControl.X2 + 200
End If


If FormControl.Y2 + 500 > MaxY Then
MaxY = FormControl.Y2 + 500
End If

Next FormControl

On Error GoTo 0
pfrmIn.Height = MaxY
pfrmIn.Width = MaxX
End If

On Error GoTo 0
End If


For Each FormControl In pfrmIn
ResizeControl FormControl, pfrmIn
Next FormControl

On Error Resume Next

If Not pfrmIn.MDIChild Then
On Error GoTo 0
pfrmIn.Visible = isVisible
Else

If bNew Then
pfrmIn.Height = StartY
pfrmIn.Width = StartX

For Each FormControl In pfrmIn
ResizeControl FormControl, pfrmIn
Next FormControl

End If

End If

On Error GoTo 0
End If

bRunning = False
End If

End Sub


Public Sub SaveFormPosition(pfrmIn As Form)

Dim i As Long

If MaxForm > 0 Then

For i = 0 To (MaxForm - 1)

If FormRecord(i).Name = pfrmIn.Name Then

FormRecord(i).Top = pfrmIn.Top

FormRecord(i).Left = pfrmIn.Left

FormRecord(i).Height = pfrmIn.Height

FormRecord(i).Width = pfrmIn.Width
Exit Sub
End If

Next i

AddForm (pfrmIn)
End If

End Sub


Public Sub RestoreFormPosition(pfrmIn As Form)

Dim i As Long

If MaxForm > 0 Then

For i = 0 To (MaxForm - 1)

If FormRecord(i).Name = pfrmIn.Name Then

If FormRecord(i).Top < 0 Then
pfrmIn.WindowState = 2
ElseIf FormRecord(i).Top < 30000 Then
pfrmIn.WindowState = 0
pfrmIn.Move FormRecord(i).Left, FormRecord(i).Top, FormRecord(i).Width, FormRecord(i).Height
Else
pfrmIn.WindowState = 1
End If

Exit Sub
End If

Next i

End If

End Sub

'Adicone o code abaixo no evento que voce deseja chamar para regular
'os objetos no seu form
Resizeform Me

Ate mais,


"O pior inimigo que você poderá encontrar será sempre você mesmo."
     
Geronimo
Pontos: 2843
JOINVILLE
SC - BRASIL
Postada em 29/04/2006 09:42 hs            
De uma olhada neste codigo:
em um form coloque um textbox picture, option, frame, commandbutton...
cole este codigo:
Private Sub Form_Load()
    Call SaveFormPosition(Form1)
End Sub

Private Sub Form_Resize()
    Me.AutoRedraw = False
    Call ResizeForm(Form1)
    Me.AutoRedraw = True
End Sub

Em um modulo cole o seguinte:
Private Type ctrObj
    Name As String
    Index As Long
    Parrent As String
    Top As Long
    Left As Long
    Height As Long
    Width As Long
    ScaleHeight As Long
    ScaleWidth As Long
End Type

Private FormRecord() As ctrObj
Private ControlRecord() As ctrObj
Private MaxForm As Long
Private MaxControl As Long

Private Function ActualPos(plLeft As Long) As Long
    If plLeft < 0 Then
        ActualPos = plLeft + 75000
    Else
        ActualPos = plLeft
    End If
End Function

Private Function FindForm(pfrmIn As Form) As Long

Dim i As Long
    FindForm = -1
    If MaxForm > 0 Then
        For i = 0 To (MaxForm - 1)
            If FormRecord(i).Name = pfrmIn.Name Then
                FindForm = i
                Exit Function
            End If
        Next i
    End If
End Function

Private Function AddForm(pfrmIn As Form) As Long
Dim FormControl As Control
Dim i As Long
    ReDim Preserve FormRecord(MaxForm + 1)
    FormRecord(MaxForm).Name = pfrmIn.Name
    FormRecord(MaxForm).Top = pfrmIn.Top
    FormRecord(MaxForm).Left = pfrmIn.Left
    FormRecord(MaxForm).Height = pfrmIn.Height
    FormRecord(MaxForm).Width = pfrmIn.Width
    FormRecord(MaxForm).ScaleHeight = pfrmIn.ScaleHeight
    FormRecord(MaxForm).ScaleWidth = pfrmIn.ScaleWidth
    AddForm = MaxForm
    MaxForm = MaxForm + 1
    For Each FormControl In pfrmIn
        i = FindControl(FormControl, pfrmIn.Name)
        If i < 0 Then
            i = AddControl(FormControl, pfrmIn.Name)
        End If
    Next FormControl
End Function

Private Function FindControl(inControl As Control, inName As String) As Long
Dim i As Long
    FindControl = -1
    For i = 0 To (MaxControl - 1)
        If ControlRecord(i).Parrent = inName Then
            If ControlRecord(i).Name = inControl.Name Then
                On Error Resume Next
                If ControlRecord(i).Index = inControl.Index Then
                    FindControl = i
                    Exit Function
                End If
                On Error GoTo 0
            End If
        End If
    Next i
End Function

Private Function AddControl(inControl As Control, inName As String) As Long
    ReDim Preserve ControlRecord(MaxControl + 1)
    On Error Resume Next
    ControlRecord(MaxControl).Name = inControl.Name
    ControlRecord(MaxControl).Index = inControl.Index
    ControlRecord(MaxControl).Parrent = inName
    If TypeOf inControl Is Line Then
        ControlRecord(MaxControl).Top = inControl.Y1
        ControlRecord(MaxControl).Left = ActualPos(inControl.X1)
        ControlRecord(MaxControl).Height = inControl.Y2
        ControlRecord(MaxControl).Width = ActualPos(inControl.X2)
    Else
        ControlRecord(MaxControl).Top = inControl.Top
        ControlRecord(MaxControl).Left = ActualPos(inControl.Left)
        ControlRecord(MaxControl).Height = inControl.Height
        ControlRecord(MaxControl).Width = inControl.Width
    End If
    'If TypeOf inControl Is DBList Then
    '    inControl.IntegralHeight = False
    'End If
    On Error GoTo 0
    AddControl = MaxControl
    MaxControl = MaxControl + 1
End Function

Private Function PerWidth(pfrmIn As Form) As Long
Dim i As Long
    i = FindForm(pfrmIn)
    If i < 0 Then
        i = AddForm(pfrmIn)
    End If
    PerWidth = (pfrmIn.ScaleWidth * 100)  FormRecord(i).ScaleWidth
End Function

Private Function PerHeight(pfrmIn As Form) As Single
Dim i As Long
    i = FindForm(pfrmIn)
    If i < 0 Then
        i = AddForm(pfrmIn)
    End If
    PerHeight = (pfrmIn.ScaleHeight * 100)  FormRecord(i).ScaleHeight
End Function

Private Sub ResizeControl(inControl As Control, pfrmIn As Form)
Dim i As Long
Dim yRatio, xRatio, lTop, lLeft, lWidth, lHeight As Long
    yRatio = PerHeight(pfrmIn)
    xRatio = PerWidth(pfrmIn)
    i = FindControl(inControl, pfrmIn.Name)
    On Error GoTo Moveit
    If inControl.Left < 0 Then
        lLeft = CLng(((ControlRecord(i).Left * xRatio)  100) - 75000)
    Else
        lLeft = CLng((ControlRecord(i).Left * xRatio)  100)
    End If
    lTop = CLng((ControlRecord(i).Top * yRatio)  100)
    lWidth = CLng((ControlRecord(i).Width * xRatio)  100)
    lHeight = CLng((ControlRecord(i).Height * yRatio)  100)
    GoTo Moveit
Moveit:
    On Error GoTo MoveError1
    If TypeOf inControl Is Line Then
        If inControl.X1 < 0 Then
            inControl.X1 = CLng(((ControlRecord(i).Left * xRatio)  100) - 75000)
        Else
            inControl.X1 = CLng((ControlRecord(i).Left * xRatio)  100)
        End If
        inControl.Y1 = CLng((ControlRecord(i).Top * yRatio)  100)
        If inControl.X2 < 0 Then
            inControl.X2 = CLng(((ControlRecord(i).Width * xRatio)  100) - 75000)
        Else
            inControl.X2 = CLng((ControlRecord(i).Width * xRatio)  100)
        End If
        inControl.Y2 = CLng((ControlRecord(i).Height * yRatio)  100)
    Else
        If TypeOf inControl Is Timer Then
            GoTo subExit
        End If
        If TypeOf inControl Is Image Then  ' ImageList
            GoTo subExit
        End If
        'If TypeOf inControl Is CommonDialog Then
        '    GoTo subExit
        'End If
        inControl.Move lLeft, lTop, lWidth, lHeight
    End If
    GoTo subExit
MoveError1:
    On Error GoTo MoveError2
    inControl.Move lLeft, lTop, lWidth
    GoTo subExit
MoveError2:
    On Error GoTo subExit
    inControl.Move lLeft, lTop
subExit:
    On Error GoTo 0
End Sub

Public Sub ResizeForm(gForm As Form)
Dim FormControl As Control
Dim isVisible As Boolean
If gForm.Top < 30000 Then
    isVisible = gForm.Visible
    gForm.Visible = False
    For Each FormControl In gForm
        Call ResizeControl(FormControl, gForm)
    Next FormControl
    gForm.Visible = isVisible
End If
End Sub

Public Sub SaveFormPosition(gForm As Form)
Dim i As Long
    If MaxForm > 0 Then
        For i = 0 To (MaxForm - 1)
            If FormRecord(i).Name = gForm.Name Then
                FormRecord(i).Top = gForm.Top
                FormRecord(i).Left = gForm.Left
                FormRecord(i).Height = gForm.Height
                FormRecord(i).Width = gForm.Width
                Exit Sub
            End If
        Next i
        AddForm (gForm)
    End If
End Sub

Private Sub RestoreFormPosition(gForm As Form)
Dim i As Long
    If MaxForm > 0 Then
        For i = 0 To (MaxForm - 1)
            If FormRecord(i).Name = gForm.Name Then
                If FormRecord(i).Top < 0 Then
                    gForm.WindowState = 2
                ElseIf FormRecord(i).Top < 30000 Then
                    gForm.WindowState = 0
                    gForm.Move FormRecord(i).Left, FormRecord(i).Top, FormRecord(i).Width, FormRecord(i).Height
                Else
                    gForm.WindowState = 1
                End If
                Exit Sub
            End If
        Next i
    End If
End Sub

Este codigo serve para aumentar todos os componentes 
conforme o form for aumentado, para testa o efeito deixe o form
 pequeno e execute depois de uma maximixar para ver a ideia.
sds geronimo

"O pior inimigo que você poderá encontrar será sempre você mesmo."
     
RicoCardozo
não registrado
Postada em 29/04/2006 12:14 hs   
E dai geronimo beleza..
Cara tá dando um  monte de erro.
 
E o do LCRamos tambem ..
     
Página(s): 1/2      PRÓXIMA »


Seu Nome:

Seu eMail:

ALTERAR PARA MODO HTML
Mensagem:

[:)] = 
[:P] = 
[:(] = 
[;)] = 

HTML DESLIGADO

     
 VOLTAR

  



CyberWEB Network Ltda.    © Copyright 2000-2025   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página