有人能把vb代碼轉換成delphi嗎

Dim Classprint As New OpenRs '定義列印記錄集
Dim xlApp As New Excel.Application
Dim sendsql As String

Private Sub gridcs() '對grid所需求進行初始化
On Error GoTo finish
Select Case Grid1.Cell(hang, 7).Text
 Case "周一至周五"
   Grid2.Cols = 5 * nknumber + 1
   Grid3.Cols = 5 * nknumber + 1
 Case "周一至周六"
   Grid2.Cols = 6 * nknumber + 1
   Grid3.Cols = 6 * nknumber + 1
 Case "周一至周日"
   Grid2.Cols = 7 * nknumber + 1
   Grid3.Cols = 7 * nknumber + 1
End Select '以下是列出對應的教師資源以及班級資源
Grid2.Range(1, 1, Grid2.Rows - 1, Grid2.Cols - 1).ClearText
Grid3.Range(1, 1, Grid3.Rows - 1, Grid3.Cols - 1).ClearText
Set kc2 = cnn.Execute("select 占用 from 占用 where 教師姓名='" & Grid1.Cell(hang, 5).Text & "'")
For i = 1 To Grid2.Cols - 1
Grid2.Cell(1, i).Text = Mid(kc2.Fields(0), i, 1)
Next
Grid3.Range(1, 1, Grid3.Rows - 1, Grid3.Cols - 1).Alignment = cellCenterCenter
Set kc2 = cnn.Execute("select 占用 from 課程占用 where 班級='" & XPCombo1.Text & "'")
For i = 1 To Grid3.Cols - 1
Grid3.Cell(1, i).Text = Mid(kc2.Fields(0), i, 1)
Next
Exit Sub
finish:
MsgBox Err.Description
End Sub

Private Sub grid4hq() '獲取教師與班級之間的課程點
On Error GoTo finish
Grid4.Rows = 1
Dim m As Integer
For i = 1 To Grid2.Cols - 1 Step n '通過對比對教師與班級之間的可以排課點進行規納
  If Grid2.Cell(1, i).Text = "0" Then
   If Grid3.Cell(1, i).Text = "0" Then
    Grid4.Rows = Grid4.Rows + 1
    Grid4.Cell(Grid4.Rows - 1, 1).Text = i
    End If
 End If
 Next
 Exit Sub
finish:
MsgBox Err.Description
End Sub

Private Sub asPopup1_Click(Cancel As Boolean)
kctable = "登陸"
Form6.Caption = "用戶管理"
Form6.Show 1
End Sub

Private Sub asPopup10_Click(Cancel As Boolean)
kctable = "班級名稱"
Form6.Caption = "班級管理"
Form6.Show 1
End Sub

Private Sub asPopup2_Click(Cancel As Boolean)
kctable = "教學時間段"
Form5.Caption = "教學時間段設定"
Form5.Show 1
End Sub

Private Sub asPopup3_Click(Cancel As Boolean)
End
End Sub

Private Sub asPopup4_Click(Cancel As Boolean)
kctable = "課程名"
Form5.Caption = "課程管理"
Form5.Show 1
End Sub

Private Sub asPopup5_Click(Cancel As Boolean) '這里是對一些生成錯誤的資料進行還原
Dim vyes As String
vyes = MsgBox("當系統出現排課錯誤時進行的完全還原操作,確定嗎？", vbQuestion + vbYesNo, "提示")
If vyes = vbYes Then
Set kc2 = cnn.Execute("update 占用 set 占用='000000000000000000000000000000000000000000'")
Set kc2 = cnn.Execute("update 課程占用 set 占用='000000000000000000000000000000000000000000'")
End If
End Sub
…
這個是部分代碼
還有另外幾部分
幫同學做的畢業設計
Dim i, n As Integer
Private Declare Function GetKeyState Lib "user32" _
   (ByVal nVirtKey As Long) As Integer

Private Sub Form_Load()
Grid1.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^" '進行注冊
With Grid1
    .AllowUserResizing = True
    .DisplayFocusRect = False
    .ExtendLastCol = True
    .Appearance = Flat
    .FixedRowColStyle = Flat
    .ScrollBarStyle = Flat
    
    .DefaultFont.Name = "Tahoma"
    .DefaultFont.Size = 8
    .BackColorFixed = RGB(90, 158, 214)
    .BackColorFixedSel = RGB(110, 180, 230)
    .BackColorBkg = RGB(90, 158, 214)
    .BackColorScrollBar = RGB(231, 235, 247)
    .BackColor1 = RGB(231, 235, 247)
    .BackColor2 = RGB(239, 243, 255)
    .GridColor = RGB(148, 190, 231)
    .Column(0).Width = 0
    .Column(1).Width = 150
    .Column(2).Width = 100
    .Column(3).Width = 100
    .Column(3).Locked = True
