Jo0o0oje hacker
New Member
سلام اگه ممكنه يكي در مورد اين كدا توضيح بده
خيلي فوريه
برا دفاعيه هست .ميخوام اگه ممكنه در مورد سورس برنامه توضيح داده بشه و اينكه چرا از اين توابع استفاده شده .
خيلي فوريه
پيشاپيش از مديران محترم تشكر ميكنم
خيلي فوريه
برا دفاعيه هست .ميخوام اگه ممكنه در مورد سورس برنامه توضيح داده بشه و اينكه چرا از اين توابع استفاده شده .
خيلي فوريه
پيشاپيش از مديران محترم تشكر ميكنم
'SAVE PROCEDURES
'===============
Public Function SaveEnabled()
If boolnew = False Then
MDIForm1.mnuSave.Enabled = True
MDIForm1.Toolbar1.Buttons(3).Enabled = True
MDIForm1.mnuSaveAs.Enabled = True
MDIForm1.Toolbar1.Buttons(4).Enabled = True
Else
MDIForm1.mnuSaveAs.Enabled = True
MDIForm1.Toolbar1.Buttons(4).Enabled = True
End If
End Function
Public Function SaveDisabled()
MDIForm1.mnuSaveAs.Enabled = False
MDIForm1.mnuSave.Enabled = False
MDIForm1.Toolbar1.Buttons(3).Enabled = False
MDIForm1.Toolbar1.Buttons(4).Enabled = False
End Function
Public Function SaveDoc()
If GetAttr(MDIForm1.CommonDialog1.FileName) And vbReadOnly Then
MsgBox MDIForm1.CommonDialog1.FileName & " Çíä í˜ ÝÇíá ÝÞØ ÎæÇäÏäí ÇÓÊ æ ÞÇÈá ÐÎíÑå ãÌÏÏ äíÓÊ"
bCannotSave = True
Exit Function
End If
If boolnew = True Then
frmOpenDoc.RichTextBox1.SelStart = 0
frmOpenDoc.RichTextBox1.SaveFile MDIForm1.CommonDialog2.FileName
boolsave = True
MDIForm1.mnuSave.Enabled = False
MDIForm1.Toolbar1.Buttons(3).Enabled = False
Else
frmOpenDoc.RichTextBox1.SelStart = 0
frmOpenDoc.RichTextBox1.SaveFile MDIForm1.CommonDialog1.FileName
boolsave = False
MDIForm1.mnuSave.Enabled = True
MDIForm1.Toolbar1.Buttons(3).Enabled = False
End If
End Function
Public Function SaveNew()
On Error GoTo ErrHandler
MDIForm1.CommonDialog2.Flags = &H2 'File exists
MDIForm1.CommonDialog2.ShowSave
frmOpenDoc.RichTextBox1.SaveFile MDIForm1.CommonDialog2.FileName
boolsave = False
ControlsDisabled
Exit Function
ErrHandler:
Cancel = True
End Function
Public Function SaveAs()
On Error GoTo ErrHandler
MDIForm1.CommonDialog2.Flags = &H2 'File exists
MDIForm1.CommonDialog2.ShowSave
frmOpenDoc.RichTextBox1.SaveFile MDIForm1.CommonDialog2.FileName
boolsave = False
boolnew = False
frmOpenDoc.Caption = MDIForm1.CommonDialog2.FileName
MDIForm1.StatusBar1.Panels(1).Text = MDIForm1.CommonDialog2.FileName
MDIForm1.mnuPrintPreview.Enabled = True: MDIForm1.Toolbar1.Buttons(7).Enabled = True
MDIForm1.mnuDelete.Enabled = True: MDIForm1.Toolbar1.Buttons(5).Enabled = True
Exit Function
ErrHandler:
Cancel = True
End Function
'CLOSING PROCEDURES
'==================
Public Function CloseNew()
Response = MsgBox(" ÂíÇ ÊÛííÑÇÊ ÐÎíÑå ÔæäÏ¿", vbQuestion + vbYesNoCancel)
MDIForm1.CommonDialog2.CancelError = True
On Error GoTo ErrHandler
Select Case Response
Case vbYes
Call SaveAs
Call CloseNew1
Case vbNo
Call ControlsDisabled
Call CloseNew1
End Select
Exit Function
ErrHandler:
Cancel = True
End Function
Public Function CloseModExisting()
If boolsave = True Then
Response = MsgBox("ÂíÇ ÊÛííÑÇÊ ÐÎíÑå ÔæäÏ¿ ", vbQuestion + vbYesNoCancel)
On Error GoTo ErrHandler
Select Case Response
Case vbYes
Call SaveDoc
If bCannotSave = False Then
Call CloseModExisting1
End If
Case vbNo
Call CloseModExisting1
End Select
Else
Call ControlsDisabled
frmOpenDoc.RichTextBox1.Visible = False
End If
ErrHandler:
Exit Function
End Function
Public Function CloseFile()
If boolnew = True And boolsave = True Then
Call CloseNew
Else
If boolsave = True Then
Call CloseModExisting
Else
Call ControlsDisabled
frmOpenDoc.RichTextBox1.Visible = False
End If
End If
End Function
'EXIT PROCEDURES
'===============
Public Function ExitDoc()
If boolsave = True And boolnew = True Then
Response = MsgBox(" ÂíÇ ÊÛííÑÇÊ ÐÎíÑå ÔæäÏ¿", vbQuestion + vbYesNoCancel)
MDIForm1.CommonDialog2.CancelError = True
On Error GoTo ErrHandler
Select Case Response
Case vbYes
Call SaveAs
End
Case vbNo
End
End Select
Else
If boolsave = True And boolnew = False Then
Response = MsgBox(" ÂíÇ ÊÛííÑÇÊ ÐÎíÑå ÔæäÏ¿", vbQuestion + vbYesNoCancel)
MDIForm1.CommonDialog2.CancelError = True
On Error GoTo ErrHandler
Select Case Response
Case vbYes
Call SaveDoc
End
Case vbNo
End
End Select
Else
End
End If
End If
ErrHandler:
Exit Function
End Function
'OPEN PROCEDURES
'===============
Public Function OpenDocument()
Call SaveDisabled
Dim currLine&
boolsave = False
boolnew = False
MDIForm1.CommonDialog1.CancelError = True
On Error GoTo ErrHandler
MDIForm1.CommonDialog1.ShowOpen
Screen.MousePointer = 11
DoEvents 'added to hide the Open dialog while loading.
MDIForm1.StatusBar1.Panels(1).Text = "ÈÑÇí ÈÇÒíÇÈí ÝÇíá äÏ áÍÙå ÕÈÑ ˜äíÏ..."
frmOpenDoc.Visible = True
frmOpenDoc.RichTextBox1.Visible = True
frmOpenDoc.WindowState = 0
frmOpenDoc.Width = Screen.Width * 0.89 ' Set width of form.
frmOpenDoc.Height = Screen.Height * 0.61 ' Set height of form.
frmOpenDoc.RichTextBox1.LoadFile MDIForm1.CommonDialog1.FileName
DoEvents
currLine& = SendMessageLong(frmOpenDoc.RichTextBox1.hwnd, EM_LINEFROMCHAR, -1&, 0&) + 1
MDIForm1.StatusBar1.Panels(4) = Format$(currLine&, "##,###")
MDIForm1.StatusBar2.Visible = False
frmOpenDoc.Caption = MDIForm1.CommonDialog1.FileName
frmOpenDoc.SetFocus
MDIForm1.StatusBar1.Panels(1) = MDIForm1.CommonDialog1.FileName
Screen.MousePointer = 0
Call ControlsEnabled
frmFind.Hide
frmReplace.Hide
boolnew = False
Exit Function
ErrHandler:
Exit Function
End Function
Public Function OpenDocMod()
Response = MsgBox(" ÂíÇ ÊÛííÑÇÊ ÐÎíÑå ÔæäÏ¿", vbQuestion + vbYesNoCancel)
MDIForm1.CommonDialog2.CancelError = True
On Error Resume Next
Select Case Response
Case vbYes
OpenDocModify
Case vbNo
ControlsDisabled
frmOpenDoc.Visible = False
Call OpenFile
End Select
frmFind.Hide
frmReplace.Hide
Exit Function
ErrHandler:
Exit Function
End Function
Public Function OpenFile()
If boolnew = True And boolsave = True Then
Call OpenDocMod
Else
If boolsave = True Then
Call OpenCloseModExisting
Else
Call OpenDocument
End If
End If
End Function
Public Function OpenCloseModExisting()
If boolnew = True And boolsave = True Then
Call OpenDocMod
Else
If boolsave = True Then
Response = MsgBox(" ÂíÇ ÊÛííÑÇÊ ÐÎíÑå ÔæäÏ¿", vbQuestion + vbYesNoCancel)
On Error GoTo ErrHandler
Select Case Response
Case vbYes
Call SaveDoc
Call OpenDocument
Case vbNo
Call OpenDocument
End Select
Else
Call OpenDocument
End If
frmFind.Hide
frmReplace.Hide
End If
Exit Function
ErrHandler:
Exit Function
End Function
Public Function DocUnload()
If boolnew = True And boolsave = True Then
Response = MsgBox(" ÂíÇ ÊÛííÑÇÊ ÐÎíÑå ÔæäÏ¿", vbQuestion + vbYesNoCancel)
MDIForm1.CommonDialog2.CancelError = True
On Error GoTo ErrHandler
Select Case Response
Case vbYes
On Error GoTo ErrHandler
MDIForm1.CommonDialog2.Flags = &H2 'File exists
MDIForm1.CommonDialog2.ShowSave
frmOpenDoc.RichTextBox1.SaveFile MDIForm1.CommonDialog2.FileName
boolsave = False
Exit Function
End
Case vbNo
End
End Select
Else
If boolsave = True Then
Response = MsgBox(" ÂíÇ ÊÛííÑÇÊ ÐÎíÑå ÔæäÏ¿", vbQuestion + vbYesNoCancel)
MDIForm1.CommonDialog2.CancelError = True
On Error GoTo ErrHandler
Select Case Response
Case vbYes
Call SaveDoc
If bCannotSave = False Then
End
End If
Case vbNo
End
End Select
Else
End
End If
End If
ErrHandler:
Cancel = True
End Function
'==============
'Creating the spelling object
Public Function Spelling()
Dim Speller As Object
Dim txt As String
Dim new_txt As String
Dim pos As Integer
MDIForm1.StatusBar1.Panels(1).Text = "ÈÇÒíÇÈí ÝÇíá ÛáØ ÇãáÇÆí ÇÒ ÈÑäÇãå æÑÏ ....."
On Error GoTo OpenError
Set Speller = CreateObject("Word.Basic")
On Error GoTo ErrorTrap
Screen.MousePointer = 11
Speller.FileNew
Speller.Insert frmOpenDoc.RichTextBox1.Text
Screen.MousePointer = 0
If boolnew = True Then
MDIForm1.StatusBar1.Panels(1) = MDIForm1.CommonDialog2.FileName
Else
MDIForm1.StatusBar1.Panels(1) = MDIForm1.CommonDialog1.FileName
End If
Speller.ToolsSpelling
Speller.EditSelectAll
txt = Speller.selection()
Speller.FileExit 2
If Right$(txt, 1) = vbCr Then
txt = Left$(txt, Len(txt) - 1)
new_txt = ""
pos = InStr(txt, vbCr)
Do While pos > 0
new_txt = new_txt & Left$(txt, pos - 1) & vbCrLf
txt = Right$(txt, Len(txt) - pos)
pos = InStr(txt, vbCr)
Loop
new_txt = new_txt & txt
frmOpenDoc.RichTextBox1.Text = new_txt
txt = ""
End If
MsgBox "The Spelling Check has completed "
txt = ""
Exit Function
OpenError:
' MsgBox "Error" & Str$(Error.Number) & " opening word." & vbCrLf & Error.Description
ErrorTrap:
Call ErrorTrap
End Function
Public Function ErrorTrap()
MsgBox "ÎØÇ Error# " + Str$(Err) + Chr(10) + Chr(13) + Chr(10) + Error$ + Chr(13) + Chr(10) + Chr(10) + "ÇÏÇãå "
End Function
Public Function NewModExisting()
If boolsave = True Then
Response = MsgBox(" ÂíÇ ÊÛííÑÇÊ ÐÎíÑå ÔæäÏ¿", vbQuestion + vbYesNoCancel)
On Error GoTo ErrHandler
Select Case Response
Case vbYes
Call SaveNew
Call NewModExisting1
MDIForm1.mnuPaste.Enabled = True
MDIForm1.Toolbar1.Buttons(14).Enabled = True
Case vbNo
Call ControlsDisabled
Call NewModExisting1
MDIForm1.mnuPaste.Enabled = True
MDIForm1.Toolbar1.Buttons(14).Enabled = True
End Select
Else
Call ControlsDisabled
MDIForm1.mnuTimeDate.Enabled = True
boolnew = True
frmOpenDoc.SetFocus
End If
ErrHandler:
Exit Function
End Function
Public Function OpenDocModify()
On Error GoTo ErrHandler
MDIForm1.CommonDialog2.Flags = &H2 'File exists
MDIForm1.CommonDialog2.ShowSave
frmOpenDoc.RichTextBox1.SaveFile MDIForm1.CommonDialog2.FileName
boolsave = False
Call OpenDocument
Exit Function
ErrHandler:
Cancel = True
End Function
Public Function PrintDoc()
'MDIForm1.CommonDialog3.CancelError = True
'On Error GoTo ErrHandler
'MDIForm1.CommonDialog3.ShowPrinter
'X = Printer.ScaleWidth / 2
'Y = Printer.ScaleHeight / 2
'Printer.CurrentX = X
'Printer.CurrentY = Y
'Printer.Circle Step(0, 0), 1500
'Printer.FillStyle = 0
'Printer.CurrentX = X
'Printer.CurrentY = Y + 800
'For i = O To 4
'Printer.FillColor = QBColor(i)
'Printer.Circle Step(0, -800), i * 200 + 100
'Next i
'Printer.CurrentX = 0
'Printer.CurrentY = 0
'Printer.FontSize = 24
'Printer.Print frmOpenDoc.RichTextBox1.Text
'Printer.EndDoc
'ErrHandler:
'Exit Function
'Printer.Print frmOpenDoc.RichTextBox1.Text
Printer.PrintQuality = vbPRPQMedium
With frmOpenDoc.RichTextBox1
.SaveFile MDIForm1.CommonDialog1.FileName, rtfRTF
.SelStart = 0
On Error Resume Next
While Len(.Text) > 0
Screen.MousePointer = 11
.SelLength = InStr(.SelStart + 1, .Text, vbCrLf) + 1
Printer.Font.Name = .SelFontName
Printer.Font.Size = .SelFontSize
Printer.Font.Bold = .SelBold
Printer.Print Mid(.SelText, 1, .SelLength)
.SelText = ""
.SelStart = 0
Wend
.LoadFile MDIForm1.CommonDialog1.FileName, rtfRTF
End With
Printer.EndDoc
Screen.MousePointer = 0
End Function
Public Function CloseModExistNewDoc()
If boolsave = True Then
Response = MsgBox(" ÂíÇ ÊÛííÑÇÊ ÐÎíÑå ÔæäÏ¿", vbQuestion + vbYesNoCancel)
On Error GoTo ErrHandler
Select Case Response
Case vbYes
Call SaveDoc
If bCannotSave = False Then
Call CloseDocument
End If
Case vbNo
Call CloseDocument
End Select
Else
Call ControlsDisabled
MDIForm1.mnuTimeDate.Enabled = True
frmOpenDoc.RichTextBox1.Visible = True
frmOpenDoc.SetFocus
End If
ErrHandler:
Exit Function
End Function
Public Sub CheckSoftware(X As Form)
Dim SaveTitle$
If App.PrevInstance Then
SaveTitle$ = App.Title
MsgBox "Çíä ÓäÏ ÞÈáÇ ÈÇÒ ÔÏå ÇÓÊ" + Chr(10) + Chr(13) + Chr(10) + "áØÝÇ ÂäÑÇ í˜ÈÇÑ ÈÈäÏíÏ æ ãÌÏÏÇ ÈÇÒ äãÇÆíÏ"
App.Title = ""
X.Caption = ""
AppActivate SaveTitle$
SendKeys "%{ENTER}", True
End
End If
End Sub
Public Function RichTextKeyDown()
If boolnew = True Then
Dim currLine&
On Local Error Resume Next
currLine& = SendMessageLong(frmOpenDoc.RichTextBox1.hwnd, EM_LINEFROMCHAR, -1&, 0&) + 1
With MDIForm1
.StatusBar1.Panels(4) = Format$(currLine&, "##,###")
.Toolbar1.Buttons(4).Enabled = True
.mnuSaveAs.Enabled = True
.Combo2.Enabled = True
.mnuPrint.Enabled = True: .Toolbar1.Buttons(6).Enabled = True
.mnuCut.Enabled = True: .Toolbar1.Buttons(12).Enabled = True
.mnuCopy.Enabled = True: .Toolbar1.Buttons(13).Enabled = True
.mnuPaste.Enabled = True: .Toolbar1.Buttons(14).Enabled = True
.mnuFind.Enabled = True
.mnuReplace.Enabled = True
.Toolbar1.Buttons(18).Enabled = True
.mnuFormatText.Enabled = True
.mnuWordCount.Enabled = True
.mnuSpelling.Enabled = True: .Toolbar1.Buttons(16).Enabled = True
.Toolbar1.Buttons(22).Enabled = True
.Toolbar1.Buttons(23).Enabled = True
.Toolbar1.Buttons(24).Enabled = True
.Toolbar1.Buttons(25).Enabled = True
.Toolbar1.Buttons(29).Enabled = True
.Toolbar1.Buttons(30).Enabled = True
.Toolbar1.Buttons(31).Enabled = True
.mnuSelectAll.Enabled = True
.mnuTimeDate.Enabled = True
boolsave = True
End With
Else
On Local Error Resume Next
currLine& = SendMessageLong(frmOpenDoc.RichTextBox1.hwnd, EM_LINEFROMCHAR, -1&, 0&) + 1
With MDIForm1
.StatusBar1.Panels(4) = Format$(currLine&, "##,###")
.Toolbar1.Buttons(4).Enabled = True: .mnuSaveAs.Enabled = True
.Toolbar1.Buttons(3).Enabled = True: .mnuSave.Enabled = True
.Combo2.Enabled = True
.mnuPrint.Enabled = True: .Toolbar1.Buttons(6).Enabled = True
.mnuCut.Enabled = True: .Toolbar1.Buttons(12).Enabled = True
.mnuCopy.Enabled = True: .Toolbar1.Buttons(13).Enabled = True
.mnuPaste.Enabled = True: .Toolbar1.Buttons(14).Enabled = True
.mnuFind.Enabled = True
.mnuReplace.Enabled = True
.Toolbar1.Buttons(18).Enabled = True
.mnuFormatText.Enabled = True
.mnuWordCount.Enabled = True
.mnuSpelling.Enabled = True: .Toolbar1.Buttons(16).Enabled = True
.Toolbar1.Buttons(22).Enabled = True
.Toolbar1.Buttons(23).Enabled = True
.Toolbar1.Buttons(24).Enabled = True
.Toolbar1.Buttons(25).Enabled = True
.Toolbar1.Buttons(29).Enabled = True
.Toolbar1.Buttons(30).Enabled = True
.Toolbar1.Buttons(31).Enabled = True
.mnuSelectAll.Enabled = True
.mnuTimeDate.Enabled = True
boolsave = True
End With
End If
End Function
Public Function CloseDocument()
Call ControlsDisabled
boolnew = True
With frmOpenDoc
.Visible = True
.RichTextBox1.Visible = True
.RichTextBox1.Enabled = True
.WindowState = 0
.SetFocus
.Width = Screen.Width * 0.89 ' Set width of form.
.Height = Screen.Height * 0.61 ' Set height of form. frmOpenDoc.Top = (Screen.Height - Height) / 20 ' Center form vertically.
.Caption = "ÓäÏ ÌÏíÏ"
End With
MDIForm1.StatusBar1.Panels(1).Text = "ÇíÌÇÏ í˜ ÓäÏ ÌÏíÏ"
MDIForm1.mnuTimeDate.Enabled = True
MDIForm1.Combo2.Enabled = True
End Function
Public Function NewModExisting1()
boolnew = True
MDIForm1.Combo2.Enabled = True
MDIForm1.mnuTimeDate.Enabled = True
MDIForm1.StatusBar1.Panels(1).Text = "ÇíÌÇÏ í˜ ÓäÏ ÌÏíÏ"
With frmOpenDoc
.Visible = True
.WindowState = 0
.SetFocus
.RichTextBox1.Enabled = True
' .Width = Screen.Width * 0.89 ' Set width of form.
' .Height = Screen.Height * 0.61 ' Set height of form.
' .Top = (Screen.Height - Height) / 20 ' Center form vertically.
.Caption = "ÓäÏ ÌÏíÏ"
End With
End Function
Public Function CloseModExisting1()
Call ControlsDisabled
boolnew = False
'MDIForm1.Combo2.Enabled = True
MDIForm1.StatusBar1.Panels(1).Text = "ÇíÌÇÏ í˜ ÓäÏ ÌÏíÏ"
With frmOpenDoc
.Visible = False
.RichTextBox1.Visible = False
.WindowState = 0
.Width = Screen.Width * 0.89 ' Set width of form.
.Height = Screen.Height * 0.61 ' Set height of form.
.Top = (Screen.Height - Height) / 20 ' Center form vertically.
.Caption = "ÓäÏ ÌÏíÏ"
End With
End Function
Public Function CloseNew1()
MDIForm1.mnuTimeDate.Enabled = True
MDIForm1.Combo2.Enabled = True
MDIForm1.StatusBar1.Panels(1).Text = "ÇíÌÇÏ í˜ ÓäÏ ÌÏíÏ"
With frmOpenDoc
.Visible = True
.RichTextBox1.Visible = True
.RichTextBox1.Enabled = True
.Width = Screen.Width * 0.89 ' Set width of form.
.Height = Screen.Height * 0.61 ' Set height of form. frmOpenDoc.Top = (Screen.Height - Height) / 400 ' Center form vertically.
.Caption = "ÓäÏ ÌÏíÏ"
End With
End Function
