More OpenGl Drag & Drop

[Charles Pegge]

Click the chosen box before dropping the image onto the window

Code Select Expand


  % Title "Console Drag & Drrop Image Demo"
  uses consoleG
  BeginScript

  procedure main()
  ================
  if opening
    static int res,wi[16],ht[16],imgn[16]
    static int imgne=4
    int i
    for i=1 to imgne
      texe++ 'texture slots
      imgn[i]=texe
    next
    static string wr
  end if

  cls ' .3,.3,.5
  pushstate
  move 8.0,-4.0
  'UserMovement m1,100
  '
  'display image
  '
  static int pk
  flat
  int i
  float prp
  for i=1 to imgne
    if pick
      texture 0
      picklabel 100+i
    else
      if picked=100+i
        pk=100+i
        if filedrop
          wr=filedrop
          LoadTexture wr,imgn[i],res,wi[i],ht[i] 'slot in texture
          filedrop=""
        endif
      endif
      color 1,1,1,1
      texture imgn[i]
    endif
    pushstate
    scale 3
    '
    subroutine displaybox
      if wi[i]
        prp=Ht[i]/Wi[i]
      else
        prp=1.0
      endif
      quadnorm 1.0,prp 'apply image texture to a quad
    end subroutine
    '
    gosub displaybox
    '
    if picked=100+i
      texture 0
      color 0.9,0.9,0.0
      'box-around
      thickness 2
      scale 1.05
      move 0,0,0.001
      glBegin GL_LINE_STRIP
      glVertex2f -1,-prp
      glVertex2f  1,-prp
      glVertex2f  1, prp
      glVertex2f -1, prp
      glVertex2f -1,-prp
      glEnd
      move 0,0,-0.001
    endif
    '
    popstate
    move 8.0
  next
  picklabel 0
  if pk
    i=pk-100
    pushstate
    move -20,-15
    scale 10
    texture imgn[i]
    gosub displaybox
    popstate
  endif
  texture 0
  popstate
  '
  end procedure 'main

  EndScript


[Frank Brübach]

Thanks Charles I Like it and Made this example how to place 8 Photos in Scene...
How to reduced space between Photo boxes?

Code Select Expand


'Click the chosen box before dropping the image onto the window

'CodeSelect Expand

  % Title "Console Drag & Drop Image Demo"
  uses consoleG
  BeginScript

  procedure main()
  ================
  if opening
    static int res,wi[16],ht[16],imgn[16]
    static int imgne=8
    int i
    for i=1 to imgne
      texe++ 'texture slots
      imgn[i]=texe
    next
    static string wr
  end if

  cls ' .3,.3,.5
  pushstate
  'move 8.0,-4.0 orig
  'move 6.0,-4.0
  move 2.0,-4.0
  'UserMovement m1,100
  '
  'display image
  '
  static int pk
  flat
  int i
  float prp
  for i=1 to imgne
    if pick
      texture 0
      picklabel 100+i
    else
      if picked=100+i
        pk=100+i
        if filedrop
          wr=filedrop
          LoadTexture wr,imgn[i],res,wi[i],ht[i] 'slot in texture
          filedrop=""
        endif
      endif
      color 1,1,1,1
      texture imgn[i]
    endif
    pushstate
    scale 1.5 '3
    '
    subroutine displaybox
      if wi[i]
        prp=Ht[i]/Wi[i]
      else
        prp=1.0
      endif
      move -1,0
      quadnorm 1.0,prp 'apply image texture to a quad
      'quadnorm 0.50,prp 'apply image texture to a quad measure can be modified
    end subroutine
    '
    gosub displaybox
    '
    if picked=100+i
      texture 0
      color 0.9,0.9,0.0
      'box-around
      thickness 2
      scale 1.05
      move 0,0,0.001 
      glBegin GL_LINE_STRIP
      glVertex2f -1,-prp
      glVertex2f  1,-prp
      glVertex2f  1, prp
      glVertex2f -1, prp
      glVertex2f -1,-prp
      glEnd
      move 0,0,-0.001
    endif
    '
    popstate
    move 8.0
  next
  picklabel 0
  if pk
    i=pk-100
    pushstate
    move -20,-15
    scale 10
    texture imgn[i]
    gosub displaybox
    popstate
  endif
  texture 0
  popstate
  '
  end procedure 'main

  EndScript

And its possible to make for example four rows a 4x8 Photos Like a thumbnail of each Photo?

Thanks... Frank more I havent checked Yet

[Nicola]

Charles
When is PushState or PopState used?

[Charles Pegge]

