PureBasic Forums - English

Code: Select all

;2005 by Hroudtwolf
;PureBasic-lounge.de
#LVM_FIRST = $1000 
#LVM_GETHEADER = (#LVM_FIRST + 31) 

#HDN_FIRST = (-300) 
#HDN_BEGINTRACKW = (#HDN_FIRST-26) 

Global hwnd, OldProc, Header, HeaderID

Structure DateiDaten
  adresse.s
  bereich.s
  ascausgabe.s
EndStructure

Global NewList MeineDatei.DateiDaten()

Declare OpenMyFile()
Declare HeaderCallBack(wnd,uMsg,wParam,lParam) 

LoadFont(1,"Fixedsys",10)
If OpenWindow (1,0,0,740,500,"HEX-Viewer",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
  If CreateMenu (1,WindowID(1))
    MenuTitle ("Datei")
    MenuItem (1,"Datei laden")
  EndIf
  tbHandle = CreateToolBar (1,WindowID(1))
  If tbHandle
    ToolBarStandardButton(1, #PB_ToolBarIcon_Open)
  EndIf 
  ListIconGadget (1,1,30,738,440,"Adresse",80,#PB_ListIcon_GridLines )
  SetGadgetFont (1,FontID(1))
  AddGadgetColumn (1,1,"Bytes",420)
  AddGadgetColumn (1,2,"ASC",234)
  SendMessage_(GadgetID(1),#LVM_SETBKCOLOR,0,$D5FFFF) 
  SendMessage_(GadgetID(1),#LVM_SETTEXTBKCOLOR,0,$D5FFFF) 
  SendMessage_(GadgetID(1),#LVM_SETTEXTCOLOR,0,RGB(0,0,196)) 
  TextGadget (2,90,2,300,20,"By Hroudtwolf 2005 http://www.PureBasic-Lounge.de")
  SetParent_(GadgetID(2),tbHandle)
  Header = SendMessage_(GadgetID(1),#LVM_GETHEADER,0,0) 
  HeaderID = GetDlgCtrlID_(Header) 
  OldProc = SetWindowLong_(GadgetID(1),#GWL_WNDPROC,@HeaderCallBack()) 
  Repeat
    event=WaitWindowEvent()
    Select event
      Case #PB_Event_Menu
        Select EventMenu()
          Case 1
            OpenMyFile ()
            
        EndSelect 
    EndSelect 
  Until event=#PB_Event_CloseWindow
  
EndIf 
End

Procedure OpenMyFile ()
  Datei$=OpenFileRequester ("Datei laden","","Alle Dateien (*.*)|*.*|Executables (*.exe)|*.exe|DynamicLinkLibrarys (*.dll)|*.dll",0)
  If datei$<>""
    ClearGadgetItems(1)
    ClearList(MeineDatei())
    ResetList(MeineDatei())
    If OpenFile (1,datei$)
      While Eof(1)=0
        If reihe=0
          AddElement(MeineDatei())
          MeineDatei()\Adresse = RSet(Hex(Loc(1)),8,"0")
        EndIf
        Wert=Abs(ReadByte(1))
        MeineDatei()\Bereich=MeineDatei()\Bereich+RSet(Hex(Wert),2,"0")+" "
        ascwert=wert
        If ascwert<0 Or ascwert>255:ascwert=0:EndIf 
        MeineDatei()\ascausgabe=MeineDatei()\ascausgabe+Chr(ascwert)
        reihe=reihe+1  
        If reihe>15:reihe=0:EndIf      
      Wend 
      CloseFile(1)
    EndIf 
  EndIf 
  
  ResetList (MeineDatei())
  While NextElement(MeineDatei()) 
    AddGadgetItem(1,-1,MeineDatei()\Adresse+Chr(10)+MeineDatei()\Bereich+Chr(10)+MeineDatei()\ascausgabe)
  Wend 
EndProcedure 

Procedure HeaderCallBack(wnd,uMsg,wParam,lParam) 
  Select uMsg 
    Case #WM_NOTIFY 
      *hdr.NMHDR = lParam 
      If *hdr\code= #HDN_BEGINTRACKW And *hdr\idFrom = HeaderID 
        Result = #True 
      EndIf  
    Default 
      Result = CallWindowProc_(OldProc,wnd,uMsg,wParam,lParam) 
  EndSelect 
  ProcedureReturn Result 
EndProcedure