O editor do harbourdoc em VB6

por **JoséQuintas** » 15 Mar 2014 11:38

Só por curiosidade:

Este é o editor que fiz em VB6 pra mexer nos textos do harbourdoc.

Tela de edição: estou usando dois monitores, o texto do txt está no segundo monitor.

por **JoséQuintas** » 15 Mar 2014 11:39

Como os textos não tem limite, adicionei uma segunda tela, que se abre com os textos da primeira.

por **JoséQuintas** » 15 Mar 2014 11:42

Tudo bem, não é Clipper ou Harbour.
Mas é uma referência sobre o que poderia existir no Harbour.

O fonte da segunda tela:


Private Sub cmdCancel_Click()
   Unload Me
   End Sub

Private Sub cmdCrLf_Click()
   txtText.Text = Replace(txtText.Text, Chr(10), Chr(13) + Chr(10))
End Sub

Private Sub cmdReload_Click()
   If txtField.Text = "Description" Then txtText.Text = frmMain.txtDescription.Text
   If txtField.Text = "Arguments" Then txtText.Text = frmMain.txtArguments.Text
   If txtField.Text = "Example" Then txtText.Text = frmMain.txtExample.Text
   If txtField.Text = "Remarks" Then txtText.Text = frmMain.txtRemarks.Text
   If txtField.Text = "Returns" Then txtText.Text = frmMain.txtReturns.Text
   If txtField.Text = "Syntax" Then txtText.Text = frmMain.txtSyntax.Text
   If txtField.Text = "Compliance" Then txtText.Text = frmMain.txtCompliance.Text
   End Sub

Private Sub cmdSave_Click()
   If txtField.Text = "Description" Then frmMain.txtDescription.Text = Replace(frmMain.txtDescription.Text, Chr(10), Chr(13) + Chr(10)): frmMain.txtDescription.Text = txtText.Text
   If txtField.Text = "Arguments" Then frmMain.txtArguments.Text = txtText.Text
   If txtField.Text = "Example" Then frmMain.txtExample.Text = txtText.Text
   If txtField.Text = "Remarks" Then frmMain.txtRemarks.Text = txtText.Text
   If txtField.Text = "Returns" Then frmMain.txtReturns.Text = txtText.Text
   If txtField.Text = "Syntax" Then frmMain.txtSyntax.Text = txtText.Text
   If txtField.Text = "Compliance" Then frmMain.txtCompliance.Text = txtText.Text
   Unload Me
   End Sub

Durante os textos, teve um que vinha com Chr(10) apenas, e não mudava de linha, então acrescentei o botão de acertar CRLF.
O resto é apenas pra pegar/devolver os textos pra outra tela.
Como serve pra vários campos, tem os IFs pra verificar de qual campo se trata.
Bem diferente de um fonte Harbour.

por **JoséQuintas** » 15 Mar 2014 11:48

E o fonte principal.
Notem que é uma função pra cada item que está na tela.
Só se coloca fonte aonde o "clicar" tem que fazer alguma coisa.

Option Explicit
Dim cnMySql As New ADODB.Connection

Private Sub cmdAnterior_Click()
   Dim cSql As String, oRs As Recordset
   cSql = "SELECT name FROM harbour WHERE name < '" & txtName.Text & "' ORDER BY name desc limit 1"
   cnMySql.Open
   Set oRs = cnMySql.Execute(cSql)
   If Not oRs.EOF Then txtName.Text = oRs!Name
   oRs.Close
   Set oRs = Nothing
   cnMySql.Close
   LoadValues
   End Sub

Private Sub cmdIncluir_Click()
   If MsgBox("Incluir a função indicada?", vbYesNo) = vbYes Then
      MsgBox "Falta implementar"
   End If
   End Sub

Private Sub cmdPesquisar_Click()
   Dim cSql As String, oRs As Recordset
   cSql = "SELECT name FROM harbour where name = '" & Me.txtName.Text & "'"
   cnMySql.Open
   Set oRs = cnMySql.Execute(cSql)
   If oRs.EOF Then
      MsgBox "Não encontrado!"
   Else
      txtName.Text = oRs!Name
   End If
   oRs.Close
   Set oRs = Nothing
   cnMySql.Close
   LoadValues
   End Sub