In ConsoleG, PushState and PopState manipulates a stack containing current position, scale, rotation and color. So these factors can be restored to a previous state.

[Frank Brübach]

Good morning ... Charles

Perhaps you can include a File loading to the photobox example Like this one only an idea

So you have a Kind of Imageviewer

Code Select Expand

'Click the chosen box before dropping the image onto the window

'CodeSelect Expand

  % Title "Console Drag & Drop Image Demo"
  uses consoleG
  BeginScript
'--------------------------------------- load a file format incl *jpg *png ----------- //

#define OFN_READONLY                 0x00000001
#define OFN_OVERWRITEPROMPT          0x00000002
#define OFN_HIDEREADONLY             0x00000004
#define OFN_NOCHANGEDIR              0x00000008
#define OFN_SHOWHELP                 0x00000010
#define OFN_ENABLEHOOK               0x00000020
#define OFN_ENABLETEMPLATE           0x00000040
#define OFN_ENABLETEMPLATEHANDLE     0x00000080
#define OFN_NOVALIDATE               0x00000100
#define OFN_ALLOWMULTISELECT         0x00000200
#define OFN_EXTENSIONDIFFERENT       0x00000400
#define OFN_PATHMUSTEXIST            0x00000800
#define OFN_FILEMUSTEXIST            0x00001000
#define OFN_CREATEPROMPT             0x00002000
#define OFN_SHAREAWARE               0x00004000
#define OFN_NOREADONLYRETURN         0x00008000
#define OFN_NOTESTFILECREATE         0x00010000
#define OFN_NONETWORKBUTTON          0x00020000
#define OFN_NOLONGNAMES              0x00040000     // force no long names for 4.x modules
#define OFN_EXPLORER                 0x00080000     // new look commdlg
#define OFN_NODEREFERENCELINKS       0x00100000
#define OFN_LONGNAMES                0x00200000     // force long names for 3.x modules
#define OFN_ENABLEINCLUDENOTIFY      0x00400000     // send include message to callback
#define OFN_ENABLESIZING             0x00800000
#define OFN_DONTADDTORECENT          0x02000000
#define OFN_FORCESHOWHIDDEN          0x10000000    // Show All files including System and hidden files

Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter as sys 'string
    lpstrCustomFilter As sys 'string
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As sys 'string
    nMaxFile As Long
    lpstrFileTitle As sys 'string
    nMaxFileTitle As Long
    lpstrInitialDir As sys 'string
    lpstrTitle As sys 'string
    flags As Long
    nFileOffset As word
    nFileExtension As word
    lpstrDefExt As sys 'string
    lCustData As Long
    lpfnHook As sys
    lpTemplateName As sys 'string
End Type
'76 bytes


Declare GetModuleHandle  lib "kernel32.dll" alias "GetModuleHandleA" (sys n) as sys
Declare Function GetOpenFileName  Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As sys
Declare CommDlgExtendedError Lib "comdlg32.dll" () as dword


'FileDialog( $ iDir , $ filter ,$ title , % parent ,% flag )

Function FileDialog(string iDir, filter, Title, sys Hwnd, Flags) As String
'==================
Dim ofn As OPENFILENAME
Dim filename[255] As zstring
int retval
' Allow only existing files and hide the read-only check box
'IF tFlag = 0
'print "TFLAG:"+ str(tFlag)
'filebox.flags = OFN_PATHMUSTEXIST or OFN_FILEMUSTEXIST or OFN_HIDEREADONLY
'END IF
'IF tFlag = 1
'filebox.flags = OFN_EXPLORER or OFN_OVERWRITEPROMPT or OFN_HIDEREADONLY
'END IF
ofn.lStructSize = sizeof(OPENFILENAME)
ofn.hwndOwner = hWnd
ofn.hInstance = GetModuleHandle(0)
ofn.lpstrFilter = ?filter
ofn.lpstrCustomFilter= NULL
ofn.nMaxCustFilter = 0
ofn.nFilterIndex = 2
ofn.lpstrFile = @filename 'zstring buffer
ofn.nMaxFile = 255
ofn.lpstrFileTitle = NULL
ofn.nMaxFileTitle = 0
ofn.lpstrInitialDir = ?idir
ofn.lpstrTitle = ?title
ofn.Flags = OFN_PATHMUSTEXIST or OFN_FILEMUSTEXIST or OFN_HIDEREADONLY
ofn.nFileOffset = 0
ofn.nFileExtension = 0
ofn.lpstrDefExt = NULL
ofn.lCustData = 0
ofn.lpfnHook = 0
ofn.lpTemplateName = NULL
'
retval = GetOpenFileName(ofn)
'http://msdn.microsoft.com/en-us/library/windows/desktop/ms646916(v=vs.85).aspx
'if retval=0 then print "Dialog Error " CommDlgExtendedError
return filename
'
End Function

