по мотивам От забав к делу
изменив интерфейс, подправив алгоритм, добавив функционал (анализирует IncludeFile и др.)
получил MakeProcDecl.exe
;- Window Constants Enumeration #Window_0 EndEnumeration ;- Gadget Constants Enumeration #Text_0 #Text_1 #String_0 #Button_Select #Button_Start #Editor EndEnumeration Procedure.s GetSysErrorText(ErrCode) Define result.s="" *Memory = AllocateMemory (255) length = FormatMessage_ (#FORMAT_MESSAGE_FROM_SYSTEM, #Null, ErrCode, 0, *Memory, 255, #Null) result=PeekS (*Memory, length - 2) FreeMemory (*Memory) ProcedureReturn result EndProcedure Procedure FatalError() Protected Result$, Line Result$="FatalError(): " Line = ErrorLine() If Line>=0 Result$+" в строке "+Str(Line)+", файла: "+ErrorFile() EndIf Result$+" Ошибка типа: "+Chr(34)+ErrorMessage()+Chr(34) MessageRequester("Фатальная ошибка выполнения", Result$, #PB_MessageRequester_Ok ) End EndProcedure Procedure getMyFile() Filename$ = OpenFileRequester("Выбрать файл для проверки", "", "Все файлы|*.*", 0) If Len(Filename$)>0 SetGadgetText(#String_0,Filename$) EndIf EndProcedure Procedure Open_Window_0() Protected Result.b= #False If OpenWindow(#Window_0, 281, 107, 570, 250, "Список процедур для заданного исходника (Используйте Drag&Drop)", #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered|#PB_Window_SizeGadget) TextGadget(#Text_0, 10, 10, 50, 20, "Файл : ", #PB_Text_Right) StringGadget(#String_0, 60, 10, 440, 20, "") TextGadget(#Text_1, 10, 40, 450, 40, "Список необходимых деклараций процедур для заданного исходника"+Chr(13)+Chr(10)+"Скопируйте Ctrl+C/Ctrl+V нужные строки в начало текста исходника") ButtonGadget(#Button_Select, 510, 10, 50, 20, ". . .") ButtonGadget(#Button_Start, 510, 43, 50, 20, "Start") EditorGadget(#Editor, 10, 80, 540, 160) EnableWindowDrop(#Window_0, #PB_Drop_Files, #PB_Drag_Link) Result=#True EndIf ProcedureReturn Result EndProcedure Procedure MakeProcedureList(SourceFileName$) Protected FileRefNum SetGadgetText(#Editor,GetGadgetText(#Editor)+Chr(13)+Chr(10)+Chr(13)+Chr(10)+"; Source: "+SourceFileName$) FileRefNum=ReadFile(#PB_Any,SourceFileName$) If Not FileRefNum ;ReadFile(0,SourceFileName$) MessageRequester("Опа...!!!", "Облом при попытке открыть файл <"+SourceFileName$+">") Else While Not(Eof(FileRefNum)) a.s=ReadString(FileRefNum) a=Trim(a) a=Trim(a,Chr(9)) ffs.s=StringField(a,1," ") If LCase(Left(ffs,9))="procedure" And Len(ffs)<14 count+1 gypsy.s=Mid(a,10) pname.s="declare"+gypsy If pname VoidName.s=StringField(pname,1,";") If voidname SetGadgetText(#Editor,GetGadgetText(#Editor)+Chr(13)+Chr(10)+VoidName ) Else If MessageRequester("Опа,,,!"," Возможно, этот исходник содержит ошибки. Все равно продолжить?")=#PB_MessageRequester_Yes SetGadgetText(#Editor,GetGadgetText(#Editor)+Chr(13)+Chr(10)+VoidName ) Else Break EndIf EndIf EndIf ElseIf LCase(Left(a,11))="includefile" IncFile$=StringField(a,2,Chr(34)) ;" MakeProcedureList(GetPathPart(SourceFileName$)+IncFile$) EndIf Wend SetGadgetText(#Editor,GetGadgetText(#Editor)+Chr(13)+Chr(10)+"; -------------- "+GetFilePart(SourceFileName$)+Chr(13)+Chr(10)) CloseFile(FileRefNum) EndIf EndProcedure OnErrorCall(@FatalError()) If Not Open_Window_0(): End: EndIf ;{- Event loop Repeat Event = WaitWindowEvent() ; ждать события EventWindow = EventWindow() ; какое окно поимело событие Select Event ; ------------------------------ Case #PB_Event_Gadget EventGadget = EventGadget() EventType = EventType() If EventGadget = #Button_Select getMyFile() SetGadgetText(#Editor,"") ;ClearList(FuncList()) MakeProcedureList(GetGadgetText(#String_0)) ElseIf EventGadget = #Button_Start SetGadgetText(#Editor,"") ;ClearList(FuncList()) MakeProcedureList(GetGadgetText(#String_0)) EndIf ; ---------------------------- Case #PB_Event_SizeWindow h=WindowHeight(#Window_0) If h<250: h=250: EndIf ResizeWindow(#Window_0, #PB_Ignore, #PB_Ignore, 570, h) ResizeGadget(#Editor, #PB_Ignore, #PB_Ignore, #PB_Ignore, h-80-10) Case #PB_Event_WindowDrop ;перетягивание файла в окно программы Rep.s=EventDropFiles() SetGadgetText(#String_0,Rep) SetGadgetText(#Editor,"") MakeProcedureList(GetGadgetText(#String_0)) Case #PB_Event_CloseWindow If EventWindow = #Window_0 CloseWindow(#Window_0) Break EndIf EndSelect ForEver ;} End
Запустить exe-шник.
задать файл исходника
написав вручную в поле ввода (ха-ха-ха) и нажать <Старт>
или выбрав визуально кнопкой <...> (уже лучше)
или бросив файл на форму методом D&D (самый лучший вариант)
Пример с тремя IncludeFile
; Source: D:\PureBasic_projects\Japan_with_Draw\Japan.pb
declare IsSoundPlaying(Sound)
declare OpenWindow_Window_0(); Source: D:\PureBasic_projects\Japan_with_Draw\Japan1.pb
declare ShowTable()
declare Show()
declare ClearLines()
declare DrawLines()
declare.b CheckStat()
declare DrawVictory()
declare Save1()
; -------------- Japan1.pb; Source: D:\PureBasic_projects\Japan_with_Draw\Japan2.pb
declare SaveCurrentID()
declare DataExtract(txt.s)
declare.b JapSelectOk()
declare.b JapSelect()
; -------------- Japan2.pb; Source: D:\PureBasic_projects\Japan_with_Draw\Japan3.pb
declare DelSaver()
declare ShowSavers()
declare.b Rest_Ok()
declare DataExtract2()
declare.b JapRestore()
; -------------- Japan3.pbdeclare.b FindCell()
declare Go_Back()
declare Sound_Change(p.b)
declare SoundNext()
declare Sound_Victory()
; -------------- Japan.pb
Отредактировано SadStar (17.07.2012 07:14:24)