Werkzeug-Verwaltung

H.Brill

Habe mal eine kleine Werkzeugverwaltung gemacht.

Vielleicht kann es jemand gebrauchen, sei es auch nur zur

Anregung für andere Aufgaben. Die Felder bzw. Spalten sind

ja schnell umgestellt. Dabei können auch Bilder, passend zu den

Werkzeugen angezeigt werden. Damit es immer eindeutig ist, welches

Bild zu welchem Werkzeug gehört, kann die Bilddatei als Seriennr.png (oder .jpg)

gespeichert werden. Also etwa so : 4711.png oder NX-4711.jpg usw.

Eine Umschaltung zwischen beiden Formaten ist als Menüpunkt Bildformat

realisiert.

Quelltext ist auch für die Anfänger mit viel Kommentaren geschrieben.

Viel Spaß damit.

Da die Größe zum Einstellen zu hoch ist, ist im Anhang eine Zip-Datei

mit Quellcode und einer Beispiel-DB (.csv) und den Bildern.

H.Brill

Hier mal die Version ohne Kommentare, da der eine oder andere

keine .zip Datei downloaden mag.

Code

' wegen den Move-Befehlen insbes. Move("FileToList",..)
' ab Version X3 bzw. Freeprofan lauffähig.
$H commctrl.ph

Declare Handle grid, ilist, TB, Texte[], Edit[], st, pic, choice1, choice2
Declare String d, spalten, zeile, dateiendung

Declare Long ende, pos, wahl, knopf

MCls 150, 200, RGB(255, 0, 0) 
StartPaint -1
  DrawText 20, 20, "Kein Bild "
  DrawText 20, 50, "vorhanden !"
  DrawText 20, 80, "Bitte ein Bild"
  DrawText 20, 110, "z.B. Seriennr.png"
  DrawText 20, 140, "in Ordner kopieren !"
EndPaint

dateiendung = ".png" 

d = $ProgDir + "Werkzeuge.csv"
spalten = "Werkzeugtyp;0;140;SerienNr.;0;80;Hersteller;0;140;Lagerort;0;140"
ende = 0
ilist = Create("ImageList", 32, 32, Create("hPic", 0, "TOOLBAR32"), RGB(192, 192, 192))

WindowTitle "Werkzeug - Verwaltung"
Window 820, 500

UseIcon "A" ' Fenster-Icon ändern

Removemenu 32767 ' CopyRight - Zeichen entfernen

TB    = Create("TOOLBAR", %HWnd, ilist, 0, 0, 2000, 1)
Toolbar("AddButton", TB, 2,  2000, "Laden")
Toolbar("AddButton", TB, 13, 2001, "Speichern")
Toolbar("AddButton", TB, 45, 2002, "Übernehmen")
Toolbar("AddButton", TB, 33, 2003, "Ändern")
Toolbar("AddButton", TB, 10, 2004, "Löschen")
Toolbar("AddButton", TB, 17, 2005, "Suchen")
Toolbar("AddButton", TB, 51, 2006, "Hilfe")
Toolbar("AddButton", TB, 49, 2007, "Ende")

' GUI aufbauen
Texte[0]  = Create("Text",   %HWnd, "Werkzeugtyp", 10, 60, 100, 25)
Texte[1]  = Create("Text",   %HWnd, "SerienNr.  ", 280, 60, 100, 25)
Texte[2]  = Create("Text",   %HWnd, "Hersteller ", 10, 100, 100, 25)
Texte[3]  = Create("Text",   %HWnd, "Lagerort   ", 280, 100, 100, 25)
Edit[0]   = Create("Edit",   %HWnd, "", 120, 60, 140, 25)
Edit[1]   = Create("Edit",   %HWnd, "", 390, 60, 180, 25)
Edit[2]   = Create("Edit",   %HWnd, "", 120, 100, 140, 25)
Edit[3]   = Create("Edit",   %HWnd, "", 390, 100, 180, 25)
choice1   = Create("RadioButton", %HWnd, "Suche nach Werkzeugtyp", 600, 60, 190, 25)
choice2   = Create("RadioButton", %HWnd, "Suche nach Hersteller ", 600, 100, 190, 25)

SetCheck choice1, 1

st = Create("Static", %HWnd, 550, 160, 150, 200)

grid  = Create("GridBox", %HWnd, spalten, 2, 10, 140, 520, 250)

CreateMenu %HWnd
PopUp "Bildformat"
AppendMenu 101, ".png - Dateien"
AppendMenu 102, ".jpg - Dateien"
Separator
AppendMenu 103, "&Ende"

If FileExists(d)
   Laden()
EndIf

UserMessages $10 

WhileNot ende
  WaitInput
  If Clicked(grid)
     pos = GetCurSel(grid)
     If pos > -1
       ' Editfelder füllen
       zeile = GetString$(grid, pos)
       SetText edit[0], SubStr$(zeile, 1, "|")
       SetText edit[1], SubStr$(zeile, 2, "|")
       SetText edit[2], SubStr$(zeile, 3, "|")
       SetText edit[3], SubStr$(zeile, 4, "|")
       If FileExists(GetText$(edit[1]) + dateiendung)
          StartPaint st
            pic = Create("hSizedPic", -1, GetText$(edit[1]) + dateiendung, 150, 200, 1)
            SetWindowPos st = 550, 160 - %BmpX, %BmpY
            DrawPic pic, 0, 0; 0
          EndPaint
       Else
          pic = Create("hSizedPic", 0, "&MEMBMP", 150, 200, 1)
          SetWindowPos st = 550, 160 - 150, 200
          StartPaint st
            DrawPic pic, 0, 0; 0
          EndPaint
       EndIf
     EndIf
  EndIf
  If MenuItem(101)
     dateiendung = ".png"
     CheckMenu 101, 1
     CheckMenu 102, 0
  ElseIf MenuItem(102)
     dateiendung = ".jpg"
     CheckMenu 101, 0
     CheckMenu 102, 1
  ElseIf MenuItem(103)
     ProgEnde()
  ElseIf MenuItem(2000)
     ' Laden
     Laden()
  ElseIf MenuItem(2001)
     ' Speichern
     Speichern()
  ElseIf MenuItem(2002)
     ' Übernehmen
     Uebernehmen()
  ElseIf MenuItem(2003)
    ' Ändern
    Aendern()
  ElseIf MenuItem(2004)
    ' Löschen
    knopf = MessageBox("Sind Sie wirklich sicher ?", "Datensatz Löschen", 292)
    Case knopf = 6 :  Loeschen()
  ElseIf MenuItem(2005)
    ' Suchen
    If GetCheck(choice1)
       wahl = 1
    ElseIf GetCheck(choice2)
       wahl = 2
    EndIf
    Suchen(wahl)
  ElseIf MenuItem(2006)
    Hilfe()
  ElseIf MenuItem(2007)
    ProgEnde()
  EndIf
  If IsKey(27) > 0
     ProgEnde()
  EndIf
  If %UMessage = $10
     ProgEnde()
  EndIf
EndWhile

Proc Aendern
pos = GetCurSel(grid)
SetText grid, pos, 0, GetText$(Edit[0])
SetText grid, pos, 1, GetText$(Edit[1])
SetText grid, pos, 2, GetText$(Edit[2])
SetText grid, pos, 3, GetText$(Edit[3])
EndProc

Proc Loeschen
pos = GetCurSel(grid)
If pos > -1
   DeleteString(grid, pos)
EndIf
EndProc

Proc Speichern
Declare Long anzahl
  ClearList
  If GetCount(grid) > 0
     ClearList
     Move("HandleToList", grid)
     DeleteString(0, GetCount(0))
     anzahl = Move("ListToFile", d)
     MessageBox(Str$(anzahl) + " Datensätze gespeichert !", "Info", 0)
  Else
     MessageBox("Keine Datensätze in\nTabelle vorhanden !", "Info", 0)
  EndIf
EndProc

Proc Laden
Declare Long anzahl
  ClearList
  ClearList grid
  anzahl = Move("FileToList", d)
  Move("ListToHandle", grid)
  MessageBox(Str$(anzahl) + " Datensätze geladen !", "Info", 0)
EndProc

Proc Uebernehmen
zeile = GetText$(Edit[0]) + "|" + GetText$(Edit[1]) + "|" + GetText$(Edit[2]) + "|" + GetText$(Edit[3])
AddString(grid, zeile)
SetCurSel grid, GetCount(grid) - 1
EndProc

Proc Suchen
Parameters Long w
Declare String such, z
Declare Long p
Set("RegEx", 1)
Select w
  CaseOf 1
    such = GetText$(edit[0])
    p = 1
  CaseOf 2
    such = GetText$(edit[2])
    p = 3
EndSelect
LvDeSelect grid, -1
WhileLoop 0, GetCount(grid) - 1
   z = GetString$(grid, &LOOP)
   If Instr(Upper$(such), Upper$(SubStr$(z, p, "|")))
      LvSelect(grid, &LOOP)
      SetCurSel grid, &LOOP
   EndIf
EndWhile
Set("RegEx", 0)
EndProc

Proc Hilfe
Declare String htext
  htext = "Bitte die Bilder als serienr.png in den \nProgramm-Ordner speichern ! z.B. 123456.png\nSo bleiben die Zuordnungen immer eindeutig\nauch bei mehreren Teilen gleichen Typs !"
  MessageBox(htext, "Hilfe", 0)
EndProc

Proc LvDeSelect
Parameters Lv&,Item&
 Declare s#
 Dim s#,1024
 Long s#,12=0
 Long s#,16 = ~LVIS_SELECTED | ~LVIS_FOCUSED
 SendMessage(Lv&, ~LVM_SETITEMSTATE,Item&,s#)
 Dispose s#
EndProc

Proc LvSelect
Parameters Lv&,Item&
Declare s#
Dim s#,1024
Long s#,12=$2
Long s#,16= ~LVIS_SELECTED | ~LVIS_FOCUSED
SendMessage(Lv&,~LVM_SETITEMSTATE,Item&,s#)
SendMessage(lv&,~LVM_SETHOTITEM ,item&,0)
SendMessage(lv&,~LVM_ENSUREVISIBLE ,Item&,0)
Dispose s#
Endproc

Proc ProgEnde
knopf = Messagebox("Vor Beenden Speichern ?", "Frage", 292)
If knopf = 6
   Speichern(d)
EndIf
ende = 1
EndProc

UserMessages 0
DeleteObject ilist

End

Alles anzeigen

H.Brill

Hier nochmal eine Erweiterung.

Vom Explorer aus kann man die Bilddateien per Drag & Drop auf das

Programmfenster ziehen. Die Dateien werden dann im aktuellen

Programmverzeichnis gespeichert. Erspart einen Teil des Kopierens,

wenn neue Bilddateien hinzu kommen.

Code

$H windows.ph
$H structs.ph
$H messages.ph
$H shellapi.ph
$H commctrl.ph

Def DragAcceptFiles(2) !"SHELL32","DragAcceptFiles"
Def DragFinish(1) !"SHELL32","DragFinish"
Def DragQueryFile(4) !"SHELL32","DragQueryFileA"
Def Sleep(1) !"KERNEL32","Sleep"

' wegen den Move-Befehlen insbes. Move("FileToList",..)
' ab Version X3 bzw. Freeprofan lauffähig.
' Einige API-Konstanten zum Selektieren/DeSelektieren
' stehen alle in der commctrl.ph
' zu finden bei
' https://xprofan.net/intl/de/header/
' Diese .ph Dateien gehören unbedingt in den INCLUDE - Ordner, den man
' anlegen sollte. Hier die wichtigsten :
' comdlg.ph, commctrl.ph, lzexpand.ph, messages.ph, richedit.ph, shellapi.ph, structs.ph, windows.ph

Declare Handle grid, ilist, TB, Texte[], Edit[], st, pic, choice1, choice2
Declare String d, spalten, zeile, dateiendung, filename, olddir, Memory pfilename
Declare Long ende, pos, wahl, knopf, anzahl, i
Dim PFileName, 461


MCls 150, 200, RGB(255, 0, 0) 
StartPaint -1                 
  DrawText 20, 20, "Kein Bild "
  DrawText 20, 50, "vorhanden !"
  DrawText 20, 80, "Bitte ein Bild"
  DrawText 20, 110, "z.B. Seriennr.png"
  DrawText 20, 140, "in Ordner kopieren !"
EndPaint

dateiendung = ".png"  ' vor eingestellt

d = $ProgDir + "Werkzeuge.csv"
spalten = "Werkzeugtyp;0;140;SerienNr.;0;80;Hersteller;0;140;Lagerort;0;140"
ende = 0
ilist = Create("ImageList", 32, 32, Create("hPic", 0, "TOOLBAR32"), RGB(192, 192, 192))

WindowTitle "Werkzeug - Verwaltung"
Window 820, 500

DragAcceptFiles(%hwnd,1)
UseIcon "A" 
Removemenu 32767

TB    = Create("TOOLBAR", %HWnd, ilist, 0, 0, 2000, 1)
Toolbar("AddButton", TB, 2,  2000, "Laden")
Toolbar("AddButton", TB, 13, 2001, "Speichern")
Toolbar("AddButton", TB, 45, 2002, "Übernehmen")
Toolbar("AddButton", TB, 33, 2003, "Ändern")
Toolbar("AddButton", TB, 10, 2004, "Löschen")
Toolbar("AddButton", TB, 17, 2005, "Suchen")
Toolbar("AddButton", TB, 51, 2006, "Hilfe")
Toolbar("AddButton", TB, 49, 2007, "Ende")

' GUI aufbauen
Texte[0]  = Create("Text",   %HWnd, "Werkzeugtyp", 10, 60, 100, 25)
Texte[1]  = Create("Text",   %HWnd, "SerienNr.  ", 280, 60, 100, 25)
Texte[2]  = Create("Text",   %HWnd, "Hersteller ", 10, 100, 100, 25)
Texte[3]  = Create("Text",   %HWnd, "Lagerort   ", 280, 100, 100, 25)
Edit[0]   = Create("Edit",   %HWnd, "", 120, 60, 140, 25)
Edit[1]   = Create("Edit",   %HWnd, "", 390, 60, 180, 25)
Edit[2]   = Create("Edit",   %HWnd, "", 120, 100, 140, 25)
Edit[3]   = Create("Edit",   %HWnd, "", 390, 100, 180, 25)
choice1   = Create("RadioButton", %HWnd, "Suche nach Werkzeugtyp", 600, 60, 190, 25)
choice2   = Create("RadioButton", %HWnd, "Suche nach Hersteller ", 600, 100, 190, 25)

SetCheck choice1, 1

st = Create("Static", %HWnd, 550, 160, 150, 200)

grid  = Create("GridBox", %HWnd, spalten, 2, 10, 140, 520, 250)

CreateMenu %HWnd
PopUp "Bildformat"
AppendMenu 101, ".png - Dateien"
AppendMenu 102, ".jpg - Dateien"
Separator
AppendMenu 103, "&Ende"

'ScreenCopy 0, 0- 800, 600

If FileExists(d)
   Laden()
EndIf

UserMessages ~WM_DROPFILES, $10 

' Ereignis - Schleife
WhileNot ende
  WaitInput
  If %UMessage =~WM_DROPFILES
     anzahl = DragQueryFile(&WParam, $FFFFFFFF, PFilename, 461)
     i = 0
     olddir = $CurrentDir
     CHDIR $ProgDir
     While i < anzahl
        DragQueryFile(&WParam, i, PFilename, 261)
        filename = String$(PFilename, 0)
        Copy filename > SubStr$(filename, -1, "\\")
        Inc i
     EndWhile
     DragFinish(&WParam)
     MessageBox(Str$(anzahl) + " Dateien nach " + $ProgDir + " kopiert !", "Info", 0)
     CHDIR olddir
  EndIf
  If Clicked(grid) ' auf Gridbox geklickt ?
     pos = GetCurSel(grid)  ' Position (Eintrag) abfragen
     If pos > -1
       zeile = GetString$(grid, pos)
       SetText edit[0], SubStr$(zeile, 1, "|")
       SetText edit[1], SubStr$(zeile, 2, "|")
       SetText edit[2], SubStr$(zeile, 3, "|")
       SetText edit[3], SubStr$(zeile, 4, "|")
       ' zugehöriges Bild anzeigen
       If FileExists(GetText$(edit[1]) + dateiendung)
          StartPaint st
            pic = Create("hSizedPic", -1, GetText$(edit[1]) + dateiendung, 150, 200, 1)
            SetWindowPos st = 550, 160 - %BmpX, %BmpY
            DrawPic pic, 0, 0; 0
          EndPaint
       Else 
          pic = Create("hSizedPic", 0, "&MEMBMP", 150, 200, 1)
          SetWindowPos st = 550, 160 - 150, 200
          StartPaint st
            DrawPic pic, 0, 0; 0
          EndPaint
       EndIf
     EndIf
  EndIf
  If MenuItem(101)
     dateiendung = ".png"
     CheckMenu 101, 1
     CheckMenu 102, 0
  ElseIf MenuItem(102)
     dateiendung = ".jpg"
     CheckMenu 101, 0
     CheckMenu 102, 1
  ElseIf MenuItem(103)
     ProgEnde()
  ElseIf MenuItem(2000)
     ' Laden
     Laden()
  ElseIf MenuItem(2001)
     ' Speichern
     Speichern()
  ElseIf MenuItem(2002)
     ' Übernehmen
     Uebernehmen()
  ElseIf MenuItem(2003)
    ' Ändern
    Aendern()
  ElseIf MenuItem(2004)
    ' Löschen
    knopf = MessageBox("Sind Sie wirklich sicher ?", "Datensatz Löschen", 292)
    Case knopf = 6 :  Loeschen()
  ElseIf MenuItem(2005)
    ' Suchen
    If GetCheck(choice1)
       wahl = 1
    ElseIf GetCheck(choice2)
       wahl = 2
    EndIf
    Suchen(wahl)
  ElseIf MenuItem(2006)
    Hilfe()
  ElseIf MenuItem(2007)
    ProgEnde()
  EndIf
  If IsKey(27) > 0  ' ESC - Taste ?
     ProgEnde()
  EndIf
  If %UMessage = $10
     ProgEnde()
  EndIf
EndWhile

Proc Aendern
pos = GetCurSel(grid) 
SetText grid, pos, 0, GetText$(Edit[0])
SetText grid, pos, 1, GetText$(Edit[1])
SetText grid, pos, 2, GetText$(Edit[2])
SetText grid, pos, 3, GetText$(Edit[3])
EndProc

Proc Loeschen
pos = GetCurSel(grid)
If pos > -1
   DeleteString(grid, pos)
EndIf
EndProc

Proc Speichern
Declare Long anzahl
  ClearList
  If GetCount(grid) > 0
     ClearList 
     Move("HandleToList", grid)
     DeleteString(0, GetCount(0))
     anzahl = Move("ListToFile", d)
     MessageBox(Str$(anzahl) + " Datensätze gespeichert !", "Info", 0)
  Else
     MessageBox("Keine Datensätze in\nTabelle vorhanden !", "Info", 0)
  EndIf
EndProc

Proc Laden
Declare Long anzahl
  ClearList
  ClearList grid
  anzahl = Move("FileToList", d)
  Move("ListToHandle", grid)
  MessageBox(Str$(anzahl) + " Datensätze geladen !", "Info", 0)
EndProc

Proc Uebernehmen
zeile = GetText$(Edit[0]) + "|" + GetText$(Edit[1]) + "|" + GetText$(Edit[2]) + "|" + GetText$(Edit[3])
AddString(grid, zeile)
SetCurSel grid, GetCount(grid) - 1
EndProc

Proc Suchen
Parameters Long w
Declare String such, z
Declare Long p
Set("RegEx", 1)
Select w
  CaseOf 1
    such = GetText$(edit[0])
    p = 1
  CaseOf 2
    such = GetText$(edit[2])
    p = 3
EndSelect
LvDeSelect grid, -1
WhileLoop 0, GetCount(grid) - 1
   z = GetString$(grid, &LOOP)
   If Instr(Upper$(such), Upper$(SubStr$(z, p, "|")))
      LvSelect(grid, &LOOP)
      SetCurSel grid, &LOOP
   EndIf
EndWhile
Set("RegEx", 0)
'Case GetCount(grid) = 0 : MessageBox("Keine Datensätze gefunden !", "Info", 0)
EndProc

Proc Hilfe
Declare String htext
  htext = "Bitte die Bilder als serienr.png in den \nProgramm-Ordner speichern ! z.B. 123456.png\nSo bleiben die Zuordnungen immer eindeutig\nauch bei mehreren Teilen gleichen Typs !"
  MessageBox(htext, "Hilfe", 0)
EndProc

Proc LvDeSelect
Parameters Lv&,Item&
 Declare s#
 Dim s#,1024
 Long s#,12=0
 Long s#,16 = ~LVIS_SELECTED | ~LVIS_FOCUSED
 SendMessage(Lv&, ~LVM_SETITEMSTATE,Item&,s#)
 Dispose s#
EndProc

Proc LvSelect
Parameters Lv&,Item&
Declare s#
Dim s#,1024
Long s#,12=$2
Long s#,16= ~LVIS_SELECTED | ~LVIS_FOCUSED
SendMessage(Lv&,~LVM_SETITEMSTATE,Item&,s#)
SendMessage(lv&,~LVM_SETHOTITEM ,item&,0)
SendMessage(lv&,~LVM_ENSUREVISIBLE ,Item&,0)
Dispose s#
Endproc

Proc ProgEnde
knopf = Messagebox("Vor Beenden Speichern ?", "Frage", 292)
If knopf = 6
   Speichern(d)
EndIf
ende = 1
EndProc

DragAcceptFiles(%hwnd,0)
Dispose Pfilename
UserMessages 0
DeleteObject ilist

End

Alles anzeigen

H.Brill

Hier noch die umgeschriebene Version für die Freeware Version 11.2 von Profan.

Code

$H windows.ph
$H structs.ph
$H messages.ph
$H shellapi.ph
$H commctrl.ph

Def DragAcceptFiles(2) !"SHELL32","DragAcceptFiles"
Def DragFinish(1) !"SHELL32","DragFinish"
Def DragQueryFile(4) !"SHELL32","DragQueryFileA"
Def Sleep(1) !"KERNEL32","Sleep"

Declare grid%, ilist%, TB%, Texte%[], Edit%[], st%, pic%, choice1%, choice2%
Declare d$, spalten$, zeile$, dateiendung$, filename$, pfilename#
Declare ende%, pos%, wahl%, knopf%, anzahl%, i%
Dim PFileName#, 461


MCls 150, 200, RGB(255, 0, 0)
StartPaint -1
  DrawText 20, 20, "Kein Bild "
  DrawText 20, 50, "vorhanden !"
  DrawText 20, 80, "Bitte ein Bild"
  DrawText 20, 110, "z.B. Seriennr.png"
  DrawText 20, 140, "in Ordner kopieren !"
EndPaint

dateiendung$ = ".png"

d$ = $ProgDir + "Werkzeuge.csv"
spalten$ = "Werkzeugtyp;0;140;SerienNr.;0;80;Hersteller;0;140;Lagerort;0;140"
ende% = 0

ilist% = Create("ImageList", 16, 16, Create("hPic", 0, "TOOLBAR"), RGB(192, 192, 192))

WindowTitle "Werkzeug - Verwaltung"
Window 820, 500

DragAcceptFiles(%hwnd,1)
UseIcon "A"

Removemenu 32767

TB%    = Create("TOOLBAR", %HWnd, ilist%, 0, 0, 2000, 1)
Toolbar("AddButton", TB%, 12,2000, "Laden")
Toolbar("AddButton", TB%, 7, 2001, "Speichern")
Toolbar("AddButton", TB%, 6, 2002, "Übernehmen")
Toolbar("AddButton", TB%, 4, 2003, "Ändern")
Toolbar("AddButton", TB%, 53, 2004, "Löschen")
Toolbar("AddButton", TB%, 14, 2005, "Suchen")
Toolbar("AddButton", TB%, 51, 2006, "Hilfe")
Toolbar("AddButton", TB%, 10, 2007, "Ende")

Texte%[0]  = Create("Text",   %HWnd, "Werkzeugtyp", 10, 60, 100, 25)
Texte%[1]  = Create("Text",   %HWnd, "SerienNr.  ", 280, 60, 100, 25)
Texte%[2]  = Create("Text",   %HWnd, "Hersteller ", 10, 100, 100, 25)
Texte%[3]  = Create("Text",   %HWnd, "Lagerort   ", 280, 100, 100, 25)
Edit%[0]   = Create("Edit",   %HWnd, "", 120, 60, 140, 25)
Edit%[1]   = Create("Edit",   %HWnd, "", 390, 60, 180, 25)
Edit%[2]   = Create("Edit",   %HWnd, "", 120, 100, 140, 25)
Edit%[3]   = Create("Edit",   %HWnd, "", 390, 100, 180, 25)
choice1%   = Create("RadioButton", %HWnd, "Suche nach Werkzeugtyp", 600, 60, 190, 25)
choice2%   = Create("RadioButton", %HWnd, "Suche nach Hersteller ", 600, 100, 190, 25)
SetCheck choice1%, 1

Def @CreateTextM(6) @Control("STATIC",@$(2),$50000001,@%(3),@%(4), @%(5),@%(6),@%(1),100, %hInstance)


st% = CreateTextM(%HWnd, "", 0, 550, 160, 150, 200)

  'Create("Static", %HWnd, 550, 160, 150, 200)

grid%  = Create("GridBox", %HWnd, spalten$, 2, 10, 140, 520, 250)

CreateMenu %HWnd
PopUp "Bildformat"
AppendMenu 101, ".png - Dateien"
AppendMenu 102, ".jpg - Dateien"
Separator
AppendMenu 103, "&Ende"

If FileExists(d$)
   Laden()
EndIf


UserMessages ~WM_DROPFILES, $10

WhileNot ende%
  WaitInput
  If %UMessage =~WM_DROPFILES
     anzahl% = DragQueryFile(&WParam, $FFFFFFFF, PFilename#, 461)
     i% = 0
     While i% < anzahl%
        DragQueryFile(&WParam, i%, PFilename#, 261)
        filename$ = String$(PFilename#, 0)
        Copy filename$ > $ProgDir + Substr$(filename$, -1, "\\")
        Inc i%
     EndWhile
     DragFinish(&WParam)
     MessageBox(Str$(anzahl%) + " Dateien nach " + $ProgDir + " kopiert !", "Info", 0)
  EndIf
  If Clicked(grid%)
     pos% = GetCurSel(grid%)
     If pos% > -1
       zeile$ = Getstring$(grid%, pos%)
       SetText edit%[0], Substr$(zeile$, 1, "|")
       SetText edit%[1], Substr$(zeile$, 2, "|")
       SetText edit%[2], Substr$(zeile$, 3, "|")
       SetText edit%[3], Substr$(zeile$, 4, "|")
       If FileExists(GetText$(edit%[1]) + dateiendung$)
          StartPaint st%
            pic% = Create("hSizedPic", -1, GetText$(edit%[1]) + dateiendung$, 150, 200, 1)
            SetWindowPos st% = 550, 160 - %BmpX, %BmpY
            DrawPic pic%, 0, 0; 0
          EndPaint
       Else
          pic% = Create("hSizedPic", 0, "&MEMBMP", 150, 200, 1)
          SetWindowPos st% = 550, 160 - 150, 200
          StartPaint st%
            DrawPic pic%, 0, 0; 0
          EndPaint
       EndIf
     EndIf
  EndIf
  If MenuItem(101)
     dateiendung = ".png"
     CheckMenu 101, 1
     CheckMenu 102, 0
  ElseIf MenuItem(102)
     dateiendung = ".jpg"
     CheckMenu 101, 0
     CheckMenu 102, 1
  ElseIf MenuItem(103)
     ProgEnde()
  ElseIf MenuItem(2000)
     ' Laden
     Laden()
  ElseIf MenuItem(2001)
     ' Speichern
     Speichern()
  ElseIf MenuItem(2002)
     ' Übernehmen
     Uebernehmen()
  ElseIf MenuItem(2003)
    ' Ändern
    Aendern()
  ElseIf MenuItem(2004)
    ' Löschen
    knopf% = MessageBox("Sind Sie wirklich sicher ?", "Datensatz Löschen", 292)
    Case knopf% = 6 :  Loeschen()
  ElseIf MenuItem(2005)
    ' Suchen
    If GetCheck(choice1%)
       wahl% = 1
    ElseIf GetCheck(choice2%)
       wahl% = 2
    EndIf
    Suchen(wahl%)
  ElseIf MenuItem(2006)
    Hilfe()
  ElseIf MenuItem(2007)
    ProgEnde()
  EndIf
  If IsKey(27) > 0
     ProgEnde()
  EndIf
  If %UMessage = $10
     ProgEnde()
  EndIf
EndWhile

Proc Aendern
pos% = GetCurSel(grid%)
SetText grid%, pos%, 0, GetText$(Edit%[0])
SetText grid%, pos%, 1, GetText$(Edit%[1])
SetText grid%, pos%, 2, GetText$(Edit%[2])
SetText grid%, pos%, 3, GetText$(Edit%[3])
EndProc

Proc Loeschen
pos% = GetCurSel(grid%)
If pos% > -1
   Deletestring(grid%, pos%)
EndIf
EndProc

Proc Speichern
Declare anzahl%
  ClearList
  If GetCount(grid%) > 0
     ClearList 
     MoveHandleToList(grid%)
     Deletestring(0, GetCount(0))
     anzahl% = MoveListToFile(d$)
     MessageBox(Str$(anzahl%) + " Datensätze gespeichert !", "Info", 0)
  Else
     MessageBox("Keine Datensätze in\nTabelle vorhanden !", "Info", 0)
  EndIf
EndProc

Proc Laden
Declare anzahl%
  ClearList
  ClearList grid%
  anzahl% = MoveFileToList(d$)
  MoveListToHandle(grid%)
  MessageBox(Str$(anzahl%) + " Datensätze geladen !", "Info", 0)
EndProc

Proc Uebernehmen
zeile$ = GetText$(Edit%[0]) + "|" + GetText$(Edit%[1]) + "|" + GetText$(Edit%[2]) + "|" + GetText$(Edit%[3])
Addstring(grid%, zeile$)
LvDeSelect grid%, -1
LvSelect(grid%, GetCount(grid%) - 1)
LB_SETPOS(grid%, GetCount(grid%) - 1)
SendMessage(grid%, ~LVM_ENSUREVISIBLE, GetCount(grid%) - 1, 0)
EndProc

Proc Suchen
Parameters w%
Declare such$, z$
Declare p%
Set("RegEx", 1)
Select w%
  CaseOf 1
    such$ = GetText$(edit%[0])
    p% = 1
  CaseOf 2
    such$ = GetText$(edit%[2])
    p% = 3
EndSelect
LvDeSelect grid%, -1  ' alles in der grid%box de-selektieren
WhileLoop 0, GetCount(grid%) - 1
   z$ = Getstring$(grid%, &LOOP)
   If Instr(Upper$(such$), Upper$(Substr$(z$, p%, "|")))
      LvSelect(grid%, &LOOP)
      LB_SETPOS(grid%, &LOOP)
      SendMessage(grid%, ~LVM_ENSUREVISIBLE, &LOOP, 0)
   EndIf
EndWhile
Set("RegEx", 0)
'Case GetCount(grid%) = 0 : MessageBox("Keine Datensätze gefunden !", "Info", 0)
EndProc

Proc Hilfe
Declare htext$
  htext$ = "Bitte die Bilder als serienr.png in den \nProgramm-Ordner speichern ! z.B. 123456.png\nSo bleiben die Zuordnungen immer eindeutig\nauch bei mehreren Teilen gleichen Typs !"
  MessageBox(htext$, "Hilfe", 0)
EndProc

Proc LvDeSelect
Parameters Lv&,Item&
 Declare s#
 Dim s#,1024
 Long s#,12=0
 Long s#,16 = ~LVIS_SELECTED | ~LVIS_FOCUSED
 SendMessage(Lv&, ~LVM_SETITEMSTATE,Item&,s#)
 Dispose s#
EndProc

Proc LvSelect
Parameters Lv&,Item&
Declare s#
Dim s#,1024
Long s#,12=$2
Long s#,16= ~LVIS_SELECTED | ~LVIS_FOCUSED
SendMessage(Lv&,~LVM_SETITEMSTATE, Item&, s#)
SendMessage(lv&,~LVM_SETHOTITEM , item&, 0)
SendMessage(lv&,~LVM_ENSUREVISIBLE ,Item&,0)
Dispose s#
Endproc

Proc LB_SETPOS
  Parameters Handl%,Num%
  Selectstring(Handl%,Num%-1,Getstring$(Handl%,Num%))
EndProc

Proc ProgEnde
knopf% = Messagebox("Vor Beenden Speichern ?", "Frage", 292)
If knopf% = 6
   Speichern(d$)
EndIf
ende% = 1
EndProc

Proc MoveFileToList
Parameters datei$
Declare zeile$, i%
CLEARLIST
Assign #1, datei$
Reset #1
i% = 0
WhileNot @Eof(#1)
  Input #1, zeile$
  Addstring zeile$
  Inc i%
EndWhile
Close #1
Return i%
EndProc

Proc MoveListToFile
Parameters datei$
Declare zeile$, i%
i% = 0
Assign #1, datei$
Rewrite #1
WhileLoop 0, GetCount(0) - 1
  zeile$ = ListboxItem$(&LOOP)
  Print #1, zeile$
  i% = &LOOP + 1
EndWhile
Close #1
Return i%
EndProc

DragAcceptFiles(%hwnd, 0)
Dispose Pfilename#
UserMessages 0
DeleteObject ilist%

End

Alles anzeigen

Somit hat Herr p.Specht auch was davon. Und vor allem neue User, die Profan mal ausprobieren wollen

und nur die 11er Version zum Testen haben. Ist ja frustrierend, wenn die nur den Code für X3 und höher

sehen und es selber nicht ausprobieren können. Und die Umstellung hat vor allem etwas Erfahrung verlangt

(fehlende Funktionen z.B. SetCurSel usw.), die man keinem neuen User zumuten kann. Ich hoffe mal, daß

ich alle Fehler bzw. Änderungen gesehen habe.

Gruß an alle Nutzer der Freeware Version 11.2

H.Brill

Hallo,

Ich habe noch eine kleine Merkwürdigkeit entdeckt und zwar bei der fertigen .exe.

Wenn man auf einen Eintrag in der Gridbox klickt, und noch kein Bild existiert, soll

ja das Bild, das mit

Code

MCls 150, 200, RGB(255, 0, 0)

erzeugt wurde, angezeigt werden. Im Interpreter klappt das ja auch, bloß in der fertigen

.exe wird das Bild nur halb angezeigt. Die untere Hälfte fehlt. Bei einem weiteren Klick

auf den gleichen Eintrag erscheint das Bild dann komplett. Hat da jemand eine Idee, was

hier falsch läuft ? Bei den anderen Bildern funktioniert es ja richtig.

Habe es jetzt bei Version X4 und Version 11.2 bemerkt. Bei Version X3 taucht das Problem

schon im Interpreter auf.

H.Brill

So, habe es jetzt herausgefunden. Liegt eindeutig an dem MCLs - Befehl.

Wenn man diesen mit

Code

hbild = Create("hNewPic", 150, 200, RGB(255, 0, 0))

ersetzt und mit

Code

StartPaint hbild              ' Falls es keine Bilddatei gibt, wird dieses angezeigt.
  DrawText 20, 20, "Kein Bild "
  DrawText 20, 50, "vorhanden !"
  DrawText 20, 80, "Bitte ein Bild"
  DrawText 20, 110, "z.B. Seriennr.png"
  DrawText 20, 140, "in Ordner kopieren !"
EndPaint

das Bild malt, kann man es unten im Else - Zweig mit

Code

' pic = Create("hSizedPic", 0, "&MEMBMP", 150, 200, 1)  ' aus kommentieren
 DrawPic hbild, 0, 0; 0

anzeigen. Dann funktioniert es richtig.

p. specht

Grosses Danke im Namen aller XProfan 11-free Nutzer, lieber Heinz!

Hier ergänzend noch das Link auf diese ältere Freeware-Vollversion: Downloadseite

Wer es etwas moderner haben will, kann die Light-Version mit Stand ähnlich XProfan X3, genannt FreeProfan32 von HIER nutzen. Allerdings fehlen da doch ein paar wichtige Funktionen, die erst in der derzeit aktuellen Version X4 verbaut sind. Testhalber gabe es dazu damals ebenfalls eine Alpha-Vorversion, siehe HIER.

Gruss

P.S.: Kaufen kann man die Letztversion natürlich auch ...

cadtec

Bravo Heinz! Kompliment für Deine Werkzeugverwaltung.

Pfannkuchengesicht

Frage: Was macht denn die Werkzeugverwaltung genau, wofür nutzt man sie?

Abifiz

Ich weiß ja nicht, ob es Deine Frage wirklich beantwortet, aber es fällt mir dazu ein, daß in der deutschen Wikipedia zum Thema tatsächlich ein eigener Artikel existiert, über welchen ich vor zwei oder drei Jahren gestolpert bin:

Werkzeugverwaltung – Wikipedia

Abifiz 28. September 2021 um 14:43