'string dir="C:\cevp\projects\opcode\OxygenBasic\demos\GUI"
string dir=""
string sep=chr(0)
'filter=""
'--------------------- load image formats -------------------- //
string filter="*.jpg"+sep+"*.png"+sep+"text"+sep+"*.txt"+sep+
       "basic"+sep+"*.bas;*.o2bas"+sep+
       "include"+sep+"*.inc"+sep+
       "header"+sep+"*.h"+sep+
       sep

string title="Test File Opening Dialog"
sys hwnd=0
int f
'int f=FileDialog(dir,filter,title,hwnd,OFN_EXPLORER or OFN_OVERWRITEPROMPT or OFN_HIDEREADONLY)
if f then print f
'------------------
  procedure main()
  ================
  if opening
    static int res,wi[16],ht[16],imgn[16]
    static int imgne=4
    int i
    for i=1 to imgne
      texe++ 'texture slots
      imgn[i]=texe
    next
    static string wr
  end if

'---------------------- // load a file plus image formats // -------------- test
if opening
    static int f
    sys hwnd
    string title
    f=FileDialog(dir,filter,title,hwnd,OFN_EXPLORER or OFN_OVERWRITEPROMPT or OFN_HIDEREADONLY)
    return 1 
end if
'---------------------- // load a file plus image formats // -------------- test

  cls ' .3,.3,.5
  pushstate
  move 8.0,-4.0
  'UserMovement m1,100
  '
  'display image
  '
  static int pk
  flat
  int i
  float prp
  for i=1 to imgne
    if pick
      texture 0
      picklabel 100+i
    else
      if picked=100+i
        pk=100+i
        if filedrop
          wr=filedrop
          LoadTexture wr,imgn[i],res,wi[i],ht[i] 'slot in texture
          filedrop=""
        endif
      endif
      color 1,1,1,1
      texture imgn[i]
    endif
    pushstate
    scale 3
    '
    subroutine displaybox
      if wi[i]
        prp=Ht[i]/Wi[i]
      else
        prp=1.0
      endif
      quadnorm 1.0,prp 'apply image texture to a quad
    end subroutine
    '
    gosub displaybox
    '
    if picked=100+i
      texture 0
      color 0.9,0.9,0.0
      'box-around
      thickness 2
      scale 1.05
      move 0,0,0.001
      glBegin GL_LINE_STRIP
      glVertex2f -1,-prp
      glVertex2f  1,-prp
      glVertex2f  1, prp
      glVertex2f -1, prp
      glVertex2f -1,-prp
      glEnd
      move 0,0,-0.001
    endif
    '
    popstate
    move 8.0
  next
  picklabel 0
  if pk
    i=pk-100
    pushstate
    move -20,-15
    scale 10
    texture imgn[i]
    gosub displaybox
    popstate
  endif
  texture 0
  popstate
  '
  end procedure 'main

  EndScript


[Nicola]

Isn't Filedialog already present in filedialog.inc?

[Frank Brübach]

Yes of course but If you want to Filter the string the File Format EG for jpg PNG bmp etcpp you must declare what Kind of Images Here to load

Another way could be to combine grid example with photobox example See my Dummy  Pic below  its Just an idea

[Nicola]

In fact I saw that you could only send the filter built as needed in the program under construction.

Code Select Expand

string sep=chr(0)
  filter=
  "all files"+sep+"*.*"+sep+
  "text"+sep+"*.txt"+sep+
  "basic"+sep+"*.bas;*.o2bas"+sep+
  "include"+sep+"*.inc"+sep+
  "header"+sep+"*.h"+sep+

[Charles Pegge]

I wouldn't worry too much about filters. I envisage a system where you might want to load obj, mtl, or even txt files, as well as image files, and the software should be able to handle them intelligently.

[Charles Pegge]

The code used for Ctrl-O opening and Ctrl-S saving dialogs in a ConsoleG environment:

Code Select Expand

uses consoleG
 uses FileDialogs

  'FILING
  if keystate(VK_CONTROL)
    int a=-1
    if lastkey=0x4f  'Open
      a=0
    elseif lastkey=0x53 'Save
      a=1
    endif
    if a>=0
      string ff
      scope
        char ch[256]
        GetCurrentDirectory 255,ch
        ff=GetFileName "t.txt",a
        if a=0
          filedrop=ff
          ff=""
        endif
        SetCurrentDirectory ch 'restore dir
      end scope
      'mbox filedrop
      lastkey=0
      lastchar=0
      key[VK_CONTROL]=0
    endif
  endif