End With
MsgBox "因為某此班級正在使用這里的某些資源，使用修改和洗掉有可能會造成不必要的損失！", vbInformation, "友情提示"
Call callmain
End Sub

Private Sub callmain()
kcsave = False
kcedit = True
kcdel = True
Set kc1 = cnn.Execute("select * from " & kctable)
Select Case kctable
Case "課程名", "教學時間段"
Grid1.Rows = 1 '清除所有記錄
i = 2
End Select

Grid1.Cols = i + 1 '必須+1,因為實際上為4行,但第一行是隱藏的
For i = 0 To i - 1  '顯示資料的欄位名
Grid1.Cell(0, i + 1).Text = kc1.Fields(i).Name  '讀取表中的各欄位名
Next
n = i
i = 1
Do While Not kc1.EOF
 Grid1.Rows = Grid1.Rows + 1
 For j = 1 To n '設定讀取列
 If kc1.Fields(j - 1) = Null Then '空值的處理
 Grid1.Cell(i, j).Text = ""
 Else
 Grid1.Cell(i, j).Text = kc1.Fields(j - 1)
 End If
 Next
  i = i + 1
 kc1.MoveNext '讀取下一記錄
Loop
Grid1.Column(1).Locked = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call XPButton5_Click
End Sub

Private Sub Grid1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
PopupMenu cz
End If
End Sub

Private Sub Grid1_RowColChange(ByVal Row As Long, ByVal Col As Long)
hang = Row
End Sub

Private Sub Grid1_Validate(Cancel As Boolean) '設定TAB鍵切換
Dim nActiveRow As Long, nActiveCol As Long
    Const VK_TAB = 9

    If GetKeyState(VK_TAB) < 0 Then
        nActiveRow = Grid1.ActiveCell.Row
        nActiveCol = Grid1.ActiveCell.Col
        If nActiveCol < Grid1.Cols - 1 Then
            Grid1.Range(nActiveRow, nActiveCol + 1, _
                        nActiveRow, nActiveCol + 1).Selected
        End If
        Cancel = True
    End If
    End Sub

Private Sub renovate_Click()
Call callmain
End Sub

Private Sub XPButton1_Click()
kcsave = True
kcedit = False
kcdel = False
Set kc1 = cnn.Execute("select * from " & kctable)
Grid1.Rows = 1 '清除所有記錄
Grid1.Rows = 2 '默認為2行
For i = 0 To 1   '顯示資料的欄位名
Grid1.Cell(0, i + 1).Text = kc1.Fields(i).Name  '讀取表中的各欄位名
Next
Grid1.Column(1).Locked = False
Grid1.Cell(1, 1).SetFocus
XPButton2.Default = True
End Sub

Private Sub XPButton2_Click()
If kcsave = False Then
MsgBox "不支持保存操作！", vbInformation, "當前不支持"
Exit Sub
End If
If Grid1.Cell(1, 1).Text <> "" Then
Set kc1 = cnn.Execute("select * from " & kctable & " where " & kc1.Fields(0).Name & "='" & Grid1.Cell(1, 1).Text & "' and " & kc1.Fields(1).Name & "='" & Grid1.Cell(1, 2).Text & "'")
  If kc1.EOF = True Then
   Set kc1 = cnn.Execute("insert into " & kctable & "( " & kc1.Fields(0).Name & "," & kc1.Fields(1).Name & ") values('" & Grid1.Cell(1, 1).Text & "','" & Grid1.Cell(1, 2).Text & "')")
    '---------------------為教師的時間占用作標記
    If kctable = "課程名" Then
    Dim num As Integer
     num = 7 * nknumber
     For i = 1 To num
     sql = sql & "0"
     Next
    Set kc2 = cnn.Execute("insert into 占用 values('" & Grid1.Cell(1, 2).Text & "','" & sql & "')")
End If
'------------------
  MsgBox "提交成功！", vbInformation, ""
  Call callmain
  Else
  MsgBox "資料不可重復！", vbInformation, "不可重復"
  Exit Sub
  End If
Else
MsgBox "物件不可以是空格", vbInformation, "錯誤提示"
End If
End Sub

Private Sub XPButton3_Click()
If kcedit = False Then
MsgBox "當前修改操作不被允許!", vbInformation, "非使用物件"
Exit Sub
End If
      For i = 1 To Grid1.Rows - 1
            Set kc2 = cnn.Execute("update " & kctable & " set " & kc1.Fields(0).Name & "='" & Grid1.Cell(i, 1).Text & "'," & kc1.Fields(1).Name & "='" & Grid1.Cell(i, 2).Text & "' where " & kc1.Fields(0).Name & "='" & Grid1.Cell(i, 1).Text & "'")
        Next
     MsgBox "修改的資料己經完成", vbInformation, "完成操作"
     Call callmain
End Sub