Private Sub cmdPrimeiro_Click()
   Dim cSql As String, oRs As Recordset
   cSql = "SELECT name FROM harbour ORDER BY name limit 1"
   cnMySql.Open
   Set oRs = cnMySql.Execute(cSql)
   If Not oRs.EOF Then txtName.Text = oRs!Name
   oRs.Close
   Set oRs = Nothing
   cnMySql.Close
   LoadValues
   End Sub

Private Sub cmdSeguinte_Click()
   Dim cSql As String, oRs As Recordset
   cSql = "SELECT name FROM harbour where name > '" & txtName.Text & "' ORDER BY name limit 1"
   cnMySql.Open
   Set oRs = cnMySql.Execute(cSql)
   If Not oRs.EOF Then txtName.Text = oRs!Name
   oRs.Close
   Set oRs = Nothing
   cnMySql.Close
   LoadValues
   End Sub

Private Sub cmdSalva_Click()
   Dim cSql As String
   cSql = "UPDATE harbour set "
   cSql = cSql & " NAME=" & "'" & txtName.Text & "'"
   cSql = cSql & ", SEEALSO=" & "'" & txtSeeAlso.Text & "'"
   cSql = cSql & ", HBP=" & "'" & txtHbp.Text & "'"
   cSql = cSql & ", LIBRARY=" & "'" & txtLibrary.Text & "'"
   cSql = cSql & ", RETURNS=" & "'" & txtReturns.Text & "'"
   cSql = cSql & ", SYNTAX=" & "'" & txtSyntax.Text & "'"
   cSql = cSql & ", ONELINER=" & "'" & TxtOneLiner.Text & "'"
   cSql = cSql & ", ARGUMENTS=" & "'" & txtArguments.Text & "'"
   cSql = cSql & ", DESCRIPTION=" & "'" & Replace(txtDescription.Text, "'", Chr(34)) + "'"
   cSql = cSql & ", EXAMPLE=" & "'" & txtExample.Text & "'"
   cSql = cSql & ", AUTHOR=" & "'" & txtAuthor.Text & "'"
   cSql = cSql & ", REMARKS=" & "'" & txtRemarks.Text & "'"
   cSql = cSql & ", LASTUPDATE=" & "'" & txtLastUpdate.Text & "'"
   cSql = cSql & ", COMPLIANCE=" & "'" & txtCompliance.Text & "'"
   cSql = cSql & ", CATEGORY=" & "'" & txtCategory.Text & "'"
   cSql = cSql & ", SUBCATEGORY=" & "'" & txtSubCategory.Text & "'"
   cSql = cSql & ", OK=" & "'" & txtOk.Text & "'"
   cSql = cSql & ", ALTCATEGORY=" & "'" & txtAltCategory.Text & "'"
   cSql = cSql & " WHERE NAME=" & "'" & txtName.Text & "'"
   cnMySql.Open
   cnMySql.Execute cSql
   cnMySql.Close
   End Sub

Private Sub cmdSair_Click()
   Unload Me
   End Sub

Private Sub cmdUltimo_Click()
   Dim cSql As String, oRs As Recordset
   cSql = "SELECT name FROM harbour ORDER BY name desc limit 1"
   cnMySql.Open
   Set oRs = cnMySql.Execute(cSql)
   If Not oRs.EOF Then txtName.Text = oRs!Name
   oRs.Close
   Set oRs = Nothing
   cnMySql.Close
   LoadValues
   End Sub

Private Sub Form_Load()
   cnMySql.ConnectionString = "Driver=MySQL ODBC 3.51 Driver;Server=xxx;Option=131072;Stmt=;" & _
      "Database=xxxxx;User ID=xxxxx;Password=xxxxx;"
   End Sub

Private Sub Form_Unload(Cancel As Integer)
   Set cnMySql = Nothing
   End Sub