Integrated into Drag & Drop

Code Select Expand


  % Title "Console Drag & Drrop Image Demo"
  uses consoleG
  uses filedialogs

  BeginScript

  procedure main()
  ================
  if opening
    static int res,wi[16],ht[16],imgn[16]
    static int imgne=4
    int i
    for i=1 to imgne
      texe++ 'texture slots
      imgn[i]=texe
    next
    static string wr
  end if

  'FILING
  if keystate(VK_CONTROL)
    int a=-1
    if lastkey=0x4f  'Open
      a=0
    elseif lastkey=0x53 'Save
      a=1
    endif
    if a>=0
      string ff
      scope
        char ch[256]
        GetCurrentDirectory 255,ch
        ff=GetFileName "t.txt",a
        if a=0
          filedrop=ff
          ff=""
        endif
        SetCurrentDirectory ch 'restore dir
      end scope
      'mbox filedrop
      lastkey=0
      lastchar=0
      key[VK_CONTROL]=0
    endif
  endif

  cls ' .3,.3,.5
  pushstate
  move 8.0,-4.0
  'UserMovement m1,100
  '
  'display image
  '
  static int pk
  flat
  int i
  float prp
  for i=1 to imgne
    if pick
      texture 0
      picklabel 100+i
    else
      if picked=100+i
        pk=100+i
        if filedrop
          wr=filedrop
          LoadTexture wr,imgn[i],res,wi[i],ht[i] 'slot in texture
          filedrop=""
        endif
      endif
      color 1,1,1,1
      texture imgn[i]
    endif
    pushstate
    scale 3
    '
    subroutine displaybox
      if wi[i]
        prp=Ht[i]/Wi[i]
      else
        prp=1.0
      endif
      quadnorm 1.0,prp 'apply image texture to a quad
    end subroutine
    '
    gosub displaybox
    '
    if picked=100+i
      texture 0
      color 0.9,0.9,0.0
      'box-around
      thickness 2
      scale 1.05
      move 0,0,0.001
      glBegin GL_LINE_STRIP
      glVertex2f -1,-prp
      glVertex2f  1,-prp
      glVertex2f  1, prp
      glVertex2f -1, prp
      glVertex2f -1,-prp
      glEnd
      move 0,0,-0.001
    endif
    '
    popstate
    move 8.0
  next
  picklabel 0
  if pk
    i=pk-100
    pushstate
    move -20,-15
    scale 10
    texture imgn[i]
    gosub displaybox
    popstate
  endif
  texture 0
  popstate
  '
  end procedure 'main

  EndScript


[Frank Brübach]

Good morning Charles.. thanks for your example but If I want to Test IT I am getting an Error Message..

See my example below

1) Both together used consoleG and uses Filedialogs produce this Error

2) If I am using uses filedialos Alone I can get the File Name

Code Select Expand


print "testFile + consoleG"
'
' both together consoleG + FileDialogs dont run
'
uses consoleG
uses FileDialogs

' error message:
' unidentified element type
' line 36 SYS
' inc/filedialogs.inc
'
' if I use only in code "uses FileDialogs" all ok

  string fi=GetFileName("t.txt", 0)
  if fi then print fi

dim a,b,c as sys
dim k as sys
a=100 : b=200 : c=300
k=a*b*c
print "Result: "+k

Did you change one of the Last oxygen Updates the filedialogs.inc?

Regards Frank

[Frank Brübach]

OK I found the Problem with Filedialog function has changed... In one of the Last Updates...

Here the fixed Version with all necessary Headers

Code Select Expand

' I have fixed the Filedialog function
'

Title "Console Drag & Drrop Image Demo, ,openFile"
  uses consoleG
  'uses filedialogs

  BeginScript

BeginScript

