PureBoard

Code: Alles auswählen

EnableExplicit

CompilerIf Defined(CFM_BACKCOLOR, #PB_Constant)
CompilerElse
  #CFM_BACKCOLOR =$4000000
CompilerEndIf

CompilerIf Defined(CFE_AUTOBACKCOLOR, #PB_Constant)
CompilerElse
  #CFE_AUTOBACKCOLOR =#CFM_BACKCOLOR
CompilerEndIf


Declare.l Editor_SetBackColor(Gadget, Color)
Declare.l Editor_UnsetBackColor(Gadget)

Define a, EventID


If OpenWindow(0,0,0,500,250,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  EditorGadget(1,10,10,480,200,0)
  ButtonGadget(2,10,220,100,20,"Set Backcolor")
  ButtonGadget(3,390,220,100,20,"Unset Backcolor")
  
  For a=1 To 10
    AddGadgetItem(1,-1,"Teststring",0,0)
  Next
  
  Repeat
  EventID=WaitWindowEvent()
  If EventID=#PB_Event_Gadget
    Select EventGadget()
      Case 2
        SendMessage_(GadgetID(1),#EM_SETSEL,0,-1)   ; Select all      
        Editor_SetBackColor(1, #Yellow)
        SendMessage_(GadgetID(1),#EM_SETSEL,0,0)    ;Deselect all
      Case 3
        SendMessage_(GadgetID(1),#EM_SETSEL,0,-1)   ; Select all      
        Editor_UnsetBackColor(1)
        SendMessage_(GadgetID(1),#EM_SETSEL,0,0)    ;Deselect all      
    EndSelect
  EndIf
  Until EventID=#PB_Event_CloseWindow
EndIf

Procedure.l Editor_SetBackColor(Gadget, Color)
  Protected format.CHARFORMAT2
  format\cbSize = SizeOf(CHARFORMAT2)
  format\dwMask = #CFM_BACKCOLOR
  format\crBackColor = Color
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

Procedure.l Editor_UnsetBackColor(Gadget)
  Protected format.CHARFORMAT2
  format\cbSize = SizeOf(CHARFORMAT2)
  format\dwMask = #CFM_BACKCOLOR
  format\dwEffects = #CFE_AUTOBACKCOLOR
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

Code: Alles auswählen

; Author: Michael 'neotoma' Taupitz

EnableExplicit

Declare.s GetTestText()
Declare.l Editor_GetFirstVisibleLineNumber(Gadget)
Declare.s Editor_GetFirstVisibleLineText(Gadget)

If OpenWindow(0,0,0,500,250,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  EditorGadget(1,10,10,480,210,0)
  If CreateStatusBar(0, WindowID(0))
      AddStatusBarField(80)
      AddStatusBarField(410)
  EndIf
  SetGadgetText(1,GetTestText())
  SendMessage_(GadgetID(1),#EM_SETSEL,2,5)
    
  Repeat
    StatusBarText(0, 0, "Topline Nr.:"+Str( Editor_GetFirstVisibleLineNumber(1)) )
    StatusBarText(0, 1, Editor_GetFirstVisibleLineText(1))  
  Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf

Procedure.l Editor_GetFirstVisibleLineNumber(Gadget)
  Protected result=SendMessage_(GadgetID(Gadget),#EM_GETFIRSTVISIBLELINE,0 ,0)
  ProcedureReturn result
EndProcedure 

Procedure.s Editor_GetFirstVisibleLineText(Gadget)
  Protected iTopLine.i, iLineLength.i, iCharPos.i, Result.s
  iTopLine=SendMessage_(GadgetID(Gadget), #EM_GETFIRSTVISIBLELINE, 0 ,0)
  iCharPos=SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, iTopLine ,0)
  iLineLength=SendMessage_(GadgetID(Gadget), #EM_LINELENGTH ,iCharPos ,0)
  Result = Space(iLineLength)
  SendMessage_(GadgetID(Gadget), #EM_GETLINE, iTopLine ,@Result)
  ProcedureReturn Result
EndProcedure 

Procedure.s GetTestText()
  Protected i.i
  Protected TestText.s = "{\rtf1\ansi\ansicpg1252\deff0\deflang1031{\fonttbl{\f0\fnil\fcharset0 Tahoma;}{\f1\fnil\fcharset0 MS Shell Dlg;}{\f2\fnil\fcharset2 Symbol;}}"
  TestText + "{\colortbl ;\red255\green170\blue85;\red0\green85\blue255;}"
  TestText + "\viewkind4\uc1\pard\qj\f0\fs32 "
  For i = 0 To 400
    TestText + Str(i) + "{\tab}$" + RSet(Hex(i), 4, "0") + "{\tab}" + Str(Random(1000)) + "\par"+#CRLF$
  Next      
  TestText + "}"
  Debug("Testtext finished")
  ProcedureReturn TestText
EndProcedure
 

Code: Alles auswählen

; Author: Michael 'neotoma' Taupitz

EnableExplicit

;Declares
Declare.s GetTestText()
Declare.l FlickerWork(Gadget)
Declare.l Editor_DisableRedraw(Gadget, bVal.i=#True)

Define Event.i

If OpenWindow(0,0,0,500,250,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  EditorGadget(1,10,10,480,210,0)
  SetGadgetText(1,GetTestText())
  
  ButtonGadget(100 , 10,225,100,20,"Flicker")
  ButtonGadget(150 , 390,225,100,20,"Non Flicker")
    
  Repeat
    Event = WaitWindowEvent()
    If Event = #PB_Event_Gadget
      Select EventGadget()
        Case 100  ; Flicker
          SendMessage_(GadgetID(1), #EM_SETSEL, -1, 0)          
          FlickerWork(1)
        Case 150  ; NonFlicker
          SendMessage_(GadgetID(1), #EM_SETSEL, -1, 0)          
          Editor_DisableRedraw(1)        ;Disable Redraw
          FlickerWork(1)
          Editor_DisableRedraw(1,#False) ;Enable Redraw
          
          ;This to mak a Redrwa after Finishing - to see the Changes.
          RedrawWindow_(GadgetID(1),0,0,#RDW_UPDATENOW|#RDW_ERASE|#RDW_INVALIDATE)          
      EndSelect
    EndIf 
  Until Event = #PB_Event_CloseWindow
EndIf

;==============================================================================
; Procedure Name ....:  Editor_DisableRedraw
; Description .......:  When performing several actions, or actions on text that
;                       is not currently in the visible window, or when changing
;                       selections repeatedly - an EditorGadget may flicker.
;                       Disabling the Gadget with WM_SetReDraw before taking
;                       actions, then turning enabling it after the actions have
;                       been taken can significantly improve performance.. 
;
; Syntax ............:  Editor_DisableRedraw(Gadget, bVal.i=#True)
; Parameter(s) ......:  Gadget    - A PB-GadgetId
;                       bVal      - #True (default) to Disable Redraw
;                                 - #False to Enable / reenable Redraw
; Return value(s) ...:  Nothing
;
; Author(s) .........:   Michael 'neotoma' Taupitz
; Creation Date .....:   18.06.2010
; Version ...........:   0.0.0.1
; Last Update .......:   
; Remarks ...........:   
;==============================================================================

Procedure.l Editor_DisableRedraw(Gadget, bVal.i=#True)
  SendMessage_(GadgetID(Gadget),#WM_SETREDRAW,1!bVal ,0)  
EndProcedure 

;Testprocedure to make some Operations on the EditorGadget
Procedure.l FlickerWork(Gadget)
  Protected i.i,m.i,n.i,iResult.i
  For i = 1 To 1000
    m = Random(240)
    n = m + Random(240-m)
    iResult = SendMessage_(GadgetID(Gadget), #EM_SETSEL, m, n+1)
  Next i  
  iResult = SendMessage_(GadgetID(Gadget), #EM_SETSEL, 0,2)    
EndProcedure  

;Create a Test-Text
Procedure.s GetTestText()    
  Protected i
  Protected TestText.s = "{\rtf1\ansi\ansicpg1252\deff0\deflang1031{\fonttbl{\f0\fnil\fcharset0 Tahoma;}{\f1\fnil\fcharset0 MS Shell Dlg;}{\f2\fnil\fcharset2 Symbol;}}"
  TestText + "{\colortbl ;\red255\green170\blue85;\red0\green85\blue255;}"
  TestText + "\viewkind4\uc1\pard\qj\f0\fs32 "
  For i = 0 To 120
    TestText + Str(i) + "{\tab}$" + RSet(Hex(i), 4, "0") + "{\tab}" + Str(Random(1000)) + "\par"+#CRLF$
  Next  
  TestText + "}"
  ProcedureReturn TestText
EndProcedure

Code: Alles auswählen

; Author: Michael 'neotoma' Taupitz
; Minimum-System : Windows 2000 Prof.

EnableExplicit

CompilerIf Defined(PROCESS_MEMORY_COUNTERS , #PB_Structure)
CompilerElse
Structure PROCESS_MEMORY_COUNTERS
  cb.l                              ;The size of the structure, in bytes.
  PageFaultCount.l                  ;The number of page faults.
  PeakWorkingSetSize.i              ;The peak working set size, in bytes.
  WorkingSetSize.i                  ;The current working set size, in bytes.
  QuotaPeakPagedPoolUsage.i         ;The peak paged pool usage, in bytes.
  QuotaPagedPoolUsage.i             ;The current paged pool usage, in bytes.
  QuotaPeakNonPagedPoolUsage.i      ;The peak nonpaged pool usage, in bytes.
  QuotaNonPagedPoolUsage.i          ;The current nonpaged pool usage, in bytes.
  PagefileUsage.i                   ;The current space allocated for the pagefile, in bytes.
                                    ; (Those pages may or may not be in memory.)
  PeakPagefileUsage.i               ;The peak space allocated for the pagefile, in bytes.
EndStructure 
CompilerEndIf

; Prototypes 
Prototype.i EmptyWorkingSet( hProcess.i)
Prototype.i GetProcessMemoryInfo( hProcess.i, *ppsmemCounters.PROCESS_MEMORY_COUNTERS, cb.i)



;Declares 
Declare.i BoostMemory(PID)
Declare.i GetProcessMemoryUsage(pid)
Declare.i GetCurrentMemoryUsage()
Declare.i BoostCurrentMemory()

; Mainloop for Test/Demo
Define Event.i


If OpenWindow(0,0,0,200,60,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  TextGadget(1,30,10,180,20,"",0)  
  ButtonGadget(2,50,30,100,20,"Boost")  
  Repeat
    Event = WaitWindowEvent()
    Select Event    
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 2 : BoostCurrentMemory()
        EndSelect
    EndSelect
        
    SetGadgetText(1,"Memory-Usage: "+StrF( GetCurrentMemoryUsage()/1024.0,1 )+" Kb")
    
  Until Event = #PB_Event_CloseWindow
EndIf

End


; Uses the PsAPI-Function EmptyWorkingSet()
Procedure.i BoostMemory(PID)
  Protected Result.i
  Protected EmptyWorkingSet.EmptyWorkingSet
  Protected  lib_psapi = OpenLibrary (#PB_Any, "psapi.dll")
  If lib_psapi
    EmptyWorkingSet.EmptyWorkingSet = GetFunction(lib_psapi,"EmptyWorkingSet")
    Result = EmptyWorkingSet( PID )
    CloseLibrary(lib_psapi)    
  EndIf
  ProcedureReturn Result
EndProcedure 


; Uses the PsAPI-Function GetProcessMemoryInfo()
Procedure.i GetProcessMemoryUsage(pid)
  Protected Result.i
  Protected PMC.PROCESS_MEMORY_COUNTERS
  Protected GetProcessMemoryInfo.GetProcessMemoryInfo

  Protected  lib_psapi = OpenLibrary (#PB_Any, "psapi.dll")
  If lib_psapi
    GetProcessMemoryInfo.GetProcessMemoryInfo = GetFunction(lib_psapi,"GetProcessMemoryInfo")
    If GetProcessMemoryInfo( GetCurrentProcess_(), @PMC, SizeOf(PROCESS_MEMORY_COUNTERS))
      Result = PMC\WorkingSetSize    
    EndIf
    CloseLibrary(lib_psapi)    
  EndIf
    
  ProcedureReturn Result;
EndProcedure  

;Get for the current process
Procedure.i GetCurrentMemoryUsage()
  ProcedureReturn GetProcessMemoryUsage(GetCurrentProcess_())
EndProcedure

;Boost for the current process
Procedure.i BoostCurrentMemory()
  ProcedureReturn BoostMemory(GetCurrentProcess_())
EndProcedure 

Code: Alles auswählen

; Author: Michael 'neotoma' Taupitz
; Minimum-System : Windows 2000 Prof.

EnableExplicit

#MAX_DRIVERS = 1024


Prototype.i EnumDeviceDrivers( lpImageBase.i, cb.i, lpcbNeeded.i)
Prototype.i GetDeviceDriverBaseName( ImageBase.i, lpBaseName.i,nSize.i)
Prototype.i GetDeviceDriverFileName( ImageBase.i, lpFileName.i,nSize.i)


Define EnumDeviceDrivers.EnumDeviceDrivers
Define GetDeviceDriverBaseName.GetDeviceDriverBaseName
Define GetDeviceDriverFileName.GetDeviceDriverFileName

Define lib_psapi
Define szDriver.s{1024}
Define szDriverFile.s{1024}
Define cbNeeded.l
Define cDrivers.l, i;
Dim drivers.l(#MAX_DRIVERS)


lib_psapi = OpenLibrary (#PB_Any, "psapi.dll")
If lib_psapi
  If OpenWindow(0,0,0,500,250,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
    ListIconGadget(1,10,10,480,230,"Driver",200,0)
    AddGadgetColumn(1,1,"File",300)
    
    EnumDeviceDrivers.EnumDeviceDrivers = GetFunction(lib_psapi,"EnumDeviceDrivers")
    CompilerIf #PB_Compiler_Unicode    
      GetDeviceDriverBaseName.GetDeviceDriverBaseName = GetFunction(lib_psapi,"GetDeviceDriverBaseNameW")  
      GetDeviceDriverFileName.GetDeviceDriverFileName = GetFunction(lib_psapi,"GetDeviceDriverFileNameW")
    CompilerElse
      GetDeviceDriverBaseName.GetDeviceDriverBaseName = GetFunction(lib_psapi,"GetDeviceDriverBaseNameA")  
      GetDeviceDriverFileName.GetDeviceDriverFileName = GetFunction(lib_psapi,"GetDeviceDriverFileNameA")
    CompilerEndIf
    
    If EnumDeviceDrivers(@drivers(), #MAX_DRIVERS*SizeOf(Long), @cbNeeded ) And cbNeeded < #MAX_DRIVERS*SizeOf(Long)
      cDrivers = cbNeeded/SizeOf(Long);
      MessageRequester("Info","Total Device Drivers count : "+Str(cDrivers));
      
      For i = 0 To cDrivers-1
        GetDeviceDriverBaseName( drivers(i), @szDriver    , 1024/SizeOf(CHARACTER) );
        GetDeviceDriverFileName( drivers(i), @szDriverFile, 1024/SizeOf(CHARACTER) );
        AddGadgetItem(1,-1,szDriver+Chr(10)+szDriverFile,0,0)        
      Next
    EndIf
    
    Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
    
  EndIf      
EndIf  
  

Code: Alles auswählen

Define Event.i
Define Path.s ="C:\"

If OpenWindow(0,0,0,350,60,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  TextGadget  (1, 30,12, 80,20,"Open Dos at:",0)  
  StringGadget(2,115,10,120,20,Path)  
  ButtonGadget(3,240,10,40,20,"...")  
  ButtonGadget(4, 30,35,100,20,"Open DOS")  
  Repeat
    Event = WaitWindowEvent()
    Select Event    
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 3 : 
            Path = PathRequester("Bitte wählen Sie einen Pfad aus", Path)
            SetGadgetText(2,Path)
          Case 4 :    
            Select OSVersion() 
              Case #PB_OS_Windows_95,#PB_OS_Windows_98,#PB_OS_Windows_ME
                RunProgram("command", "/K chdir /D "+Path,"")       ;WinNT, 2000, XP, Vista
              Default
                RunProgram("cmd", "/K chdir /D "+Path,"")       ;WinNT, 2000, XP, Vista
             EndSelect
        EndSelect
    EndSelect
        
    
  Until Event = #PB_Event_CloseWindow
EndIf

End

Code: Alles auswählen

Structure PROCESS_MEMORY_COUNTERS
  cb.l                              ;The size of the structure, in bytes.
  PageFaultCount.l                  ;The number of page faults.
  PeakWorkingSetSize.i              ;The peak working set size, in bytes.
  WorkingSetSize.i                  ;The current working set size, in bytes.
  QuotaPeakPagedPoolUsage.i         ;The peak paged pool usage, in bytes.
  QuotaPagedPoolUsage.i             ;The current paged pool usage, in bytes.
  QuotaPeakNonPagedPoolUsage.i      ;The peak nonpaged pool usage, in bytes.
  QuotaNonPagedPoolUsage.i          ;The current nonpaged pool usage, in bytes.
  PagefileUsage.i                   ;The current space allocated for the pagefile, in bytes.
                                    ; (Those pages may or may not be in memory.)
  PeakPagefileUsage.i               ;The peak space allocated for the pagefile, in bytes.
EndStructure