Private Function LoadValues()
   Dim cSql As String, oRs As Recordset
   cSql = "SELECT * FROM harbour where name='" & txtName.Text & "'"
   cnMySql.Open
   Set oRs = cnMySql.Execute(cSql)
   If oRs.EOF Then
      txtName.Text = ""
      TxtOneLiner.Text = ""
      txtSyntax.Text = ""
      txtDescription.Text = ""
      txtArguments.Text = ""
      txtExample.Text = ""
      txtReturns.Text = ""
      txtHbp.Text = ""
      txtLibrary.Text = ""
      txtSeeAlso.Text = ""
      txtAuthor.Text = ""
      txtRemarks.Text = ""
      txtLastUpdate.Text = ""
      txtCompliance.Text = ""
      txtCategory.Text = ""
      txtSubCategory.Text = ""
      txtOk.Text = ""
      txtAltCategory.Text = ""
   Else
      txtName.Text = oRs!Name
      TxtOneLiner.Text = oRs!OneLiner
      txtSyntax.Text = oRs!syntax
      txtDescription.Text = oRs!Description
      txtArguments.Text = oRs!arguments
      txtExample.Text = oRs!example
      txtReturns.Text = oRs!returns
      txtHbp.Text = oRs!hbp
      txtLibrary.Text = oRs!library
      txtSeeAlso.Text = oRs!seealso
      txtAuthor.Text = oRs!author
      txtRemarks.Text = oRs!Remarks
      txtLastUpdate.Text = oRs!LastUpdate
      txtCompliance.Text = oRs!Compliance
      txtCategory.Text = oRs!Category
      txtSubCategory.Text = oRs!SubCategory
      txtOk.Text = oRs!ok
      txtAltCategory.Text = oRs!altcategory
   End If
   oRs.Close
   Set oRs = Nothing
   cnMySql.Close
   End Function

Private Sub lblArguments_Click()
   Load frmEditText
   frmEditText.txtField = "Arguments"
   frmEditText.txtText.Text = txtArguments.Text
   frmEditText.Show vbModal
End Sub

Private Sub lblCompliance_Click()
   Load frmEditText
   frmEditText.txtField = "Compliance"
   frmEditText.txtText.Text = txtCompliance.Text
   frmEditText.Show vbModal
End Sub

Private Sub lblDescription_Click()
   Load frmEditText
   frmEditText.txtField = "Description"
   frmEditText.txtText.Text = txtDescription.Text
   frmEditText.Show vbModal
End Sub

Private Sub lblExample_Click()
   Load frmEditText
   frmEditText.txtField = "Example"
   frmEditText.txtText.Text = txtExample.Text
   frmEditText.Show vbModal
End Sub

Private Sub lblLastUpdate_Click()
txtLastUpdate.Text = Right(Str(Year(Now())), 4) & "-" & Right(Str(Month(Now()) + 100), 2) & "-" & Right(Str(Day(Now()) + 100), 2) & " " & Time()
End Sub

Private Sub lblRemarks_Click()
Load frmEditText
frmEditText.txtField = "Remarks"
frmEditText.txtText.Text = txtRemarks.Text
frmEditText.Show vbModal
End Sub

Private Sub lblReturns_Click()
   Load frmEditText
   frmEditText.txtField.Text = "Returns"
   frmEditText.txtText.Text = txtReturns.Text
   frmEditText.Show vbModal
End Sub

Private Sub lblSyntax_Click()
Load frmEditText
frmEditText.txtField = "Syntax"
frmEditText.txtText.Text = txtSyntax.Text
frmEditText.Show vbModal
End Sub

Private Sub txtName_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
   KeyAscii = 0
   cmdPesquisar_Click
End If
End Sub

por **JoséQuintas** » 15 Mar 2014 12:00

Recursos:
- Digita o nome da função e ENTER, pesquisa e trás o resultado - isso é no evento KeyPress (equivalente Inkey()) do campo do nome, verificando se digitou ENTER.
- Ao clicar nos títulos, abre a janela completa pra edição - isso é no evento Click de cada texto (label)
- Ao clicar no título da data, já preenche com a data atual (no título (label) da data, evento click)
- E botão salvar, que salva tudo.

E a parte de copiar (ctrl-C,ctrl-X)/colar (ctrl-v), desfazer (ctrl-z), etc. são automáticas.

Sem chance de fazer algo parecido em Harbour, somente com os recursos que conheço.
E provavelmente precisaria de muito mais código fonte.

Notas:
Não mexia no VB6 há alguns anos. Apenas fui fazendo, porque precisava alguma coisa pra facilitar atualizar os textos.
O fonte pra ADO é praticamente igual no Harbour, mas o memoedit() não teria os mesmos recursos.
E desenhar a tela via código fonte é compicado, a não ser que seja somente console.