#define OFN_READONLY                0x00000001
#define OFN_OVERWRITEPROMPT          0x00000002
#define OFN_HIDEREADONLY            0x00000004
#define OFN_NOCHANGEDIR              0x00000008
#define OFN_SHOWHELP                0x00000010
#define OFN_ENABLEHOOK              0x00000020
#define OFN_ENABLETEMPLATE          0x00000040
#define OFN_ENABLETEMPLATEHANDLE    0x00000080
#define OFN_NOVALIDATE              0x00000100
#define OFN_ALLOWMULTISELECT        0x00000200
#define OFN_EXTENSIONDIFFERENT      0x00000400
#define OFN_PATHMUSTEXIST            0x00000800
#define OFN_FILEMUSTEXIST            0x00001000
#define OFN_CREATEPROMPT            0x00002000
#define OFN_SHAREAWARE              0x00004000
#define OFN_NOREADONLYRETURN        0x00008000
#define OFN_NOTESTFILECREATE        0x00010000
#define OFN_NONETWORKBUTTON          0x00020000
#define OFN_NOLONGNAMES              0x00040000    // force no long names for 4.x modules
#define OFN_EXPLORER                0x00080000    // new look commdlg
#define OFN_NODEREFERENCELINKS      0x00100000
#define OFN_LONGNAMES                0x00200000    // force long names for 3.x modules
#define OFN_ENABLEINCLUDENOTIFY      0x00400000    // send include message to callback
#define OFN_ENABLESIZING            0x00800000
#define OFN_DONTADDTORECENT          0x02000000
#define OFN_FORCESHOWHIDDEN          0x10000000    // Show All files including System and hidden files

Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter as sys 'string
    lpstrCustomFilter As sys 'string
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As sys 'string
    nMaxFile As Long
    lpstrFileTitle As sys 'string
    nMaxFileTitle As Long
    lpstrInitialDir As sys 'string
    lpstrTitle As sys 'string
    flags As Long
    nFileOffset As word
    nFileExtension As word
    lpstrDefExt As sys 'string
    lCustData As Long
    lpfnHook As sys
    lpTemplateName As sys 'string
End Type
'76 bytes


Declare GetModuleHandle  lib "kernel32.dll" alias "GetModuleHandleA" (sys n) as sys
Declare Function GetOpenFileName  Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As sys
Declare CommDlgExtendedError Lib "comdlg32.dll" () as dword


'FileDialog( $ iDir , $ filter ,$ title , % parent ,% flag )

'-------------------------------------------------------------------------- //
Function FileDialog(string iDir, filter, Title, sys Hwnd, Flags) As String
'==========================================================================

Dim ofn As OPENFILENAME
Dim filename[255] As zstring
int retval   
    ' Allow only existing files and hide the read-only check box
    'IF tFlag = 0
    'print "TFLAG:"+ str(tFlag)
    'filebox.flags = OFN_PATHMUSTEXIST or OFN_FILEMUSTEXIST or OFN_HIDEREADONLY
    'END IF
    'IF tFlag = 1
    'filebox.flags = OFN_EXPLORER or OFN_OVERWRITEPROMPT or OFN_HIDEREADONLY
    'END IF
ofn.lStructSize = sizeof(OPENFILENAME)
ofn.hwndOwner = hWnd
ofn.hInstance = GetModuleHandle(0)
ofn.lpstrFilter = ?filter
ofn.lpstrCustomFilter= NULL
ofn.nMaxCustFilter = 0
ofn.nFilterIndex = 2
ofn.lpstrFile = @filename 'zstring buffer
ofn.nMaxFile = 255
ofn.lpstrFileTitle = NULL
ofn.nMaxFileTitle = 0
ofn.lpstrInitialDir = ?idir
ofn.lpstrTitle = ?title
ofn.Flags = OFN_PATHMUSTEXIST or OFN_FILEMUSTEXIST or OFN_HIDEREADONLY
ofn.nFileOffset = 0
ofn.nFileExtension = 0
ofn.lpstrDefExt = NULL
ofn.lCustData = 0
ofn.lpfnHook = 0
ofn.lpTemplateName = NULL
'
retval = GetOpenFileName(ofn)
'http://msdn.microsoft.com/en-us/library/windows/desktop/ms646916(v=vs.85).aspx
'if retval=0 then print "Dialog Error " CommDlgExtendedError
return filename
'
'End Function

'string dir="C:\cevp\projects\opcode\OxygenBasic\demos\GUI"
string dir=""
string sep=chr(0)
'filter=""
'--------------------- load image formats -------------------- //
string filter="*.jpg"+sep+"*.png"+sep+"text"+sep+"*.txt"+sep+
      "basic"+sep+"*.bas;*.o2bas"+sep+
      "include"+sep+"*.inc"+sep+
      "header"+sep+"*.h"+sep+
      sep

string title="Test File Opening Dialog"
sys hwnd=0
int f
' fileDialog new below --- :-)
'int f=FileDialog(dir,filter,title,hwnd,OFN_EXPLORER or OFN_OVERWRITEPROMPT or OFN_HIDEREADONLY)
if f then print f
Dim filename[255] As zstring

if retval
  return filename
end if

End Function


Function GetFileName(string name, sys a, string filt="") as string
'=================================================================
'
'dir="OxygenBasic\demos\GUI"
'
sys    hwnd
string filter,dir,title
'
if filt then
  filter=filt
else
  string sep=chr(0)
  filter=
  "all files"+sep+"*.*"+sep+
  "text"+sep+"*.txt"+sep+
  "basic"+sep+"*.bas;*.o2bas"+sep+
  "include"+sep+"*.inc"+sep+
  "header"+sep+"*.h"+sep+
  sep
end if
'
if a then
  title="Save File as"
else
  title="Load File"
end if
'
sys flags = OFN_EXPLORER or OFN_OVERWRITEPROMPT or OFN_HIDEREADONLY
'
return FileDialog(dir,filter,title,hwnd,OFN_EXPLORER or OFN_OVERWRITEPROMPT or OFN_HIDEREADONLY)
'return FileDialog(dir,filter,title,name,hwnd,flags,a)
'
end function

  'BeginScript


  procedure main()
  ================
  if opening
    static int res,wi[16],ht[16],imgn[16]
    static int imgne=4
    int i
    for i=1 to imgne
      texe++ 'texture slots
      imgn[i]=texe
    next
    static string wr
  end if


'---- "o"=79 0x4F 'open
'---- "s"=83 0x53 'save

  'FILING
  'if keystate(VK_CONTROL)
  if keystate(79) '(83)
    int a=-1
    if lastkey=0x4f  'Open '0x53 = 83
      a=0
    elseif lastkey=0x53 'Save
      a=1
    endif
    if a>=0
      string ff
      scope
        char ch[256]
        GetCurrentDirectory 255,ch
        ff=GetFileName "t.txt",a
        if a=0
          filedrop=ff
          ff=""
        endif
        SetCurrentDirectory ch 'restore dir
      end scope
      'mbox filedrop
      lastkey=0
      lastchar=0
      key[VK_CONTROL]=0
    endif
  endif

  cls ' .3,.3,.5
  pushstate
  move 8.0,-4.0
  'UserMovement m1,100
  '
  'display image
  '
  static int pk
  flat
  int i
  float prp
  for i=1 to imgne
    if pick
      texture 0
      picklabel 100+i
    else
      if picked=100+i
        pk=100+i
        if filedrop
          wr=filedrop
          LoadTexture wr,imgn[i],res,wi[i],ht[i] 'slot in texture
          filedrop=""
        endif
      endif
      color 1,1,1,1
      texture imgn[i]
    endif
    pushstate
    scale 3
    '
    subroutine displaybox
      if wi[i]
        prp=Ht[i]/Wi[i]
      else
        prp=1.0
      endif
      quadnorm 1.0,prp 'apply image texture to a quad
    end subroutine
    '
    gosub displaybox
    '
    if picked=100+i
      texture 0
      color 0.9,0.9,0.0
      'box-around
      thickness 2
      scale 1.05
      move 0,0,0.001
      glBegin GL_LINE_STRIP
      glVertex2f -1,-prp
      glVertex2f  1,-prp
      glVertex2f  1, prp
      glVertex2f -1, prp
      glVertex2f -1,-prp
      glEnd
      move 0,0,-0.001
    endif
    '
    popstate
    move 8.0
  next
  picklabel 0
  if pk
    i=pk-100
    pushstate
    move -20,-15
    scale 10
    texture imgn[i]
    gosub displaybox
    popstate
  endif
  texture 0
  popstate
  '
  end procedure 'main

  EndScript
 
That was Not easy to find the solution

[Charles Pegge]

Hi Frank,

Yes there was a problem with uppercase SYS. The opengl environment is capital-sensitive:

Filedialogs.inc should look like this

Code Select Expand

'no case sensitivity

#ifndef HAS_COREWIN
  uses corewin
#endif

% OFN_READONLY                0x00000001
% OFN_OVERWRITEPROMPT          0x00000002
% OFN_HIDEREADONLY            0x00000004
% OFN_NOCHANGEDIR              0x00000008
% OFN_SHOWHELP                0x00000010
% OFN_ENABLEHOOK              0x00000020
% OFN_ENABLETEMPLATE          0x00000040
% OFN_ENABLETEMPLATEHANDLE    0x00000080
% OFN_NOVALIDATE              0x00000100
% OFN_ALLOWMULTISELECT        0x00000200
% OFN_EXTENSIONDIFFERENT      0x00000400
% OFN_PATHMUSTEXIST            0x00000800
% OFN_FILEMUSTEXIST            0x00001000
% OFN_CREATEPROMPT            0x00002000
% OFN_SHAREAWARE              0x00004000
% OFN_NOREADONLYRETURN        0x00008000
% OFN_NOTESTFILECREATE        0x00010000
% OFN_NONETWORKBUTTON          0x00020000
% OFN_NOLONGNAMES              0x00040000    '// force no long names for 4.x modules
% OFN_EXPLORER                0x00080000    '// new look commdlg
% OFN_NODEREFERENCELINKS      0x00100000
% OFN_LONGNAMES                0x00200000    '// force long names for 3.x modules
% OFN_ENABLEINCLUDENOTIFY      0x00400000    '// send include message to callback
% OFN_ENABLESIZING            0x00800000
% OFN_DONTADDTORECENT          0x02000000
% OFN_FORCESHOWHIDDEN          0x10000000    '// Show All files including System and hidden files


type OPENFILENAMEA
  dword  lStructSize
  sys    hwndOwner
  sys    hInstance
  char*  lpstrFilter
  char*  lpstrCustomFilter
  dword  nMaxCustFilter
  dword  nFilterIndex
  char*  lpstrFile
  dword  nMaxFile
  char*  lpstrFileTitle
  dword  nMaxFileTitle
  char*  lpstrInitialDir
  char*  lpstrTitle
  dword  Flags
  word  nFileOffset
  word  nFileExtension
  char*  lpstrDefExt
  long  lCustData
  sys    lpfnHook
  char*  lpTemplateName
end type

typedef OPENFILENAMEA OPENFILENAME

Declare GetModuleHandle      lib "kernel32.dll" alias "GetModuleHandleA" (optional char*n) as sys
Declare GetOpenFileName      Lib "comdlg32.dll" Alias "GetOpenFileNameA" (OPENFILENAME*opfn) As sys
Declare GetSaveFileName      Lib "comdlg32.dll" Alias "GetSaveFileNameA" (OPENFILENAME*opfn) As sys
Declare CommDlgExtendedError Lib "comdlg32.dll" () as dword


'FileDialog( $ iDir , $ filter ,$ title , % parent , flag )


Function FileDialog(string iDir,filter,Title,Name, sys Hwnd, Flags, a) As String
'===============================================================================

def FileNameLen 256

OPENFILENAME ofn
char        FileName[FileNameLen]
if Name then FileName=Name
int          retval   

 ofn.lStructSize      = sizeof(OPENFILENAME)
 ofn.hwndOwner        = hWnd
 ofn.hInstance        = GetModuleHandle
 ofn.lpstrFilter      = filter
 ofn.lpstrCustomFilter = null
 ofn.nMaxCustFilter    = 0
 ofn.nFilterIndex      = 1
 ofn.lpstrFile        = FileName 'coupling to char buffer
 ofn.nMaxFile          = FileNameLen
 ofn.lpstrFileTitle    = null
 ofn.nMaxFileTitle    = 0
 ofn.lpstrInitialDir  = idir
 ofn.lpstrTitle        = title
 ofn.Flags            = flags
 ofn.nFileOffset      = 0
 ofn.nFileExtension    = 0
 ofn.lpstrDefExt      = null
 ofn.lCustData        = 0
 ofn.lpfnHook          = 0
 ofn.lpTemplateName    = null


sys retval
'
if a then
 retval=GetSaveFileName(ofn)
else
 retval=GetOpenFileName(ofn)
end if
'
'http://msdn.microsoft.com/en-us/library/windows/desktop/ms646916(v=vs.85).aspx

if retval
  return filename
end if

End Function


Function GetFileName(string name, sys a, string filt="") as string
'=================================================================
'
'dir="OxygenBasic\demos\GUI"
'
sys    hwnd
string filter,dir,title
'
if filt then
  filter=filt
else
  string sep=chr(0)
  filter=
  "all files"+sep+"*.*"+sep+
  "text"+sep+"*.txt"+sep+
  "basic"+sep+"*.bas;*.o2bas"+sep+
  "include"+sep+"*.inc"+sep+
  "header"+sep+"*.h"+sep+
  sep
end if
'
if a then
  title="Save File as"
else
  title="Load File"
end if
'
sys flags = OFN_EXPLORER or OFN_OVERWRITEPROMPT or OFN_HIDEREADONLY
'
return FileDialog(dir,filter,title,name,hwnd,flags,a)
'
end function



'! SHBrowseForFolder Lib "shell32" (BrowseInfo *lpbi) as sys
'! SHGetPathFromIDList Lib "shell32" (sys pidList, sys lpBuffer) As sys



function BrowseCallbackProc(sys hwnd, int uMsg, sys wParam, lParam) as int, callback
====================================================================================
'Used with the BrowseForFolder function to select a default folder
  % BFFM_ENABLEOK      0x465
  % BFFM_SETSELECTION  0x466
  % BFFM_SETSTATUSTEXT  0x464
  % BFFM_INITIALIZED    1
  % BFFM_SELCHANGED    2
  % BFFM_VALIDATEFAILED 3
  '
  if uMsg = BFFM_INITIALIZED
    SendMessage(hwnd, BFFM_SETSELECTION, uMsg, lParam )
  endif
  return 0  ' the function should always return 0
end function


type BrowseInfo
  sys hWndOwner
  sys pIDLRoot
  sys pszDisplayName
  sys lpszTitle
  int ulFlags
  sys lpfnCallback
  sys lParam
  int iImage
end type
'
function BrowseForDir(sys hWnd,  string strTitle="", strInitDir="\" ) as string
===============================================================================
 '% BIF_RETURNONLYFSDIRS = 1
 '% BIF_EDITBOX = &H10
  % MAX_PATH = 260
  '
  BrowseInfo tbi
  tbi.hWndOwner = hwnd
  tbi.lpszTitle = strptr(strTitle)
 'tbi.ulFlags = BIF_RETURNONLYFSDIRS or BIF_EDITBOX
  tbi.lpfnCallback = @BrowseCallbackProc
  tbi.lParam = strptr(strInitDir)
  sys h = SHBrowseForFolder(@tbi)
  if h
    char s[MAX_PATH]
    SHGetPathFromIDList(h, s)
    return s
  endif
end function

'USAGE:
'sys hWnd=0
'print strDir = BrowseForDir(hWnd,"Select a Folder","c:\users")


[Frank Brübach]

Hello Charles and all ...

Here is the fixed Version of photobox drag and drop with File save function and I did two Info lines too how to handle this example

Oxygen consoleG (OpenGL) example

Code Select Expand

' fixed example cause of wrong filedialogs.inc file some weeks ago
' by frank bruebach, oxygen, 14.01.2024
'
% Title "Console Drag & Drop Image / File Demo"
  uses consoleG
  uses filedialogs

  BeginScript

  procedure main()
  ================
  if opening
    static int res,wi[16],ht[16],imgn[16]
    static int imgne=4
    int i
    for i=1 to imgne
      texe++ 'texture slots
      imgn[i]=texe
    next
    static string wr
  end if

  'FILING save and open ------------------------- //
  if keystate(83) or keystate(79) 'VK_CONTROL
    int a=-1
    if lastkey=0x4f 
      a=0
    elseif lastkey=0x53
      a=1
    endif
    if a>=0
      string ff
      scope
        char ch[256]
        GetCurrentDirectory 255,ch
        ff=GetFileName "t.txt",a
        if a=0
          filedrop=ff
          ff=""
        endif
        SetCurrentDirectory ch 'restore dir
      end scope
      'mbox filedrop
      lastkey=0
      lastchar=0
      key[VK_CONTROL]=0
    endif
  endif

  cls ' .3,.3,.5
  pushstate
  move 8.0,-4.0
  'UserMovement m1,100
  '
  'display image
  '
  static int pk
  flat
  int i
  float prp
  for i=1 to imgne
    if pick
      texture 0
      picklabel 100+i
    else
      if picked=100+i
        pk=100+i
        if filedrop
          wr=filedrop
          LoadTexture wr,imgn[i],res,wi[i],ht[i] 'slot in texture
          filedrop=""
        endif
      endif
      color 1,1,1,1
      texture imgn[i]
    endif
    pushstate
    scale 3
    '
    subroutine displaybox
      if wi[i]
        prp=Ht[i]/Wi[i]
      else
        prp=1.0
      endif
      quadnorm 1.0,prp 'apply image texture to a quad
    end subroutine
    '
    gosub displaybox
    '
    if picked=100+i
      texture 0
      color 0.9,0.9,0.0
      'box-around
      thickness 2
      scale 1.05
      move 0,0,0.001
      glBegin GL_LINE_STRIP
      glVertex2f -1,-prp
      glVertex2f  1,-prp
      glVertex2f  1, prp
      glVertex2f -1, prp
      glVertex2f -1,-prp
      glEnd
      move 0,0,-0.001
    endif
    '
    popstate
    move 8.0
  next
  picklabel 0
  if pk
    i=pk-100
    pushstate
    move -20,-15
    scale 10
    texture imgn[i]
    gosub displaybox
    popstate
  endif
  texture 0
  popstate

gprint "info: 2) press 'O' key for open a file / photo, press 'S' key to save a file / picture"
move -31,0.85
gprint "info: 1) pick a photo and drag it into one of the four little boxes (rectangle)" '+cr+
  end procedure 'main
  EndScript