PureBasic Forums - English

Code: Select all

    ;
    ; NotePB.pb : a Notepad starter with some limitations at this step, like a 64K limit.
    ;
    ; This code is sent to the forum for teaching, but might not be used without author's acknoledge.
    ; It actually is part of author's publications and is not free of rights.
    ; More functionalities are available, with customized GUI by request to fweil@internext.fr
    ;
    ; This PureBasic source code program will run only on Windows compatible platforms for users executing a licensed PureBasic.
    ;
    ; FWeil : 20040517
    ;
    ; Comments available for PB forum users.
    ;
    #Quit = 99 ; Following constants are given for source readability.
    #EditorGadget = 10
    #MenuItem_New = 11
    #MenuItem_Open = 12
    #MenuItem_Save = 13
    #MenuItem_SaveAs = 14
    #MenuItem_Close = 15
    #MenuItem_Exit = 16
    #MenuItem_Find = 25
    #MenuItem_FindNext = 26
    #MenuItem_Replace = 27
    #MenuItem_Font = 31
    #MenuItem_Help = 41
    #MenuItem_Apropos = 42
    #Window_Main = 0
    #StatusBar = 0
    #Menu = 0

    #TTS_RECTANGULAR = $10 ; API constants unknown from PureBasic defining tooltip types
    #TTS_RECTANGULARLIFT = $20
    #TTS_BALLOON = $40

    Global FileName.s, NLines, NChars, FontName.s, FontSize, FontColor, FontStyle

    Procedure AddToolTip(Handle, Text.s) ; This replaces the GadgetToolTip procedure of PureBasic giving a higher quality tooltip for gadgets. API based.
      hToolTip = CreateWindowEx_(0, "tooltips_class32", "", $D0000000 | #TTS_BALLOON, 0, 0, 0, 0, WindowID(#Window_Main), 0, GetModuleHandle_(0), 0) ; Tooltip window creation
      SendMessage_(hToolTip, #RB_SETTEXTCOLOR - 1, $C0FFFF, 0) ; Foreground color tooltip : Don't know why #RB_SETTEXTCOLOR - 1 !
      SendMessage_(hToolTip, #RB_SETBKCOLOR, $400000, 0) ; Background color tooltip
      SendMessage_(hToolTip, #RB_SIZETORECT + 1, 0, 180) ; Maximum width of tooltip : Don't know why #RB_SIZETORECT + 1 !
      Button.TOOLINFO\cbSize = SizeOf(TOOLINFO) ; Structure information fulfillment
      Button\uFlags = #TTF_IDISHWND | #TTF_SUBCLASS ; Indicates that the uId member is the window handle to the tool. If this flag is not set, uId is the identifier of the tool. | Indicates that the tooltip control should subclass the tool's window to intercept messages, such as WM_MOUSEMOVE. If not set, you need to use the TTM_RELAYEVENT message to forward messages to the tooltip control. For a list of messages that a tooltip control processes, see TTM_RELAYEVENT.
      Button\hWnd = Handle
      Button\uId = Handle
      Button\lpszText = @Text
      SendMessage_(hToolTip, #RB_SETBARINFO, 0, Button) ; Send structure content to the tooltip window.
    EndProcedure

    Procedure SavePreferences(IniFileName.s)
      If CreatePreferences(IniFileName)
          WritePreferenceString("FontName", FontName)
          WritePreferenceLong("FontSize", FontSize)
          WritePreferenceLong("FontColor", FontColor)
          WritePreferenceLong("FontStyle", FontStyle)
          ClosePreferences()
      EndIf
    EndProcedure

    Procedure MenuItemWithShortcut(MenuItem, ItemText.s, Shortcut) ; Procedure to set both a menu item and the corresponding keyboard shortcut.
      MenuItem(MenuItem, ItemText)
      AddKeyboardShortcut(#Window_Main, Shortcut, MenuItem)
    EndProcedure

    Procedure ClearAll() ; Clear either the gadget's content and associated variables.
      SetGadgetText(#EditorGadget, "")
      FileName = ""
      NLines = 0
      NChars = 0
    EndProcedure

    Procedure HighlightSelection(Handle, a, b)
      If a And b
          SendMessage_(Handle, #EM_SETSEL, a, b) ; Send a set selection message to the given handle. API call. Highlight chars from a to b in the gadget corresponding to the given Handle.
          SendMessage_(Handle, #EM_SCROLLCARET, 0, 0) ; Send a scroll caret message to the given handle. API call. Scrolls the gadget corresponding to the given Handle to show the highlighted chars.
      EndIf
    EndProcedure

    Procedure SaveContent(ThisFileName.s) ; Check if the gadget content save to file is possible and do it.
      If CreateFile(0, ThisFileName)
          If NChars <= 64000
              WriteString(0,GetGadgetText(#EditorGadget))
              CloseFile(0)
              FileName = ThisFileName
            Else
              MessageRequester("Warning", "Save of more than 63999 chars is not possible", #PB_MessageRequester_Ok)
          EndIf
        Else
          MessageRequester("Warning", "File " + ThisFileName + " creation not possible", #PB_MessageRequester_Ok)
      EndIf
    EndProcedure

    Procedure MyStatusBar()
      CreateStatusBar(#StatusBar, WindowID(#Window_Main))
        AddStatusBarField(150)
        AddStatusBarField(450)
    EndProcedure

    ;
    ; Main start here.
    ;
      FontName = "Verdana" ; Any existing font name.
      FontSize = 12 ; Any existing font size.
      FontColor = #Black ; Any RGB value.  #Black is a PureBasic's constant equal to 0.
      FontStyle = 0 ; 0, #PB_Font_Bold, #PB_Font_Italic.
      CR.s = Chr(13)
      LF.s = Chr(10)
      EOL.s = CR + LF
      TAB.s = Chr(9)
      CurrentDirectory.s = Space(#MAX_PATH) ; #MAX_PATH is an API constant to set the maximum length of a path name (actually 260).
      FileName = ""
      GetCurrentDirectory_(#MAX_PATH, CurrentDirectory) ; Set CurrentDirectory to the program start directory.
      WorkingDirectory.s = CurrentDirectory ; Backup CurrentDirectory.
      ProgramName.s = "NotePB 2" ; Used for main window title and ini file name.
      If OpenPreferences(ProgramName + ".ini") ; Try to read ini file values or create a new ini file with default values.
          FontName = ReadPreferenceString("FontName", FontName)
          FontSize = ReadPreferenceLong("FontSize", FontSize)
          FontColor = ReadPreferenceLong("FontColor", FontColor)
          FontStyle = ReadPreferenceLong("FontStyle", FontStyle)
          ClosePreferences()
        Else
          SavePreferences(ProgramName + ".ini") ; Save ini file values.
      EndIf
      Quit = #False
      hWnd = OpenWindow(#Window_Main, 0, 0, 320, 240, ProgramName, #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered)
      If hWnd
          AddKeyboardShortcut(#Window_Main, #PB_Shortcut_Escape, #Quit)

            SetGadgetFont(#PB_Default, LoadFont(0, FontName, FontSize, FontStyle)) ; Change the gadget's font using font name, size and style.
            hEditorGadget = EditorGadget(#EditorGadget, 10, 0, WindowWidth(#Window_Main) - 20, WindowHeight(#Window_Main) - 40) ; Create the new gadget.
            AddToolTip(hEditorGadget, "You may use any menu and shortcut" + EOL + "also including Windows usual shortcuts for :" + EOL + "Cut (CTRL+X)" + EOL + "Copy (CTRL+C)" + EOL + "Paste (CTRL+V)" + EOL + "Select All (CTRL+A)")
            format.CHARFORMAT\cbSize = SizeOf(CHARFORMAT) ; Prepare color attributes in the appropriate structure for sending info to the gadget.
            format\dwMask = #CFM_COLOR ; API constant. The crTextColor member and the CFE_AUTOCOLOR value of the dwEffects member are valid.
            format\crTextColor = FontColor ; Text color. This member is ignored if the CFE_AUTOCOLOR character effect is specified. Update font color after calling FontRequester.
            SendMessage_(hEditorGadget, #EM_SETCHARFORMAT, 0, @format) ; Send the color information to the gadget. API call.
          CreateMenu(#Menu, hWnd) ; Generate the menu with titles and items. ALT + title's first letter activates a menu entry. By pushing keyboard's buttons corresponding to & letter of any item validates the item.
            MenuTitle("File")
              MenuItemWithShortcut(#MenuItem_New, "&New" + TAB + "CTRL+N", #PB_Shortcut_Control | #PB_Shortcut_N)
              MenuItemWithShortcut(#MenuItem_Open, "&Open" + TAB + "CTRL+O", #PB_Shortcut_Control | #PB_Shortcut_O)
              MenuItemWithShortcut(#MenuItem_Save, "&Save" + TAB + "CTRL+S", #PB_Shortcut_Control | #PB_Shortcut_S)
              MenuItemWithShortcut(#MenuItem_SaveAs, "Save &As" + TAB + "MAJ+CTRL+S", #PB_Shortcut_Control | #PB_Shortcut_S | #PB_Shortcut_Shift)
              MenuItemWithShortcut(#MenuItem_Close, "&Close" + TAB + "CTRL+W", #PB_Shortcut_Control | #PB_Shortcut_W)
              MenuBar()
              MenuItemWithShortcut(#MenuItem_Exit, "&Exit" + TAB + "CTRL+Q", #PB_Shortcut_Control | #PB_Shortcut_Q)
            MenuTitle("Edit")
              MenuItemWithShortcut(#MenuItem_Find, "&Find" + TAB + "CTRL+F", #PB_Shortcut_Control | #PB_Shortcut_F)
              MenuItemWithShortcut(#MenuItem_FindNext, "&Next" + TAB + "F3", #PB_Shortcut_F3)
              MenuItemWithShortcut(#MenuItem_Replace, "&Replace" + TAB + "CTRL+H", #PB_Shortcut_Control | #PB_Shortcut_H)
            MenuTitle("Display")
              MenuItemWithShortcut(#MenuItem_Font, "&Font" + TAB + "MAJ+CTRL+F", #PB_Shortcut_Control | #PB_Shortcut_F | #PB_Shortcut_Shift)
            MenuTitle("Help")
              MenuItemWithShortcut(#MenuItem_Help, "&Help" + TAB + "F1", #PB_Shortcut_F1)
              MenuItemWithShortcut(#MenuItem_Apropos, "&Apropos" + TAB + "F12", #PB_Shortcut_F12)
          MyStatusBar()
          Repeat ; Here is the main event loop. It is WaitWindowEvent based. Three entries are given here : #PB_EventCloseWindow, #PB_EventMenu and #WM_SIZE.
            Select WaitWindowEvent()
              Case #PB_Event_CloseWindow ; Switch Quit flag for exiting.
                Quit = #True
              Case #PB_Event_Menu ; Menu events generated either by keyboard shortcuts or menu items.
                Select EventMenu()
                  Case #MenuItem_New ; New generates only a gadget's content clear and associated variables reset.
                    ClearAll()
                  Case #MenuItem_Open ; Opening a file after clearing previous gadget's content and then filling the gadget with file's content.
                    ClearAll()
                    FileName = OpenFileRequester("Select the file to open", WorkingDirectory + "\" + FileName, "*.*", 0)
                    If ReadFile(0, FileName)
                        Repeat
                          a$ = ReadString(0)
                          AddGadgetItem(#EditorGadget, NLines, a$)
                          NLines + 1 ; NLines and NChars are statistics but also NLines is used in search function.
                          NChars + Len(a$) + 2
                        Until Eof(0)
                        CloseFile(0)
                    EndIf
                  Case #MenuItem_Save ; Save the gadget's content to the previously loaded file.
                    SaveContent(FileName)
                  Case #MenuItem_SaveAs ; Save the gadget's content to any given file name if possible.
                    SaveContent(SaveFileRequester("Select the file to save", WorkingDirectory + "\" + FileName, "*.*", 0))
                  Case #MenuItem_Close ; Close is redundant with New.
                    ClearAll()
                  Case #MenuItem_Exit ; Switch the Quit flag for exiting the program. Redundant with other closing ways.
                    Quit = #True
                  Case #MenuItem_Find ; Ask the user for a search mask and scroll to the first occurrence found.
                    Text.s = InputRequester("Find", "Enter text to find", Text)
                    a$ = GetGadgetText(#EditorGadget)
                    b$ = ReplaceString(a$, EOL, LF)
                    StartPos = FindString(b$, Text, 1) - 1
                    HighlightSelection(hEditorGadget, StartPos, StartPos + Len(Text))
                  Case #MenuItem_FindNext ; Scroll to the next occurrence of the search mask. Search is circular and moves back to top of the content after touching the end.
                    a$ = GetGadgetText(#EditorGadget)
                    b$ = ReplaceString(a$, EOL, LF)
                    StartPos = FindString(b$ , Text, StartPos + Len(Text)) - 1 ; Find the next mask position.
                    HighlightSelection(hEditorGadget, StartPos, StartPos + Len(Text))
                  Case #MenuItem_Replace ; Replace all Text occurences with ReplaceText in the gadget's content
                    Text.s = InputRequester("Find", "Enter text to find", Text)
                    ReplaceText.s = InputRequester("Find", "Replace with", ReplaceText)
                    a$ = GetGadgetText(#EditorGadget)
                    b$ = ReplaceString(a$, Text, ReplaceText)
                    SetGadgetText(#EditorGadget, b$)
                  Case #MenuItem_Font ; Open a font requester with enhanced attributes for changing style and color. Bad trick : the color and style prepositioning is not possible at the moment.
                    FontRequester(FontName, FontSize, #PB_FontRequester_Effects)
                    FontName = SelectedFontName() ; Update font name after calling FontRequester.
                    If SelectedFontSize() ; Update font size after calling FontRequester. This is conditional because of when clicking Cancel a 0 value returns.
                        FontSize = SelectedFontSize()
                    EndIf
                    FontColor = SelectedFontColor() ; Update font color after calling FontRequester.
                    FontStyle = SelectedFontStyle() ; Update font style after calling FontRequester.
                    a$ = GetGadgetText(#EditorGadget) ; Because it is necessary to destroy the gadget before redraw it with the new font and attributes, we have to save the gadget's content first to reload it after creating the new gadget.
                    FreeGadget(#EditorGadget) ; Destroy the former gadget.
                    SetGadgetFont(#PB_Default, LoadFont(0, FontName, FontSize, FontStyle)) ; Change the gadget's font using font name, size and style.
                    hEditorGadget = EditorGadget(#EditorGadget, 10, 0, WindowWidth(#Window_Main) - 20, WindowHeight(#Window_Main) - 40) ; Create the new gadget.
                    AddToolTip(hEditorGadget, "You may use any menu and shortcut" + EOL + "also including Windows usual shortcuts for :" + EOL + "Cut (CTRL+X)" + EOL + "Copy (CTRL+C)" + EOL + "Paste (CTRL+V)" + EOL + "Select All (CTRL+A)")
                    format.CHARFORMAT\cbSize = SizeOf(CHARFORMAT) ; Prepare color attributes in the appropriate structure for sending info to the gadget.
                    format\dwMask = #CFM_COLOR ; API constant. The crTextColor member and the CFE_AUTOCOLOR value of the dwEffects member are valid.
                    format\crTextColor = FontColor ; Text color. This member is ignored if the CFE_AUTOCOLOR character effect is specified. Update font color after calling FontRequester.
                    SendMessage_(hEditorGadget, #EM_SETCHARFORMAT, 0, @format) ; Send the color information to the gadget. API call.
                    SetGadgetText(#EditorGadget, a$) ; Fill the new gadget with the content previously stored.
                  Case #MenuItem_Help
                    HelpMessage.s = "NotePB 2 - On line Help" + EOL
                    HelpMessage = HelpMessage + "" + EOL
                    HelpMessage = HelpMessage + "You may use any menu and shortcut" + EOL
                    HelpMessage = HelpMessage + "" + EOL
                    HelpMessage = HelpMessage + "File New = CTRL+N" + EOL
                    HelpMessage = HelpMessage + "File Open = CTRL+O" + EOL
                    HelpMessage = HelpMessage + "File Save = CTRL+S" + EOL
                    HelpMessage = HelpMessage + "File Save As = MAJ+CTRL+S" + EOL
                    HelpMessage = HelpMessage + "File Close = CTRL+W" + EOL
                    HelpMessage = HelpMessage + "Program Exit = CTRL+Q" + EOL
                    HelpMessage = HelpMessage + "Find text = CTRL+F" + EOL
                    HelpMessage = HelpMessage + "Find next = F3" + EOL
                    HelpMessage = HelpMessage + "Replace text = CTRL+H" + EOL
                    HelpMessage = HelpMessage + "Change Font = MAJ+CTRL+F" + EOL
                    HelpMessage = HelpMessage + "Program Help = F1" + EOL
                    HelpMessage = HelpMessage + "Program apropos = F12" + EOL
                    HelpMessage = HelpMessage + "" + EOL
                    HelpMessage = HelpMessage + "also including Windows usual shortcuts for :" + EOL
                    HelpMessage = HelpMessage + "" + EOL
                    HelpMessage = HelpMessage + "Cut (CTRL+X)" + EOL
                    HelpMessage = HelpMessage + "Copy (CTRL+C)" + EOL
                    HelpMessage = HelpMessage + "Paste (CTRL+V)" + EOL
                    HelpMessage = HelpMessage + "Select All (CTRL+A)"
                    MessageRequester("NotePB 2 - Help", HelpMessage, #PB_MessageRequester_Ok)
                  Case #MenuItem_Apropos
                    HelpMessage.s = "NotePB 2 - Apropos" + EOL
                    HelpMessage = HelpMessage + "" + EOL
                    HelpMessage = HelpMessage + "Designed by fweil@internext.fr" + EOL
                    HelpMessage = HelpMessage + "This release is NotePB 2 : published 2004/05/17" + EOL
                    HelpMessage = HelpMessage + "" + EOL
                    HelpMessage = HelpMessage + "This program is not a freeware." + EOL
                    HelpMessage = HelpMessage + "Please contact us for more information" + EOL
                    MessageRequester("NotePB 2 - Apropos", HelpMessage, #PB_MessageRequester_Ok)
                  Case #Quit ; Switch Quit flag for exiting the program.
                    Quit = #True
                  Default
                EndSelect
              Case #PB_Event_Gadget
                Select EventGadget()
                  Case #EditorGadget
                    *Buffer = AllocateMemory(64000)
                    Debug SendMessage_(hEditorGadget, #EM_GETSELTEXT, 0, *Buffer)
                    TextCapture.s = PeekS(*Buffer)
                    FreeMemory(*Buffer)
                EndSelect
              Case #WM_SIZE ; This event corresponds to the window size change. #WM_SIZE is an API constant
                ResizeGadget(#EditorGadget, 10, 0, WindowWidth(#Window_Main) - 20, WindowHeight(#Window_Main) - 40) ; Change the gadget size.
                FreeStatusBar(#StatusBar) ; Remove previous status bar.
                MyStatusBar()
              Default
            EndSelect
            StatusBarText(#StatusBar, 0, FormatDate("%dd/%mm/%yyyy", Date()) + " " + FormatDate("%hh:%ii:%ss", Date()))
            StatusBarText(#StatusBar, 1, FileName + " " + Str(Len(GetGadgetText(#EditorGadget))) + " chars " + Str(NLines) + " lines " + Str(NChars)) ; Display current file name and statistics.
          Until Quit
          SavePreferences(ProgramName + ".ini") ; Save ini file values.
      EndIf
    End

Code: Select all

;/ SETUP WINDOW CONTENTS FOR SAMPLE CODE SEEN BELOW
#MyWindow = 0
#MyText = 0
HWND5 = OpenWindow(#MyWindow, 0, 0, 631, 449,  #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_TitleBar , "Large Text File")
If HWND5
  If CreateGadgetList(WindowID())
    MyFileText = EditorGadget(#MyText, -2, 25, 635, 426)
    SendMessage_(MyFileText, #EM_SETTARGETDEVICE, #Null, 0) ; 0=wrap , $FFFFFF(effectively)=wrapoff
    SendMessage_(MyFileText, #EM_SETREADONLY, 1, 0) 
    s$ = "This test is intended to fill the Editorgadget with a large quantity of text and write it back to a test file and otherwise does noting at all."
    For e.l = 1 To 700
      AddGadgetItem(#MyText, -1, s$) ;/ Stuff EditorGadget with dummy (sample) text 
    Next e
    AddGadgetItem(#MyText, -1, "The END") ; add terminating line for visual confirmation
  EndIf
EndIf
;
;/ SAMPLE CODE TO WRITE OUT ENTIRE CONTENTS OF EDITOR GADGET BEGINS HERE
h.l = SendMessage_(MyFileText, #EM_GETLIMITTEXT, 0, 0) ; 
If CreateFile(0, "c:\test.txt")
  e.l = 0
  Repeat ;/ Write LARGE amounts of text from EditorGadget() to a file.
    SendMessage_(MyFileText, #EM_SETSEL, e.l, e.l + 32000)  ; highlight block.
    SendMessage_(MyFileText, #WM_COPY, 0, 0) ; place block in clipboard.
    buffer$ = GetClipboardText() ; load my buffer from clipboard.
    WriteString(buffer$) ; send my buffer to file.
    If e.l + 32000 > h.l
      Break       ; bail out if my new buffer goes past end of editor content.
    Else
      WindowEvent()
      Delay(1)      ; share time slices with other apps.
    EndIf
    e.l = e.l + 32000
  ForEver
  CloseFile(0)
  SendMessage_(MyFileText, #EM_SETSEL, 0, 0)  ; 
  SetClipboardText("") ; free windows clipboard buffer.
  buffer$ = "" ; free memory used in my buffer.
EndIf
SetGadgetText(#MyText, "DONE")
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

Code: Select all

; Author: Thorsten 
; Date: 18. June 2003 / Modified

; Procedures & Callbacks for loading + saving data in EditorGadget (Richedit) 
; ---------------------------------------------------------------------------- 
; 

;- Load ******* 

Procedure StreamFileIn_Callback(hFile, pbBuff, cb, pcb) 
  ProcedureReturn ReadFile_(hFile, pbBuff, cb, pcb, 0) ! 1 
EndProcedure 

Procedure FileStreamIn(FileID.l, File.s, Gadget.l) 
  
  Protected File  
  Protected FileID 
  Protected Gadget 

  Protected StreamData.EDITSTREAM 
  
  ;Wenn die Datei geöffnet werden kann, fortfahren.  
  If ReadFile(FileID, File)    
        
    ;Das Handle der Datei speichern 
    StreamData\dwCookie = UseFile(FileID) 
    StreamData\dwError = #Null 
    
    ;Die Adresse der Callback Procedure speichern 
    StreamData\pfnCallback = @StreamFileIn_Callback() 
    
    ;Das RichEdit Control anweisen, den Stream zu aktivieren 
    SendMessage_(GadgetID(Gadget), #EM_STREAMIN, #SF_TEXT, @StreamData) 
    
    ;Datei schliessen 
    CloseFile(FileID) 
    
  EndIf 

EndProcedure 

;- Save ******* 

Procedure StreamFileOut_Callback(hFile, pbBuff, cb, pcb) 
  ProcedureReturn WriteFile_(hFile, pbBuff, cb, pcb, 0) ! 1 
EndProcedure  

Procedure FileStreamOut(FileID.l, File.s, Gadget.l) 

  Protected File  
  Protected FileID 
  Protected Gadget 

  Protected StreamData.EDITSTREAM 
  
  ;Wenn die Datei erzeugt werden kann, fortfahren.  
  If CreateFile(FileID, File) 
        
    ;Das Handle der Datei speichern 
    StreamData\dwCookie = UseFile(FileID) 
    StreamData\dwError = #Null 
    
    ;Die Adresse der Callback Procedure speichern 
    StreamData\pfnCallback = @StreamFileOut_Callback() 
    
    ;Das RichEdit Control anweisen, den Stream zu aktivieren 
    SendMessage_(GadgetID(Gadget), #EM_STREAMOUT, #SF_TEXT, @StreamData) 
    
    ;Datei schliessen 
    CloseFile(FileID) 
    
  EndIf 

EndProcedure