Ir para conteúdo
Fórum Script Brasil

soulaff

Membros
  • Total de itens

    3
  • Registro em

  • Última visita

Sobre soulaff

soulaff's Achievements

0

Reputação

  1. Pelo que percebi ninguém entendeu minha duvida ou ninguém conseguiu fazer o que pedi! Porem eu acabei conseguindo, creio que n seja um método muito convencional mas criei outro button para servir de guia!!! Porem decide fazer o intervalo de 20 em 20 não vou conseguir explicar o que eu fiz, então vou deixar o código: Imports System.Drawing.Color Public Class Form1 Private box(3) As Button Private cntr(3) As Button Private clickm As Boolean Private cntrtop(3) As Control Private ctrdown As Boolean Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Dim btn As Button Dim controlmove As Button Dim contorltop As Control For i As Integer = 1 To 3 btn = New Button btn.Name = i btn.Size = New Size(100, 20) btn.Location = New Point(100, 10 + 20 * (i - 1)) btn.BackColor = LightBlue box(i) = btn Me.Controls.Add(btn) controlmove = New Button controlmove.Name = "cntM" & i controlmove.Location = btn.Location controlmove.Size = New Size(10, 10) controlmove.Visible = True cntr(i) = controlmove Me.Controls.Add(controlmove) controlmove.BringToFront() contorltop = New Control contorltop.Name = "cntT" & i contorltop.Text = i contorltop.Location = btn.Location + New Point(0, btn.Height) contorltop.Size = New Size(100, 2) contorltop.Cursor = Cursors.SizeNS cntrtop(i) = contorltop contorltop.Visible = True Me.Controls.Add(contorltop) AddHandler btn.MouseDown, AddressOf apertado AddHandler btn.MouseUp, AddressOf desapertado AddHandler btn.MouseMove, AddressOf mover AddHandler btn.Move, AddressOf moverbtn AddHandler contorltop.MouseDown, AddressOf ctrdownsub AddHandler contorltop.MouseUp, AddressOf ctrupsub AddHandler contorltop.MouseMove, AddressOf ctrmmovesub AddHandler contorltop.Move, AddressOf ctrmovesub Next End Sub Private Sub apertado(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Dim btn As Button = DirectCast(sender, Button) clickm = True End Sub Private Sub desapertado(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Dim btn As Button = DirectCast(sender, Button) Dim ctr As Button = cntr(btn.Name) Dim ctrT As Control = cntrtop(btn.Name) clickm = False btn.Location = ctr.Location ctrT.Location = btn.Location + New Point(0, btn.Height) End Sub Private Sub mover(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Dim btn As Button = DirectCast(sender, Button) Dim ctr As Button = cntr(btn.Name) Dim ctrT As Control = cntrtop(btn.Name) If clickm = True Then If btn.Location.Y <= ctr.Location.Y + 20 And btn.Location.Y >= ctr.Location.Y - 20 Then btn.Location = btn.Location + New Point(0, e.Y) ElseIf btn.Location.Y > ctr.Location.Y + 20 Then btn.Location = ctr.Location + New Point(0, 20) ElseIf btn.Location.Y < ctr.Location.Y - 20 Then btn.Location = ctr.Location - New Point(0, 20) End If ctrT.Location = btn.Location + New Point(0, btn.Height - 5) End If End Sub Private Sub moverbtn(ByVal sender As Object, ByVal e As System.EventArgs) Dim btn As Button = DirectCast(sender, Button) Dim ctr As Control = cntr(btn.Name) If btn.Location.Y = ctr.Location.Y + 20 Then ctr.Location = btn.Location ElseIf btn.Location.Y = ctr.Location.Y - 20 Then ctr.Location = btn.Location End If End Sub Private Sub ctrdownsub(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Dim ctr As Control = DirectCast(sender, Control) ctrdown = True End Sub Private Sub ctrupsub(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Dim ctr As Control = DirectCast(sender, Control) Dim btn As Button = box(ctr.Text) ctrdown = False If Not ctr.Location.Y >= btn.Location.Y + 20 Then ctr.Location = btn.Location + New Point(0, 20) End If End Sub Private Sub ctrmmovesub(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Dim ctr As Control = DirectCast(sender, Control) Dim btn As Button = box(ctr.Text) If ctrdown = True Then If ctr.Location.Y >= btn.Location.Y + 20 Then If ctr.Location.Y < (btn.Location.Y + btn.Height) + 20 And ctr.Location.Y > (btn.Location.Y + btn.Height) - 20 Then ctr.Location = ctr.Location + New Point(0, e.Y) ElseIf ctr.Location.Y > (btn.Location.Y + btn.Height) + 20 Then ctr.Location = btn.Location + New Point(0, (btn.Height + 20)) ElseIf ctr.Location.Y < (btn.Location.Y + btn.Height) - 20 Then ctr.Location = btn.Location + New Point(0, btn.Height - 20) End If Else ctr.Location = btn.Location + New Point(0, 20) End If End If End Sub Private Sub ctrmovesub(ByVal sender As Object, ByVal e As System.EventArgs) Dim ctr As Control = DirectCast(sender, Control) Dim btn As Button = box(ctr.Text) If btn.Size.Height >= 20 Then If ctr.Location.Y = (btn.Location.Y + btn.Height) + 20 Then btn.SetBounds(btn.Left, btn.Top, btn.Width, btn.Height + 20) ElseIf ctr.Location.Y = (btn.Location.Y + btn.Height) - 20 Then btn.SetBounds(btn.Left, btn.Top, btn.Width, btn.Height - 20) End If Else btn.SetBounds(btn.Left, btn.Top, btn.Width, 20) End If End Sub End Class Com base na mesma solução fiz um button para movimentar de 20 em 20 tmb! Espero que ajude alguém com isso! e se souberem como simplificar esse código adoraria saber!!! XD Tem mais uma coisa que queria saber: como faço pra identificar de ocorreu sobreposição entre os buttons? porque quero que, quando ocorra uma sobreposição, o button reduza sua largura pela metade e fique um na esquerda e outro na direita!
  2. Ola amigos! Estou com muita dificuldade em meu projeto. Estou fazendo uma agenda de agendamento clinico, e nela eu crio buttons para representarem os horários! cada button tem 30 pixels de altura , o que representa 30 minutos de consulta! já consegui criar toda as estrutura para o agendamento dos horários porem gostaria de poder alterar o tamanho do button afim de representar um horário maior. Quero poder segurar na borda e arrastar para cima ou para baixo e alterar o tamanho do mesmo, porem de 30 em 30 pixels! já encontrei outros métodos de realizar esse resize em tempo de execução, mas não consigo ajustar para alterar de 30 em 30.... alguém por acaso conseguiria me ajudar? muito obrigado! Ps: o melhor metodo de recize que encontrei foi desse site: http://www.codeproject.com/Articles/20716/Allow-the-User-to-Resize-Controls-at-Runtime
  3. Ola gente! Tudo bem com vocês? Eu sou novo no fórum e no visual e estou tentando fazer um programa para gerenciar meu consultório odontológico. Estou tentando fazer uma agenda de horários para marcar os pacientes. Pensando bastante cheguei a um resultado aceitável, porem o código não ficou bom e tenho certeza que existe uma saída mais tranquila para meu problema Deixe-me tentar explicar: coloquei um calendário a esquerda da minha form e a direita estão textboxes onde cada uma representa o paciente marcado no horário especifico, de 8 as 19 com horários de 30 min, ou seja, uma tbx para as 8:00 uma para as 8:30 outra para as 9:00 e assim vai, ate as 19:00. estou usando uma ACCDB com as colunas data, hora e paciente Para preencher estas textboxes estou fazendo assim: Dim cs As String = My.Settings.DBagendaConnectionString Dim conect As New OleDbConnection conect.ConnectionString = cs conect.Open() 'para a tbx relacionada as 8:00 Dim sqlcmd As String = "SELECT paciente , hora FROM tb_agenda WHERE data = '" + Me.MonthCalendar1.SelectionRange.Start + "' AND hora = '8:00'" Dim cmd As New OleDbCommand(sqlcmd, conect) cmd.CommandType = CommandType.Text tbx80.Text = cmd.ExecuteScalar 'para a tbx relacionada as 8:30 Dim sqlcmd2 As String = "SELECT paciente , hora FROM tb_agenda WHERE data = '" + Me.MonthCalendar1.SelectionRange.Start + "' AND hora = '8:30'" Dim cmd2 As New OleDbCommand(sqlcmd2, conect) cmd2.CommandType = CommandType.Text tbx83.Text = cmd2.ExecuteScalar . . . Tenho certeza que posso simplificar esse código, porem não sei como! Se alguém conseguir me ajudar, ficarei muitíssimo grato!!!
×
×
  • Criar Novo...