Private Sub XPButton4_Click()
If kcdel = False Then
MsgBox "當前洗掉操作不被允許!", vbInformation, "非使用物件"
Exit Sub
End If
If hang = 0 Then
Exit Sub
End If
If Grid1.Cell(hang, 1).Text = "" Then
Exit Sub
End If
  Set kc1 = cnn.Execute("delete from " & kctable & " where " & kc1.Fields(0).Name & "='" & Grid1.Cell(hang, 1).Text & "' and " & kc1.Fields(1).Name & "='" & Grid1.Cell(hang, 2).Text & "'")
  MsgBox "目標己洗掉,請重繪資料!", vbInformation, "洗掉成功"
Call callmain
End Sub

Private Sub XPButton5_Click()
 Set kc2 = cnn.Execute("select * from 教學時間段 order by 自動編號 asc")
 i = 1
 Do While Not kc2.EOF
 formmain.Grid5.Cell(i, 0).Text = kc2.Fields(0)
 i = i + 1
 kc2.MoveNext
 Loop
Unload Me
End Sub







另外部分
Private Declare Sub ReleaseCapture Lib "user32" () '支持移動API
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Sub Form_Load()
Me.Picture = LoadPicture(App.Path & "\images\login.jpg")
Text1.BackColor = RGB(83, 82, 132)
Text2.BackColor = RGB(83, 82, 132)
End Sub

Private Sub Image1_Click()
On Error GoTo finish
Set kc1 = cnn.Execute("select * from 登陸 where 用戶名='" & Text1.Text & "' and 密碼='" & Text2.Text & "'")
If kc1.EOF = True Then
 If pnum < 2 Then
 pnum = pnum + 1
 MsgBox "用戶名或密碼錯誤!", vbInformation, "錯誤次數：" & pnum
 Text1.Text = ""
 Text2.Text = ""
 Text1.SetFocus
 Exit Sub
 Else
 MsgBox "用戶名或密碼錯誤超過三次,系統會自動退出", vbInformation, "提示"
 End
 End If
Else
 If kc1.Fields(2) = "超級管理員" Then
 admin = True
 Else
 admin = False
 End If
 Unload Me
 formmain.Show
End If
Exit Sub
finish:
    MsgBox Err.Description
End Sub

Private Sub Image2_Click()
End
End Sub
Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ReleaseCapture '以下的移動方式更簡便
    SendMessage Me.hwnd, &HA1, 2, 0&
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call Image1_Click
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call Image1_Click
End If
End Sub
哪位大蝦要是幫我轉換完了發我郵箱一份吧[email protected]

uj5u.com熱心網友回復：

如此長先收藏一下，有時間幫你翻譯。
還有，ＶＢ里的Ｆｏｒｍ和Delphi不同，確定要直譯么？

uj5u.com熱心網友回復：

汗，你這樣問，打死也不會有人幫你轉的

uj5u.com熱心網友回復：

沒事，后天我應該有空。。

uj5u.com熱心網友回復：

幫同學做的畢業設計，vb代碼段已經寫出來了，但是他的開題報告上竟然說用delphi7寫，年前的時候要弄完，再學delphi已經來不及了

uj5u.com熱心網友回復：

參考 4 樓 aloneboy110 的回復:

幫同學做的畢業設計，vb代碼段已經寫出來了，但是他的開題報告上竟然說用delphi7寫，年前的時候要弄完，再學delphi已經來不及了

可憐的孩紙。。

uj5u.com熱心網友回復：

要不要我當面致謝呀，要是我離你比較近的話，呵呵

uj5u.com熱心網友回復：

參考 6 樓 aloneboy110 的回復:

要不要我當面致謝呀，要是我離你比較近的話，呵呵

不用了

uj5u.com熱心網友回復：

你給我你的電話吧，一句半句的也說不清楚，在qq上留言，把你電話給我吧，我打電話給你，好吧

估計直譯的話應該不能運行吧，也說不上來，估計導師應該不會運行程式吧，其實就是個排課的程式，后臺鏈接SQL server資料庫

uj5u.com熱心網友回復：

參考 8 樓 aloneboy110 的回復:

你給我你的電話吧，一句半句的也說不清楚，在qq上留言，把你電話給我吧，我打電話給你，好吧

估計直譯的話應該不能運行吧，也說不上來，估計導師應該不會運行程式吧，其實就是個排課的程式，后臺鏈接SQL server資料庫

幫頂

LZ把這個程式相關的代碼及資料庫做個資源, 這樣有人幫著轉的話也能知道基本的界面和功能; 只轉代碼的話, 就跟幫你寫個程式沒什么區別了

轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/146372.html

標籤：語言基礎/算法/系統設計

上一篇：主任何如何等待執行緒執行完程，

下一篇：尚未呼叫coinitialize錯誤,補充代碼加在哪個pas