LB Booster
« Search Results »

Welcome Guest. Please Login or Register.
Feb 22nd, 2018, 3:25pm


Speed up Liberty BASIC programs by up to ten times!
Compile Liberty BASIC programs to compact, standalone executables!
Overcome many of Liberty BASIC's bugs and limitations!
LB Booster Resources
LB Booster documentation
LB Booster Home Page
LB Booster technical Wiki
Just BASIC forum
LB Umbrella forum
Liberty BASIC forum (the original)

Search Results

Total results: 10


 1   General Board / Re: XZIP DLL  on: Feb 16th, 2018, 9:22pm
Started by PabloSGL | Post by Richard Russell
on Feb 16th, 2018, 8:51pm, PabloSGL wrote:
I did not see the difference between _LOCALE_SYSTEM_DEFAULT and LOCALE.SYSTEM.DEFAULT

It's a peculiarity of Liberty BASIC that underscores are legal in Windows constants but not in variable names, whereas dots are legal in variable names but not in Windows constants (at least, there are no Windows constants containing dots).

I think you can claim the prize for discovering the first Windows constant that is known about by LB 4 but not by LBB. When creating LBB I had to 'guess' which constants to include and which not to include, and when there is a difference it is usually the other way around (i.e. LBB knows about it but LB 4 doesn't).

Sadly for you, there isn't really a prize! Sorry.

Richard.

 
  Reply Quote Notify of replies

 2   General Board / Re: XZIP DLL  on: Feb 16th, 2018, 8:51pm
Started by PabloSGL | Post by PabloSGL
Oops!, sorry!!!

I did not see the difference between _LOCALE_SYSTEM_DEFAULT and LOCALE.SYSTEM.DEFAULT (the DOTs)

You know what they say:"BASIC programmers are blind, because they can´t C"

FIXED! Thanks!!!

- Pablo
 
  Reply Quote Notify of replies

 3   General Board / Re: XZIP DLL  on: Feb 16th, 2018, 6:31pm
Started by PabloSGL | Post by Richard Russell
on Feb 16th, 2018, 5:11pm, PabloSGL wrote:
Code:
  dtBuf$ = Space$(50)
  Calldll #kernel32, "GetDateFormatA", LOCALE_SYSTEM_DEFAULT As Ulong, _
    _NULL As Ulong, st As Struct, _NULL As Ulong, dtBuf$ As Ptr, 50 As Long, _
  dt$ = Left$(dtBuf$,r-1) 

According to your comments you changed the Windows Constant to LOCALE.SYSTEM.DEFAULT (dots) but here it still has underscores. Did you change it using Edit... Replace... Replace all? That should have replaced all occurrences in the program, so I don't understand how these were missed.

Richard.

 
  Reply Quote Notify of replies

 4   General Board / Re: XZIP DLL  on: Feb 16th, 2018, 5:15pm
Started by PabloSGL | Post by PabloSGL
I get this error "Missing AS in CALLDLL". If somebody can make this to work I will be eternally grateful

Thank you.

Best regards,

- Pablo Sighel
 
  Reply Quote Notify of replies

 5   General Board / Re: XZIP DLL  on: Feb 16th, 2018, 5:11pm
Started by PabloSGL | Post by PabloSGL
Part III

Code:


'------------ COM and XZip.dll subs/functions ----------
[InitCom]
  Struct comObj, obj As Ulong 'for receiving pointers to COM objects
  Struct LVAL, x As Long 'for receiving numeric returns from COM methods
  Struct STRVAL, x As Ptr 'for receiving string returns from COM methods
Return

Sub Zip.Pack XZipObject, src$, zip$
  Calldll #com, "dhCallMethod", XZipObject As Ulong, ".Pack(%s, %s)" As Ptr,_
    src$ As Ptr, zip$ As Ptr, r As Long
End Sub

Sub Zip.Pack.PreservePath XZipObject, src$, zip$
  Calldll #com, "dhCallMethod", XZipObject As Ulong, ".Pack(%s, %s, %d)" As Ptr,_
    src$ As Ptr, zip$ As Ptr, 1 As Long, r As Long
End Sub

Sub Zip.UnPack XZipObject, zip$, destination$    
  Calldll #com, "dhCallMethod", XZipObject As Ulong, _    
    ".UnPack(%s, %s)" As Ptr, zip$ As Ptr, destination$ As Ptr, r As Long
End Sub

Sub Zip.Delete XZipObject, file$, zip$
  Calldll #com, "dhCallMethod", XZipObject As Ulong, ".Delete(%s, %s)" As Ptr,_
    file$ As Ptr, zip$ As Ptr, r As Long
End Sub

Sub ShowZipFiles XZipObject, hList, zipFile$
  'Display a list of the files contained in the zip file
  'along with their uncompressed size and any stored path.
  'Display the files in a listview control.
  tFolder = 1
  tFile = 2
  
  Call ListView.DeleteAllItems hList
    
  Calldll #com, "dhGetValue", "%o" As Ptr, comObj As Struct, _
    XZipObject As Ulong, ".Contents(%s)" As Ptr, zipFile$ As Ptr, r As Long
  objItems = comObj.obj.struct: comObj.obj.struct = 0

  count = GetValueLong(objItems, ".Count")
  
  For Idx = 1 To count
    Calldll #com, "dhGetValue", "%o" As Ptr, comObj As Struct, _
    objItems As Ulong, ".Item(%d)" As Ptr, Idx As Long, r As Long
    objItem = comObj.obj.struct: comObj.obj.struct = 0
    
    If GetValueLong(objItem, ".Type") = tFile Then
      listIdx = listIdx + 1
      fileName$ = GetValueStr$(objItem, ".Name")
      fileTime$ = GetValueDateTime$(objItem, ".Date")
      fileSize = GetValueLong(objItem, ".Size")
      filePath$ = GetValueStr$(objItem, ".Path")
      
      r = ListView.InsertItem(hList, listIdx-1, 0, fileName$)
      r = ListView.SetItem(hList, listIdx-1, 1, fileTime$)
      r = ListView.SetItem(hList, listIdx-1, 2, Str$(fileSize))
      r = ListView.SetItem(hList, listIdx-1, 3, filePath$)
    End If
    Call SetNothing objItem
  Next Idx

  Call SetNothing objItems
End Sub

Function GetArchiveFileCount(XZipObject, zipFile$)
  Calldll #com, "dhGetValue", "%o" As Ptr, comObj As Struct, _
    XZipObject As Ulong, ".Contents(%s)" As Ptr, zipFile$ As Ptr, r As Long
  objItems = comObj.obj.struct: comObj.obj.struct = 0
  GetArchiveFileCount = GetValueLong(objItems, ".Count")
  Call SetNothing objItems
End Function

Sub BeginCOM
  Open "oleaut32.dll" For Dll As #ole
  Open "LB_dispHelper.dll" For Dll As #com
  Calldll #com, "dhInitializeCom", FALSE As Long, r As Long
  Calldll #com, "dhToggleExceptions", 1 As Long, r As Long
End Sub

Sub EndCOM
  Close #ole
  Calldll #com, "Uninitialize_COM", 1 As Long, r As Void
  Close #com
End Sub

Function CreateObject(ObjName$)
  'Create an instance of ObjName$ on the local machine
  ObjName$ = ObjName$ + Chr$(0)
  Calldll #com, "dhCreateObject", ObjName$ As Ptr, _NULL As Long, _
    comObj As Struct, r As Ulong
  CreateObject = comObj.obj.struct: comObj.obj.struct = 0
End Function

Sub SetNothing Object
  Calldll #com, "dhReleaseObject", Object As Ulong, r As Void
End Sub

Function GetValueStr$(Object, item$)
  STRVAL.x.struct = ""
  Calldll #com, "dhGetValue", "%s" As Ptr, STRVAL As Struct, _
    Object As Ulong, item$ As Ptr, r As Long
  GetValueStr$ = Winstring(STRVAL.x.struct)
  x=STRVAL.x.struct: Calldll #com, "FreeString", x As Ulong, r As Void
End Function

Function GetValueLong(Object, item$)
  LVAL.x.struct = 0
  Calldll #com, "dhGetValue", "%d" As Ptr, LVAL As Struct, _
    Object As Ulong, item$ As Ptr, r As Long
  GetValueLong = LVAL.x.struct
End Function

Function GetValueDateTime$(Object, item$)
  TIME.NOSECONDS = 2
  Struct DT, x As Double
  Struct st, _  'SYSTEMTIME
    wYear As Word, _
    wMonth As Word, _
    wDayOfWeek As Word, _
    wDay As Word, _
    wHour As Word, _
    wMinute As Word, _
    wSecond As Word, _
    wMilliseconds As Word

  Calldll #com, "dhGetValue", "%D" As Ptr, DT As Struct, _
    Object As Ulong, item$ As Ptr, r As Long
  vtDate = DT.x.struct
  
  Calldll #ole, "VariantTimeToSystemTime", vtDate As Double, st As Struct, r As Long
  
  dtBuf$ = Space$(50)
  Calldll #kernel32, "GetDateFormatA", LOCALE_SYSTEM_DEFAULT As Ulong, _
    _NULL As Ulong, st As Struct, _NULL As Ulong, dtBuf$ As Ptr, 50 As Long, _
  dt$ = Left$(dtBuf$,r-1)

  dtBuf$ = Space$(50)
  Calldll #kernel32, "GetTimeFormatA", LOCALE_SYSTEM_DEFAULT As Ulong, _
    TIME.NOSECONDS As Ulong, st As Struct, _NULL As Ulong, dtBuf$ As Ptr, 50 As Long, _
    r As Long
  tm$ = Left$(dtBuf$,r-1)

  GetValueDateTime$ = dt$ + "  " + tm$
End Function

 

 
  Reply Quote Notify of replies

 6   General Board / Re: XZIP DLL  on: Feb 16th, 2018, 5:11pm
Started by PabloSGL | Post by PabloSGL
Part II

Code:

Function file$(path$)
  While Instr(path$,"\")
    path$=Right$(path$,Len(path$)-1)
  Wend
  file$=path$
End Function

Function ParseOFNlist(strList$, maxElements)
  'Fills array OFNlist$() with paths from a chr$(13) delimited string list
  'or a single non-delimited path.
  maxElements = max(maxElements, 1)
  Redim OFNlist$(maxElements)
  idx = 0
  If Instr(strList$, Chr$(13)) Then
    While 1
      OFNlist$(idx) = Word$(strList$, idx+1, Chr$(13))
      If OFNlist$(idx) = "" Then Exit While
      idx = idx + 1
      If idx > maxElements Then
        Redim OFNlist$(1) 'erase the list
        Exit Function 'return 0, failed
      End If
    Wend
  Else
    OFNlist$(0) = strList$
  End If
  If OFNlist$(0) <> "" Then ParseOFNlist = 1 'return success
End Function

Function GetOpenFileName$(title$, path$, filter$, filterIdx, multiselect)
  'Returns a single file path or a chr$(13) delimited string of filepaths
  OFN.EXPLORER = 524288

  Struct ofn, _
    lStructSize As Long, _
    hwndOwner As Long, _
    hInstance As Long, _
    lpstrFilter$ As Ptr, _
    lpstrCustomFilter$ As Ptr, _
    nMaxCustFilter As Long, _
    nFilterIndex As Long, _
    lpstrFile$ As Ptr, _
    nMaxFile As Long, _
    lpstrFileTitle$ As Ptr, _
    nMaxFileTitle As Long, _
    lpstrInitialDir$ As Ptr, _
    lpstrTitle$ As Ptr, _
    Flags As Long, _
    nFileOffset As Word, _
    nFileExtension As Word, _
    lpstrDefExt As Long, _
    lCustData As Long, _
    lpfnHook As Long, _
    lpTemplateName As Long
    
  ofn.lStructSize.struct = Len(ofn.struct)
 
  ofn.lpstrFilter$.struct = filter$
  ofn.nFilterIndex.struct = filterIdx
  'Allow a lot of files to be chosen, 32000 characters
  ofn.lpstrFile$.struct = Chr$(0) + Space$(32000) + Chr$(0)
  ofn.nMaxFile.struct = 32000
  ofn.lpstrInitialDir$.struct = path$ + Chr$(0)
  ofn.lpstrTitle$.struct = title$ + Chr$(0)
  ofn.lpstrDefExt.struct = 0
  
  If multiselect = 1 Then
    ofn.Flags.struct = _OFN_ALLOWMULTISELECT Or _OFN_PATHMUSTEXIST Or OFN.EXPLORER
  Else
    ofn.Flags.struct = _OFN_PATHMUSTEXIST Or OFN.EXPLORER
  End If
  
  Calldll #comdlg32, "GetOpenFileNameA", ofn As Struct, r As Long

  If r Then
    q$ = Chr$(34)
    path$ = Winstring(ofn.lpstrFile$.struct)
    ofnPath$ = Left$(path$,ofn.nFileOffset.struct)
    If Right$(ofnPath$,1) <> "\" Then
      ofnPath$ = ofnPath$ + "\"
    End If

    offset = ofn.lpstrFile$.struct + ofn.nFileOffset.struct
    file$ = Winstring(offset)
    GetOpenFileName$ = ofnPath$ + file$
    
    If multiselect = 1 Then
      If GetOpenFileName$ <> "" Then
        GetOpenFileName$ = GetOpenFileName$ + Chr$(13)
      End If
      While file$<>""
        offset = offset + Len(file$) + 1
        file$ = Winstring(offset)
        If file$<>"" Then 
          GetOpenFileName$ = GetOpenFileName$ + ofnPath$ + file$ + Chr$(13)
        End If
      Wend
    End If
    GetOpenFileName$ = Trim$(GetOpenFileName$)
  Else
    'User cancelled or error,
    'see CommDlgExtendedError API.
  End If
End Function

Function BrowseForFolder$(hWnd)
  BIF.RETURNONLYFSDIRS = 1
  
  Struct BrowseInfo,_
    hWndOwner As Ulong,_
    pIDLRoot As Ulong,_
    pszDisplayName As Long,_
    lpszTitle$ As Ptr,_
    ulFlags As Long,_
    lpfnCallback As Ulong,_
    lParam As Long,_
    iImage As Long
 
  BrowseInfo.hWndOwner.struct = hWnd
  BrowseInfo.lpszTitle$.struct = "Extract files to:"
  BrowseInfo.ulFlags.struct = BIF.RETURNONLYFSDIRS

  Calldll #shell32, "SHBrowseForFolder", BrowseInfo As Struct,_
    lpIDList As Ulong

  If lpIDList > 0 Then
    sPath$ = Space$(_MAX_PATH)
    Calldll #shell32, "SHGetPathFromIDList", lpIDList As Ulong,_
      sPath$ As Ptr, success As Long
    If success Then BrowseForFolder$ = Trim$(sPath$)
    Open "ole32" For Dll As #ole32
    Calldll #ole32, "CoTaskMemFree", lpIDList As Ulong, r As Long
    Close #ole32
  End If
End Function

Function AddFileOptionsDlg(Byref chk1)
  chk1 = 0: bCanceled = 0
  WindowWidth = 382 : WindowHeight = 150
  
  Groupbox #AddFileDlg.group1, "Options", 30, 25, 200, 60
  Button   #AddFileDlg.ok, "Continue",[ok.click],UL, 250, 30, 105, 25
  Button   #AddFileDlg.cancel, "Cancel",[cancel.click],UL, 250, 60, 105, 25
  Checkbox #AddFileDlg.chk1, "Preserve Paths",[chk1.click],[chk1.reset], 80, 45, 135, 25
  
  stylebits #AddFileDlg, _DS_CENTER, 0, 0, 0
  Open "Options - Add file(s) to zip archive" For Dialog_modal As #AddFileDlg
  #AddFileDlg "trapclose [cancel.click]"
  
  Wait
  
  [ok.click]
      Goto [quit.AddFileDlg]
  
  [cancel.click]
      bCanceled = 1
      Goto [quit.AddFileDlg]
  
  [chk1.click]
      chk1 = 1: Wait
  [chk1.reset]
      chk1 = 0: Wait
      
  [quit.AddFileDlg]
      Close #AddFileDlg
      AddFileOptionsDlg = bCanceled
End Function

Function PathExists(pathSpec$)
  Struct PathExistsWFD, x As char[318]
  Calldll #kernel32, "FindFirstFileA", pathSpec$ As Ptr, _
    PathExistsWFD As Struct, hfind As Ulong
  Calldll #kernel32, "FindClose", hfind As Ulong, ret As Long
  If hfind <> _INVALID_HANDLE_VALUE Then PathExists = 1
End Function

'------------ Listview control routines ----------------
[InitListView]
  LVS.NOSORTHEADER = 32768
  LVS.REPORT = 1
  LVS.SHOWSELALWAYS = 8
  
  Struct LVCOLUMN, _
    mask As Ulong, _
    fmt As Long, _
    cx As Long, _
    pszText$ As Ptr, _
    cchTextMax As Long, _
    iSubItem As Long, _
    iImage As Long, _
    iOrder As Long
 
  Struct LVITEM, _
    mask As Ulong, _
    iItem As Long, _
    iSubItem As Long, _
    state As Ulong, _
    stateMask As Ulong, _
    pszText$ As Ptr, _
    cchTextMax As Long, _
    iImage As Long, _
    lParam As Long, _
    iIndent As Long
Return

Function CreateListView(hParent, hInst, style, l, t, w, h)
  Calldll #user32, "CreateWindowExA", _WS_EX_CLIENTEDGE As Long,_
    "SysListView32" As Ptr, "" As Ptr, style As Long,_
    l As Long, t As Long, w As Long, h As Long,_
    hParent As Long, 0 As Long, hInst As Long,_
    "" As Ptr, CreateListView As Ulong
End Function

Function ListView.InsertColumn(hLV, col, width, txt$)
  LVM.INSERTCOLUMN = 4123
  LVCF.WIDTH = 2
  LVCF.TEXT = 4

  LVCOLUMN.mask.struct = LVCF.WIDTH Or LVCF.TEXT
  LVCOLUMN.cx.struct = width
  LVCOLUMN.pszText$.struct = txt$
  Calldll #user32, "SendMessageA", hLV As Long, LVM.INSERTCOLUMN As Long, _
    col As Long, LVCOLUMN As Struct, ListView.InsertColumn As Long
End Function

Function ListView.InsertItem(hLV, row, col, txt$)
  LVM.INSERTITEM = 4103
  LVIF.TEXT = 1

  LVITEM.mask.struct = LVIF.TEXT
  LVITEM.iItem.struct = row
  LVITEM.iSubItem.struct = col
  LVITEM.pszText$.struct = txt$
  
  Calldll #user32, "SendMessageA", hLV As Long, _
    LVM.INSERTITEM As Long, 0 As Long, LVITEM As Struct, _
    ListView.InsertItem As Long
End Function

Function ListView.SetItem(hLV, row, col, txt$)
  LVM.SETITEM = 4102
  LVIF.TEXT = 1
  
  LVITEM.mask.struct = LVIF.TEXT
  LVITEM.iItem.struct = row
  LVITEM.iSubItem.struct = col
  LVITEM.pszText$.struct = txt$
  
  Calldll #user32, "SendMessageA", hLV As Long, _
    LVM.SETITEM As Long, 0 As Long, LVITEM As Struct, _
    ListView.SetItem As Long
End Function

Sub Listview.SelectAll hLV
  LVIS.SELECTED = 2
  LVM.SETITEMSTATE = 4139
  
  LVITEM.stateMask.struct = LVIS.SELECTED
  LVITEM.state.struct = LVIS.SELECTED
  Calldll #user32, "SendMessageA", hLV As Long, _
    LVM.SETITEMSTATE As Long, -1 As Long, _
    LVITEM As Struct, r As Long
End Sub

Sub ListView.ClearAll hLV
  LVIS.UNSELECTED = 0
  LVIS.SELECTED = 2
  LVM.SETITEMSTATE = 4139
  
  LVITEM.stateMask.struct = LVIS.SELECTED
  LVITEM.state.struct = LVIS.UNSELECTED
  Calldll #user32, "SendMessageA", hLV As Long, _
    LVM.SETITEMSTATE As Long, -1 As Long, _
    LVITEM As Struct, r As Long
End Sub

Sub ListView.DeleteAllItems hLV
  LVM.DELETEALLITEMS = 4105    
  Calldll #user32, "SendMessageA", hLV As Long, _
    LVM.DELETEALLITEMS As Long, 0 As Long, _
    0 As Long, r As Long
End Sub

Function ListView.GetSelectedCount(hLV)
  LVM.GETSELECTEDCOUNT = 4146
  Calldll #user32, "SendMessageA", hLV As Long, LVM.GETSELECTEDCOUNT As Long, _
    0 As Long, 0 As Long, _ 
    ListView.GetSelectedCount As Long
End Function

Function ListView.GetSelectedFiles$(hLV)
  'Gets the selected files in the listview and
  'returns them as a chr$(13) delimited list of filepaths.
  LVM.GETSELECTEDCOUNT = 4146
  LVM.GETNEXTITEM = 4108
  LVNI.SELECTED = 2
  LVM.GETITEMTEXTA = 4141
  Calldll #user32, "SendMessageA", hLV As Long, LVM.GETSELECTEDCOUNT As Long, _
    0 As Long, 0 As Long, _ 
    ItemsSelected As Long

  LVITEM.mask.struct = LVIF.TEXT
  LVITEM.cchTextMax.struct = _MAX_PATH
  LVITEM.pszText$.struct = Space$(_MAX_PATH)
  
  'Start search at -1 so LVM.GETNEXTITEM will start at item 0.
  SelectedItemIndex = -1
  For index = 1 To ItemsSelected
    Calldll #user32, "SendMessageA", hLV As Long, LVM.GETNEXTITEM As Long, _
      SelectedItemIndex As Long, LVNI.SELECTED As Long, _
      SelectedItemIndex As Long

    'get the path
    LVITEM.iSubItem.struct = 3
    Calldll #user32, "SendMessageA", hLV As Long, LVM.GETITEMTEXTA As Long, _
      SelectedItemIndex As Long, LVITEM As Struct, _
      selItem As Long
    path$=Winstring(LVITEM.pszText$.struct)
    path$ = Trim$(path$)
    If path$ <> "" Then items$ = items$ + path$

    'get the file name
    LVITEM.iSubItem.struct = 0  'first column
    Calldll #user32, "SendMessageA", hLV As Long, LVM.GETITEMTEXTA As Long, _
      SelectedItemIndex As Long, LVITEM As Struct, _
      selItem As Long
      
    file$=Winstring(LVITEM.pszText$.struct)
    file$ = Trim$(file$)
    If file$ <> "" Then items$ = items$ + file$ + Chr$(13)
  Next index
  ListView.GetSelectedFiles$ = items$
End Function
 

 
  Reply Quote Notify of replies

 7   General Board / XZIP DLL  on: Feb 16th, 2018, 5:07pm
Started by PabloSGL | Post by PabloSGL
Hello,

I am trying to use XZIP.DLL from

http://lbpe.wikispaces.com/ActiveX2#Using%20ActiveX%20DLLs%20in%20Liberty%20BASIC

This is the code I have been working on:

Part I
Code:
' Zip Archiver AciveX.dll Demo 
' by Dennis McKinney
' Released as open source.

'** Created by LB Workshop - 2/10/2005 8:41:51 PM

'Listview and multi-select file dialog are based entirely or in
'part on code from the Liberty BASIC 4 Companion and LB Workshop,
'reprinted with permission. 
'These invaluable tools are available at http://alycesrestaurant.com


'Note: minimal error checking is performed in this code.

' Added this two lines of code and named
' _LOCALE.SYSTEM.DEFAULT as LOCALE.SYSTEM.DEFAULT
LOCALE.SYSTEM.DEFAULT = hexdec("&H800")
global LOCALE.SYSTEM.DEFAULT

Nomainwin

OFNfilter$ = "Zip files" + Chr$(0) + "*.zip" + Chr$(0) + _
             "All files" + Chr$(0) + "*.*" + Chr$(0) + Chr$(0)
TRUE = 1
AppName$ = "Zip Archiver Demo"
maxFiles = 1000
mainOpen = FALSE

Struct rect,_
  left As Long,_
  top As Long,_
  right As Long,_
  bottom As Long

Gosub [InitListView]
Gosub [InitCom]

Call BeginCOM

objZip = CreateObject("XStandard.Zip")
If Not(objZip) Then 
  Notice "Xzip not installed" + Chr$(13) + _
  "The Xzip ActiveX dll has not been registered."
  Goto [quit]
End If

WindowWidth = 500 : WindowHeight = 300
UpperLeftX = Int((DisplayWidth-WindowWidth)/2)
UpperLeftY = Int((DisplayHeight-WindowHeight)/2)

Menu #main, "&File", _
            "&Open Archive", [archive.open], _
            "&New Archive", [archive.new], _
            "E&xit", [quit]
            
Menu #main, "&Actions", _
            "&Add", [archive.add], _
            "&Delete", [archive.delete], _
            "&Extract All", [archive.extract], _
            "&Select All", [archive.select.all]

stylebits #main, _WS_CLIPCHILDREN, 0, 0, 0

Open AppName$ For Window As #main
#main "trapclose [quit]"
#main "resizehandler [resizeWin]"

mainOpen = TRUE

hMain = Hwnd(#main)
hInst = GetWindowLong(hMain, _GWL_HINSTANCE)

style = _WS_CHILD Or _WS_VISIBLE Or _WS_CLIPCHILDREN _
  Or LVS.NOSORTHEADER Or LVS.REPORT Or LVS.SHOWSELALWAYS

hLV = CreateListView(hMain, hInst, style, 0, 10, 100, 100)
r = ListView.InsertColumn(hLV, 0, 200, "Name")
r = ListView.InsertColumn(hLV, 1, 140, "Modified")
r = ListView.InsertColumn(hLV, 2, 70, "Size")
r = ListView.InsertColumn(hLV, 3, 300, "Path")

'Get the cursor associated with the listview
Calldll #user32, "GetClassLongA", hLV As Ulong, _
_GCL_HCURSOR As Long, hLVCursor As Ulong

[resizeWin]
  Calldll #user32, "GetClientRect", hMain As Ulong, rect As Struct, r As Long
  r=SetWindowPos(hLV, 0, 0, 0, rect.right.struct, rect.bottom.struct, 0)

[Loop]
Wait

[quit]
  Call SetNothing objZip
  Call EndCOM
  Calldll #user32, "DestroyWindow", hLV As Long, r as Long
  If mainOpen Then Close #main
  End

[archive.new]
  Filedialog "Enter a name for the new zip file", "*.zip", zipFile$
  If (zipFile$ <> "") And (Right$(zipFile$,4) = ".zip") Then
    If Not(PathExists(zipFile$)) Then
      Call SetCaption hMain, AppName$ + ": " + file$(zipFile$)
      Call ListView.DeleteAllItems hLV
      ArchiveIsOpen = TRUE
    Else
      Notice "Error" + Chr$(13) + file$(zipFile$) + " already exists."
    End If
  Else
    If (zipFile$ <> "") Then 
      Notice "Error" + Chr$(13) + _
      zipFile$ + " is not a zip archive."
    End If
  End If
Wait

[archive.open]
  Filedialog "Open a zip file", "*.zip", zipFile$
  If (zipFile$ <> "") And (Right$(zipFile$,4) = ".zip") Then
    Call SetCaption hMain, AppName$ + ": " + file$(zipFile$)
    Call ShowZipFiles objZip, hLV, zipFile$
    ArchiveIsOpen = TRUE
  Else
    If (zipFile$ <> "") Then 
      Notice "Error" + Chr$(13) + _
      zipFile$ + " is not a zip archive."
    End If
  End If
Wait

[archive.add]
  If ArchiveIsOpen = TRUE Then
    bDlgCanceled = AddFileOptionsDlg(bPreservePaths)
    If Not(bDlgCanceled) Then
      fileList$ = GetOpenFileName$("Select file(s) to add to archive", _
        path$, OFNfilter$, 2, TRUE)
      If fileList$ <> "" Then
        Gosub [cursor.hourglass]
        If ParseOFNlist(fileList$, maxFiles) Then
          filesAdded = FALSE
          cnt = 0
          While 1
            tozip$ = OFNlist$(cnt)
            cnt = cnt + 1
            If tozip$ = "" Then Exit While
            filesAdded = TRUE
            If bPreservePaths Then
              Call Zip.Pack.PreservePath objZip, tozip$, zipFile$
            Else
              Call Zip.Pack objZip, tozip$, zipFile$
            End If
          Wend
          If filesAdded Then Call ShowZipFiles objZip, hLV, zipFile$
        Else
          Notice "Too many files selected" + chr$(13) + _
            "Cannot add more than "+ str$(maxFiles) + " files at one time."
        End If
        Gosub [cursor.normal]
      End If
    End If
  End If
Wait

[archive.extract]
  'Is archive empty?
  If GetArchiveFileCount(objZip, zipFile$) Then
    EXTpath$ = BrowseForFolder$(hMain)
    If EXTpath$ <> "" Then
      Gosub [cursor.hourglass]
      Call Zip.UnPack objZip, zipFile$, EXTpath$
      Gosub [cursor.normal]
    End If
  End If
Wait

[archive.delete]
  If ListView.GetSelectedCount(hLV) Then
    Gosub [cursor.hourglass]
    fileList$ = ListView.GetSelectedFiles$(hLV)
    If ParseOFNlist(fileList$, maxFiles) Then
      cnt = 0
      While 1
        delfile$ = OFNlist$(cnt)
        cnt = cnt + 1
        If delfile$ = "" Then Exit While
        Call Zip.Delete objZip, delfile$, zipFile$
      Wend
      Call ShowZipFiles objZip, hLV, zipFile$
    Else
      Notice "Too many files selected" + chr$(13) + _
        "Cannot delete more than "+ str$(maxFiles) + _
        " selected files at one time." + chr$(13) + chr$(13) + _
        "Select fewer files."
    End If
    Gosub [cursor.normal]
  End If
Wait

[archive.select.all]
  Call Listview.SelectAll hLV
  Calldll #user32, "SetFocus", hLV As Ulong, r As Ulong
Wait

[cursor.hourglass]
  Cursor hourglass
  Calldll #user32, "SetClassLongA", hLV As Ulong, _
    _GCL_HCURSOR As Long, _IDC_Wait As Long, r As Ulong
Return

[cursor.normal]
  Cursor normal
  Calldll #user32, "SetClassLongA", hLV As Ulong, _
    _GCL_HCURSOR As Long, hLVCursor As Long, r As Ulong
Return

Function GetWindowLong(hWin, type)
  Calldll #user32, "GetWindowLongA", hWin As Long, type As Long,_
  GetWindowLong As Long
End Function

Function SetWindowPos(hWnd, pos, x, y, w, h, flags)
  Calldll #user32, "SetWindowPos", hWnd As Ulong, pos As Long, _
    x As Long, y As Long, w As Long, h As Long, flags As Long, r As Void
End Function

Sub SetCaption hWnd, capt$
  Calldll #user32, "SetWindowTextA", hWnd As Ulong, capt$ As Ptr, r As Long
End Sub
 

 
  Reply Quote Notify of replies

 8   General Board / Wikispaces is closing down  on: Feb 12th, 2018, 3:49pm
Started by Richard Russell | Post by Richard Russell
Wikispaces (who host the BB4W and LBB wiki) are closing down later in the year; here is the official announcement.

The two big advantages of Wikispaces over most other wiki hosting sites are the freedom from advertisements (and therefore the uncluttered nature of the pages) and the syntax colouring; it is the only wiki I know that supports syntax colouring for BBC BASIC.

We have discussed our options before, when Wikispaces introduced an annual subscription, but the very fact that people have been prepared to pay shows that no entirely satisfactory alternative has been identified.

Richard.
 
  Reply Quote Notify of replies

 9   General Board / Re: Mouse event on redraw  on: Feb 10th, 2018, 08:50am
Started by Monkfish | Post by Rod
Code:


    'open a window and graphicbox
    WindowHeight = 300
    WindowWidth = 400
    graphicbox #w.g, 0, 0, 400, 300
    open "test" for window_nf as #w
    print #w, "trapclose [quit]"
    #w.g "setfocus"

    hw = hWnd(#w.g)
    struct MouseRect ,mx as long,my as long
    calldll #user32, "GetCursorPos",MouseRect As struct,re As Long
    calldll #user32, "ScreenToClient",hw As ulong,MouseRect As struct,re as long
    print MouseRect.mx.struct
    print MouseRect.my.struct
    wait


[quit]

    close #w
    end
 

 
  Reply Quote Notify of replies

 10   General Board / Re: Mouse event on redraw  on: Feb 9th, 2018, 7:44pm
Started by Monkfish | Post by Richard Russell
on Feb 9th, 2018, 5:13pm, tsh73 wrote:
GetCursorPos function ?

Yes, GetCursorPos followed by ScreenToClient typically.

Richard.
 
  Reply Quote Notify of replies


Donate $6.99 for 50,000 Ad-Free Pageviews!


This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls