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
|
|
|
|
|
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
|
|
|
|
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//
|
|
|
|
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."
|
|
|
|
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 ..
|
|
|
|