CreateDirectory dort, wo sich auch meine EXE befindet

Anfängerfragen zum Programmieren mit PureBasic.
Benutzeravatar
udg
Beiträge: 566
Registriert: 20.06.2013 23:27

CreateDirectory dort, wo sich auch meine EXE befindet

Beitrag von udg »

Wie eine Directory erstellt wird weis ich.
aber nun habe ich vor, ein kleines Tool zu bauen, welches einen Button beinhaltet und dieser Button soll aus meinem StringGadget den eingegebenen Ordnername übernehmen und genau dort erstellen wo sich auch meine Exe befindet.

Code: Alles auswählen

CreateDirectory("Test")
geht ja da nicht(wäre ja zu einfach :) ).
Wie kann ich denn klar machen, das ein Verzeichnis einfach ohne Laufwerks und Pfadangabe genau dort erstellt werden soll, wo sich meine exe befindet?



hier mein erstes Gerüst:

Code: Alles auswählen

Enumeration
  #Window_0
EndEnumeration

Enumeration
  #EingabeFeld_Name
  #Btn_Erstellen
  #TargetFiles
  #SourceFiles
  #EingabeFeld_Name_Font
  #Btn_MakeDir
EndEnumeration

Define.l Event, EventWindow, EventGadget, EventType, EventMenu

Procedure OpenWindow_Window_0()
  If OpenWindow(#Window_0, 502, 158, 500, 600, "FastRel v1", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_TitleBar|#PB_Window_ScreenCentered)
      StringGadget(#EingabeFeld_Name, 30, 60, 440, 35, "Ordner Name",#PB_String_BorderLess|#SS_CENTERIMAGE);
      SetGadgetFont(#EingabeFeld_Name, LoadFont(#EingabeFeld_Name_Font, "Microsoft Sans Serif", 20, #PB_Font_HighQuality))
      SetGadgetColor(#EingabeFeld_Name , #PB_Gadget_BackColor, RGB(183, 201, 209))
      SetGadgetColor(#EingabeFeld_Name , #PB_Gadget_FrontColor, RGB(17, 80, 108))
      
      ButtonGadget(#Btn_Erstellen, 97, 510, 305, 65, "erstellen")
      ButtonGadget(#Btn_MakeDir, 358, 100, 111, 30, "Verzeichnis anlegen")
      
      ; Create the target gadgets
      ;
      ListIconGadget(#TargetFiles, 30, 175, 440, 280, "Drop Files here", 250)
      SetGadgetColor(#TargetFiles , #PB_Gadget_BackColor, RGB(109, 145, 160)) ;TEXT Background Color
      SetGadgetColor(#TargetFiles , #PB_Gadget_FrontColor, RGB(248, 248, 248));TEXT Color
      
      ; Now enable the dropping on the target gadgets
      ;
      EnableGadgetDrop(#TargetFiles,    #PB_Drop_Files,   #PB_Drag_Copy)
  EndIf
EndProcedure

OpenWindow_Window_0()

Repeat
  Event = WaitWindowEvent()
  EventGadget = EventGadget()
  EventType = EventType()   
 
  If Event = #PB_Event_Gadget
    Select EventGadget()
          
      ; Eingabefeld
          Case #EingabeFeld_Name
          ;Auto select on Focus
            If EventType() = #PB_EventType_Focus
               SendMessage_(GadgetID(EventGadget()), #EM_SETSEL, Len(GetGadgetText(EventGadget())), 0)
             EndIf
             
           Case #Btn_Erstellen
             MessageRequester("Error", "dieser Button hat keine Funktion, Kaufen sie die Vollversion",#PB_MessageRequester_Ok|#PB_Window_ScreenCentered)
             
           Case #Btn_MakeDir
             CreateDirectory("Test")
             Debug"done"
             
     EndSelect       
  EndIf
  ; DragStart event on the source gadgets, initiate a drag & drop
    ;
    If Event = #PB_Event_Gadget And EventType() = #PB_EventType_DragStart
      Select EventGadget()
        Case #SourceFiles
          Files$ = ""       
          For i = 0 To CountGadgetItems(#SourceFiles)-1
            If GetGadgetItemState(#SourceFiles, i) & #PB_Explorer_Selected
              Files$ + GetGadgetText(#SourceFiles) + GetGadgetItemText(#SourceFiles, i) + Chr(10)
            EndIf
          Next i 
          If Files$ <> ""
            DragFiles(Files$)
          EndIf
      EndSelect
    
    ; Drop event on the target gadgets, receive the dropped data
    ;
    ElseIf Event = #PB_Event_GadgetDrop
      Select EventGadget()
          
         Case #TargetFiles
          Files$ = EventDropFiles()
          Count  = CountString(Files$, Chr(10)) + 1
          For i = 1 To Count
            AddGadgetItem(#TargetFiles, -1, StringField(Files$, i, Chr(10)))
          Next i  
       EndSelect  
 EndIf       
   
  Until Event = #PB_Event_CloseWindow

End

Zuletzt geändert von udg am 14.05.2016 18:09, insgesamt 2-mal geändert.
PB v5.43 LTS + v6.02 LTS | Windows 7 x86 + 11 x64 - Gforce RTX 4090 - AMD Ryzen 9 5900X 12-Core Processor 4.2 GHz - 64,0 GB RAM,
ASUSTEK TUF Gaming X570 Plus
ASUS ROG Thor-1200P Platinum (1200W, Aura Sync, OLED Display, 0dB-Cooling)
1x 1 TByte Samsung MZ-V7S500BW 970 EVO Plus 1 TB NVMe M.2 Internal SSD
1x 2 TByte Samsung MZ-V7S2T0BW 970 EVO Plus 2 TB NVMe M.2 Internal SSD
von BiSONTE!. Kauft Hardware gern bei ihm.
Monitor:
LG 38GL950G-B 95 (38 Zoll) Ultragear Curved 21: 9 UltraWide QHD IPS
Benutzeravatar
RSBasic
Admin
Beiträge: 8047
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: CreateDirectory

Beitrag von RSBasic »

Was du suchst, ist wahrscheinlich GetCurrentDirectory() oder besser GetPathPart(ProgramFilename()).
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Benutzeravatar
udg
Beiträge: 566
Registriert: 20.06.2013 23:27

Re: CreateDirectory

Beitrag von udg »

ok. aber "CreateDirectory()" muss ich doch trotzdem verwenden und das geht doch nur so:

Code: Alles auswählen

CreateDirectory("c:\Test")
oder kann man noch anders einen Ordner erstellen lassen. Es ist halt wichtig, dass der Ordner nebst der Exe immer erstellt wird, das man nicht ewig suchen muss
PB v5.43 LTS + v6.02 LTS | Windows 7 x86 + 11 x64 - Gforce RTX 4090 - AMD Ryzen 9 5900X 12-Core Processor 4.2 GHz - 64,0 GB RAM,
ASUSTEK TUF Gaming X570 Plus
ASUS ROG Thor-1200P Platinum (1200W, Aura Sync, OLED Display, 0dB-Cooling)
1x 1 TByte Samsung MZ-V7S500BW 970 EVO Plus 1 TB NVMe M.2 Internal SSD
1x 2 TByte Samsung MZ-V7S2T0BW 970 EVO Plus 2 TB NVMe M.2 Internal SSD
von BiSONTE!. Kauft Hardware gern bei ihm.
Monitor:
LG 38GL950G-B 95 (38 Zoll) Ultragear Curved 21: 9 UltraWide QHD IPS
Benutzeravatar
RSBasic
Admin
Beiträge: 8047
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: CreateDirectory

Beitrag von RSBasic »

Code: Alles auswählen

CreateDirectory(GetPathPart(ProgramFilename()) + "Test")
Wenn deine EXE-Datei sich im Verzeichnis "C:\Users\udg\Desktop\DeinProgramm\" (Beispiel) befindet, dann erhälst du mit GetPathPart(ProgramFilename()) den Pfad "C:\Users\udg\Desktop\DeinProgramm\" und kannst ein neues Verzeichnis im selben Verzeichnis deiner EXE-Datei anlegen.
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Benutzeravatar
udg
Beiträge: 566
Registriert: 20.06.2013 23:27

Re: CreateDirectory

Beitrag von udg »

RSBasic hat geschrieben:... und kannst ein neues Verzeichnis im selben Verzeichnis deiner EXE-Datei anlegen.
Danke für die Erklärung. Ich habe das so übernommen und noch hinzugefügt, dass der Name für den Ordner aus dem StringGadget übernommen wird.
CreateDirectory(GetPathPart(ProgramFilename()) + GetGadgetText(#EingabeFeld_Name))
Wo ich auch noch ein Problem gerade habe ist folgendens:

Das erstellte StringGadget hat eine Höhe von: 35px
Die verwendete Schrift hat eine Größe von: 10

Nun verwende ich folgende Flags: #PB_String_BorderLess|#SS_CENTERIMAGE

jedoch wird der Text nicht verical in der Höhe des StringGadgets zentriert weil ich den Flag #PB_String_BorderLess zusätzlich verwende.
Gibts da eine Möglichkeit dies trotzdem zu realisieren?
Bild


Ich seh gerade:

Code: Alles auswählen

StringGadget(#EingabeFeld_Name, 30, 60, 440, 35, "Ordner Name eingeben", #SS_CENTERIMAGE);
allein tuts auch nicht.
PB v5.43 LTS + v6.02 LTS | Windows 7 x86 + 11 x64 - Gforce RTX 4090 - AMD Ryzen 9 5900X 12-Core Processor 4.2 GHz - 64,0 GB RAM,
ASUSTEK TUF Gaming X570 Plus
ASUS ROG Thor-1200P Platinum (1200W, Aura Sync, OLED Display, 0dB-Cooling)
1x 1 TByte Samsung MZ-V7S500BW 970 EVO Plus 1 TB NVMe M.2 Internal SSD
1x 2 TByte Samsung MZ-V7S2T0BW 970 EVO Plus 2 TB NVMe M.2 Internal SSD
von BiSONTE!. Kauft Hardware gern bei ihm.
Monitor:
LG 38GL950G-B 95 (38 Zoll) Ultragear Curved 21: 9 UltraWide QHD IPS
Benutzeravatar
RSBasic
Admin
Beiträge: 8047
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: CreateDirectory

Beitrag von RSBasic »

Die Konstante "#SS_CENTERIMAGE" ist nicht für StringGadget geeignet. SS steht für Static Style und ein Static Control ist z.B. TextGadget(). StringGadget() braucht aber #ES-Konstanten (ES = Edit Style für Edit Control).
Hier gibt es einen Code, den ich in deinem Code eingebaut habe:

Code: Alles auswählen

Enumeration
  #Window_0
EndEnumeration

Enumeration
  #EingabeFeld_Name
  #Btn_Erstellen
  #TargetFiles
  #SourceFiles
  #EingabeFeld_Name_Font
  #Btn_MakeDir
EndEnumeration

Define.l Event, EventWindow, EventGadget, EventType, EventMenu

Procedure StringGadgetVCenter(GadgetID)
   hwndEdit = GadgetID(GadgetID)
   
   LineCount = SendMessage_(hwndEdit,#EM_GETLINECOUNT, 0, 0)

   hdc = GetDC_(hwndEdit)
   SelectObject_(hdc,GetGadgetFont(GadgetID))
   GetTextExtentPoint32_(hdc,"ABC",3,fsz.SIZE)
   ReleaseDC_(hwndEdit,hdc)   
   
   GetClientRect_(hwndEdit,eRect.RECT)
   eRect\top = (GadgetHeight(GadgetID) - fsz\cy * LineCount) / 2
   eRect\bottom = eRect\top + (fsz\cy * LineCount) + 4
   
   If eRect\bottom < GadgetHeight(GadgetID)
      SendMessage_(hwndEdit,#EM_SETRECT,0,eRect)
   EndIf
EndProcedure

Procedure OpenWindow_Window_0()
  If OpenWindow(#Window_0, 502, 158, 500, 600, "FastRel v1", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_TitleBar|#PB_Window_ScreenCentered)
      StringGadget(#EingabeFeld_Name, 30, 60, 440, 35, "Ordner Name",#PB_String_BorderLess | #ES_MULTILINE);
      SetGadgetFont(#EingabeFeld_Name, LoadFont(#EingabeFeld_Name_Font, "Microsoft Sans Serif", 10, #PB_Font_HighQuality))
      StringGadgetVCenter(#EingabeFeld_Name)
      
      SetGadgetColor(#EingabeFeld_Name , #PB_Gadget_BackColor, RGB(183, 201, 209))
      SetGadgetColor(#EingabeFeld_Name , #PB_Gadget_FrontColor, RGB(17, 80, 108))
     
      ButtonGadget(#Btn_Erstellen, 97, 510, 305, 65, "erstellen")
      ButtonGadget(#Btn_MakeDir, 358, 100, 111, 30, "Verzeichnis anlegen")
     
      ; Create the target gadgets
      ;
      ListIconGadget(#TargetFiles, 30, 175, 440, 280, "Drop Files here", 250)
      SetGadgetColor(#TargetFiles , #PB_Gadget_BackColor, RGB(109, 145, 160)) ;TEXT Background Color
      SetGadgetColor(#TargetFiles , #PB_Gadget_FrontColor, RGB(248, 248, 248));TEXT Color
     
      ; Now enable the dropping on the target gadgets
      ;
      EnableGadgetDrop(#TargetFiles,    #PB_Drop_Files,   #PB_Drag_Copy)
  EndIf
EndProcedure

OpenWindow_Window_0()

Repeat
  Event = WaitWindowEvent()
  EventGadget = EventGadget()
  EventType = EventType()   
 
  If Event = #PB_Event_Gadget
    Select EventGadget()
         
      ; Eingabefeld
          Case #EingabeFeld_Name
          ;Auto select on Focus
            If EventType() = #PB_EventType_Focus
               SendMessage_(GadgetID(EventGadget()), #EM_SETSEL, Len(GetGadgetText(EventGadget())), 0)
             EndIf
             
           Case #Btn_Erstellen
             MessageRequester("Error", "dieser Button hat keine Funktion, Kaufen sie die Vollversion",#PB_MessageRequester_Ok|#PB_Window_ScreenCentered)
             
           Case #Btn_MakeDir
             ;CreateDirectory("Test")
             Debug"done"
             
     EndSelect       
  EndIf
  ; DragStart event on the source gadgets, initiate a drag & drop
    ;
    If Event = #PB_Event_Gadget And EventType() = #PB_EventType_DragStart
      Select EventGadget()
        Case #SourceFiles
          Files$ = ""       
          For i = 0 To CountGadgetItems(#SourceFiles)-1
            If GetGadgetItemState(#SourceFiles, i) & #PB_Explorer_Selected
              Files$ + GetGadgetText(#SourceFiles) + GetGadgetItemText(#SourceFiles, i) + Chr(10)
            EndIf
          Next i
          If Files$ <> ""
            DragFiles(Files$)
          EndIf
      EndSelect
   
    ; Drop event on the target gadgets, receive the dropped data
    ;
    ElseIf Event = #PB_Event_GadgetDrop
      Select EventGadget()
         
         Case #TargetFiles
          Files$ = EventDropFiles()
          Count  = CountString(Files$, Chr(10)) + 1
          For i = 1 To Count
            AddGadgetItem(#TargetFiles, -1, StringField(Files$, i, Chr(10)))
          Next i 
       EndSelect 
 EndIf       
   
  Until Event = #PB_Event_CloseWindow

End
Wenn du zusätzlich horizontal zentrieren möchtest: #ES_CENTER
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Axolotl
Beiträge: 279
Registriert: 31.12.2008 16:34

Re: CreateDirectory

Beitrag von Axolotl »

Zusätzliche Tipps:

1. Das Directory befindet sich in der Entwicklungsphase je nach Compiler-Einstellung woanders....
Ganz nützlich, sich mit den speziellen Konstanten vertraut zu machen.

Code: Alles auswählen

Debug #PB_Editor_CreateExecutable
Debug #PB_Compiler_FilePath  
Debug #PB_Compiler_File
Debug #PB_Compiler_Filename  
Ein Beispiel, wie ich es anwende:

Code: Alles auswählen

  Procedure.s ProgramPath()    ;' returns the full program path
    Static s_Path$ = ""
  
    If s_Path$ = ""  ;' do it the first time only ... 
      CompilerIf #PB_Editor_CreateExecutable     ;' at runtime...
        s_Path$ = GetPathPart(ProgramFilename())
      CompilerElse
        s_Path$ = GetCurrentDirectory()
      CompilerEndIf 
    EndIf                           :Debug #PB_Compiler_Procedure+" = '"+s_Path$+"'"
    ProcedureReturn s_Path$
  EndProcedure 
;'
Global path$ = ProgramPath()
Statt GetCurrentDirectory() kann man auch eine der #PB_Compiler_* Konstanten einsetzen.

2. CreateDirectory() kann nur ein Verzeichnis neu anlegen, keine Unterverzeichnisse in einem Rutsch...
Dafür braucht es so etwas

Code: Alles auswählen

;' windows only code... 
Macro PathAddBackslash(sDirectory)
  PathAddBackslash_(sDirectory)
EndMacro

Procedure.i CreateDirectories(Directory$)      ;' returns TRUE if directory exists, (already or created)  
  Protected result, nn, dir$                   :Debug #PB_Compiler_Procedure+"("+Directory$+")"

  PathAddBackslash(Directory$)                 ;' <==>  If Right(Directory$, 1) <> "\" : Directory$ + "\" : EndIf
  If FileSize(Directory$) = -2  ;' an existing directory 
    result = #True              ;' ... return SUCCESS
  Else
    dir$ = Directory$
    Repeat
      nn = FindString(dir$, "\", nn+1)
      If nn > 0                              :Debug #PB_Compiler_Procedure+"() ··> Create '"+Mid(dir$, 1, nn)+"'"
        CreateDirectory(Mid(dir$, 1, nn))    ;' fails if dir exists... doesn't matter
      EndIf
    Until nn = 0
    result = Bool(FileSize(Directory$) = -2) ;' quality check at the end!
  EndIf
  ProcedureReturn result
EndProcedure
Using PureBasic latest stable version and current alpha/beta (x64) on Windows 11 Home
Benutzeravatar
udg
Beiträge: 566
Registriert: 20.06.2013 23:27

Re: CreateDirectory

Beitrag von udg »

RSBasic hat geschrieben:

Code: Alles auswählen

Procedure StringGadgetVCenter(GadgetID)
   hwndEdit = GadgetID(GadgetID)
   
   LineCount = SendMessage_(hwndEdit,#EM_GETLINECOUNT, 0, 0)

   hdc = GetDC_(hwndEdit)
   SelectObject_(hdc,GetGadgetFont(GadgetID))
   GetTextExtentPoint32_(hdc,"ABC",3,fsz.SIZE)
   ReleaseDC_(hwndEdit,hdc)   
   
   GetClientRect_(hwndEdit,eRect.RECT)
   eRect\top = (GadgetHeight(GadgetID) - fsz\cy * LineCount) / 2
   eRect\bottom = eRect\top + (fsz\cy * LineCount) + 4
   
   If eRect\bottom < GadgetHeight(GadgetID)
      SendMessage_(hwndEdit,#EM_SETRECT,0,eRect)
   EndIf
EndProcedure
Krasser Aufwand um den Text vertikal zentrieren zu können. Da wäre eine Konstante mal fällig :)
Das #SS_CENTERIMAGE nur bei TextGadget funktioniert habe ich mir schon gedacht. Hätte aber keine Idee gehabe wie ich das sonst realisieren kann und darum gefragt.

Nun bin ich im Moment auf dem Tripp meine kleinen Programmchen alle WindowBorderless zu erstellen. Ist wohl gerade so eine Macke von mir. Ich designe gern :)
und genau hier liegt leider der Hund begraben. Deine VerticalAlign Procedure funktioniert wunderbar, aber natürlich, wie kann es anders sein, nicht mit einem Borderless Window Bild

PS:

Habe es rausgefunden. Da kein reales Fenster vorhanden ist, geht der Fokus verloren. Um dies zu verhindern muss hinzu:

Code: Alles auswählen

    ; FOKUS AUF TOOL SETZEN
      SetActiveWindow(#Window_0)
Jetzt klappt auch wieder: AutoSelect wenn man in das StringGadget klickt :)

@Axolotl

Danke für den hilfreichen Tipp. Das man Unterverzeichnisse extra anlegen muss, habe ich mich schon belesen und dies Schritt für Schritt abarbeiten muss.
Danke dir. Aber ich werd schon noch auf diverse Probleme stoßen. Spätestens wenn ich anfangen will die Ganzen Daten die man durch Drag and Drop reinziehen kann, in den erstellten Ordner kopieren zu wollen.

Hier noch mein Neuer Code ( da bug'd mein Minimieren Button noch- wenn ich das Tool minimiere und wieder maximiere und dann nur mit der Maus über den Minimieren Button gehe, minimiert es das Fenster nochmal ? ) ist zwar ein cooler MausOver Effekt aber so nicht gedacht):

Code: Alles auswählen

Enumeration
  #Window_0
  #EingabeFeld_Name
  #Btn_Erstellen
  #container2
  #Font_Btn_Erstellen
  #TargetFiles
  #SourceFiles
  #EingabeFeld_Name_Font
  #Btn_MakeDir
  #Font_Btn_MakeDir
  #container
  #Infobar
  #Infobar_Font
  #Gadget_exit
  #Exit_btn
  #Btn_Minimize
  #Gadget_Minimize
EndEnumeration
;//////////////////////////////////// 
; DEFINIERE EXIT BUTTON BILD
;//////////////////////////////////// 
      CreateImage(#Exit_btn,30,30)
       StartDrawing(ImageOutput(#Exit_btn))
       FillArea(1,1,-1,RGB(55, 110, 133))
       Line(6,23,18,-18,$FFFFFF)
       Line(6,6,18,18,$FFFFFF)
      StopDrawing()
;//////////////////////////////////// 
; DEFINIERE MINIMIEREN BUTTON
;////////////////////////////////////
      CreateImage(#Btn_Minimize,30,30)
       StartDrawing(ImageOutput(#Btn_Minimize))
       FillArea(1,1,-1,RGB(55, 110, 133))
       Line(6,23,18,1,$FFFFFF)
       ;Line(6,6,18,18,$FFFFFF)
      StopDrawing()
;//////////////////////////////////// 
; DEFINIERE START UP EFFEKT, FADE IN
;////////////////////////////////////
#AW_BLEND = $80000    ;Uses a fade effect. This flag can be used only If hwnd is a top-level window.       
       
Define.l Event, EventWindow, EventGadget, EventType, EventMenu

; Festlegen, dass Im StringGadget der Text Vertikal zentriert wird
Procedure StringGadgetVCenter(GadgetID)
   hwndEdit = GadgetID(GadgetID)
   
   LineCount = SendMessage_(hwndEdit,#EM_GETLINECOUNT, 0, 0)

   hdc = GetDC_(hwndEdit)
   SelectObject_(hdc,GetGadgetFont(GadgetID))
   GetTextExtentPoint32_(hdc,"ABC",3,fsz.SIZE)
   ReleaseDC_(hwndEdit,hdc)   
   
   GetClientRect_(hwndEdit,eRect.RECT)
   eRect\top = (GadgetHeight(GadgetID) - fsz\cy * LineCount) / 2
   eRect\bottom = eRect\top + (fsz\cy * LineCount) + 4
   
   If eRect\bottom < GadgetHeight(GadgetID)
      SendMessage_(hwndEdit,#EM_SETRECT,0,eRect)
   EndIf
EndProcedure

Procedure OpenWindow_Window_0()
    OpenWindow(#Window_0, 502, 158, 500, 600, "FastRel v1", #PB_Window_BorderLess|#PB_Window_ScreenCentered|#WS_VISIBLE)
    ; FENSTER FARBE
      SetWindowColor(0, RGB(109, 145, 160))
    ; FOKUS AUF TOOL SETZEN
      SetActiveWindow(#Window_0)
;//////////////////////////////////// 
; TOOL TITEL INFOBAR
;////////////////////////////////////
      TextGadget(#Infobar,WindowWidth(#Window_0)-499, 1, 438, 30, "  FastRel v1",#SS_CENTERIMAGE)
      SetGadgetFont(#Infobar, LoadFont(#Infobar_Font, "Microsoft Sans Serif", 10, #PB_Font_HighQuality))
      SetGadgetColor(#Infobar , #PB_Gadget_BackColor, RGB(55, 110, 133))  ;TEXT Background Color
      SetGadgetColor(#Infobar , #PB_Gadget_FrontColor, RGB(248, 248, 248));TEXT Color
;//////////////////////////////////// 
; EXIT BUTTON POSITIONIEREN
;////////////////////////////////////
      ImageGadget(#Gadget_exit,WindowWidth(0)-31,1,30,30,ImageID(#Exit_btn))
;//////////////////////////////////// 
; MINIMIZE BUTTON POSITIONIEREN
;////////////////////////////////////
      ImageGadget(#Gadget_Minimize,WindowWidth(0)-61,1,30,30,ImageID(#Btn_Minimize))
;////////////////////////////////////
; EINGABEFELD FÜR ORDNER NAME
;////////////////////////////////////
      StringGadget(#EingabeFeld_Name, 30, 60, 440, 35,"Ordner Name eingeben",#PB_String_BorderLess | #ES_MULTILINE);
      SetGadgetFont(#EingabeFeld_Name, LoadFont(#EingabeFeld_Name_Font, "Microsoft Sans Serif", 10, #PB_Font_HighQuality))
      StringGadgetVCenter(#EingabeFeld_Name)
      SetGadgetColor(#EingabeFeld_Name , #PB_Gadget_BackColor, RGB(183, 201, 209))
      SetGadgetColor(#EingabeFeld_Name , #PB_Gadget_FrontColor, RGB(17, 80, 108))
;\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\     
; 1px RAHMEN UM DEN BUTTON: ORDNER ERSTELLEN
;\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
      TextGadget(#container,338, 109, 132, 32,"")
      SetGadgetColor(#container, #PB_Gadget_BackColor, RGB(183, 201, 209));TEXT Background Color
;////////////////////////////////////
; BUTTON ORDNER ERSTELLEN
;////////////////////////////////////
      TextGadget(#Btn_MakeDir, 339, 110, 130, 30, "Verzeichnis anlegen",#SS_CENTERIMAGE|#SS_NOTIFY|#SS_CENTER) 
      SetGadgetFont(#Btn_MakeDir, LoadFont(#Font_Btn_MakeDir, "Microsoft Sans Serif", 9, #PB_Font_HighQuality)) ; Button Font
      SetGadgetColor(#Btn_MakeDir, #PB_Gadget_BackColor, RGB(109, 145, 160))    ;TEXT Background Color
      SetGadgetColor(#Btn_MakeDir, #PB_Gadget_FrontColor, RGB(183, 201, 209));TEXT Color      
      
;\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\     
; 1px RAHMEN UM DEN BUTTON: ALLES ERSTELLEN
;\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
      TextGadget(#container2,96, 509, 307, 67,"")
      SetGadgetColor(#container2, #PB_Gadget_BackColor, RGB(183, 201, 209));TEXT Background Color     
;////////////////////////////////////
; BUTTON ALLES ERSTELLEN
;////////////////////////////////////
      TextGadget(#Btn_Erstellen, 97, 510, 305, 65, "erstellen",#SS_CENTERIMAGE|#SS_NOTIFY|#SS_CENTER) 
      SetGadgetFont(#Btn_Erstellen, LoadFont(#Font_Btn_Erstellen, "Microsoft Sans Serif", 9, #PB_Font_HighQuality)) ; Button Font
      SetGadgetColor(#Btn_Erstellen, #PB_Gadget_BackColor, RGB(109, 145, 160))    ;TEXT Background Color
      SetGadgetColor(#Btn_Erstellen, #PB_Gadget_FrontColor, RGB(183, 201, 209));TEXT Color
;////////////////////////////////////
; ERSTELL ZIEL FÜR DRAG & DROP DATEIEN
;////////////////////////////////////
      ListIconGadget(#TargetFiles, 30, 175, 440, 280, "Drop Files here", 250)
      SetGadgetColor(#TargetFiles , #PB_Gadget_BackColor, RGB(55, 110, 133)) ;TEXT Background Color
      SetGadgetColor(#TargetFiles , #PB_Gadget_FrontColor, RGB(248, 248, 248));TEXT Color
;////////////////////////////////////
; DRAG & DROP ZIEL FREIGESCHALTEN
;////////////////////////////////////
      EnableGadgetDrop(#TargetFiles, #PB_Drop_Files, #PB_Drag_Copy)
  ;EndIf
EndProcedure

OpenWindow_Window_0()
;////////////////////////////////////
; TOOL START UP EFFEKT
;////////////////////////////////////
  AnimateWindow_(WindowID(0),500,#AW_BLEND)
Repeat
  Event = WaitWindowEvent()
  EventGadget = EventGadget()
  EventType = EventType()   
 
  If Event = #PB_Event_Gadget
    Select EventGadget()
;////////////////////////////////////  
;- EINGABEFELD
;//////////////////////////////////// 
      Case #EingabeFeld_Name
           ;Auto select on Focus
            If EventType() = #PB_EventType_Focus
               SendMessage_(GadgetID(EventGadget()), #EM_SETSEL, Len(GetGadgetText(EventGadget())), 0)
             EndIf
;////////////////////////////////////  
;- ERSTELL ORDNER VON EINGABE
;////////////////////////////////////           
      Case #Btn_MakeDir
           CreateDirectory(GetPathPart(ProgramFilename()) + GetGadgetText(#EingabeFeld_Name));+ " "
           SetGadgetText(#EingabeFeld_Name," Ordner wurde erstellt")
;////////////////////////////////////  
;- BUTTON - ERSTELLEN
;//////////////////////////////////// 
      Case #Btn_Erstellen
            MessageRequester("Error", "dieser Button hat keine Funktion, Kaufen sie die Vollversion",#PB_MessageRequester_Ok|#PB_Window_ScreenCentered)  
;////////////////////////////////////  
;- EXIT BUTTON FUNCTION
;////////////////////////////////////
      Case #Gadget_exit
            End
;////////////////////////////////////  
;- MINIMIZE BUTTON FUNCTION
;////////////////////////////////////
      Case #Gadget_Minimize
            If EventType = #PB_EventType_LeftClick
              SetWindowState(#Window_0, #PB_Window_Minimize)
            EndIf
            
    EndSelect       
  EndIf
;////////////////////////////////////  
;- DRAG WINDOW MIT MAUS
;////////////////////////////////////
  Select Event
      Case #WM_LBUTTONDOWN    
            SendMessage_(WindowID(#Window_0), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)    
  EndSelect    
;////////////////////////////////////////////////////////////////////////   
;- DRAG & DROP START EVENT on the source gadgets, initiate a drag & drop
;////////////////////////////////////////////////////////////////////////
  If Event = #PB_Event_Gadget And EventType() = #PB_EventType_DragStart
      Select EventGadget()
        Case #SourceFiles
          Files$ = ""       
          For i = 0 To CountGadgetItems(#SourceFiles)-1
            If GetGadgetItemState(#SourceFiles, i) & #PB_Explorer_Selected
              Files$ + GetGadgetText(#SourceFiles) + GetGadgetItemText(#SourceFiles, i) + Chr(10)
            EndIf
          Next i 
          If Files$ <> ""
            DragFiles(Files$)
          EndIf
      EndSelect
;////////////////////////////////////////////////////////////////////////
;- DRAG & DROP START EVENT on the target gadgets, receive the dropped data
;////////////////////////////////////////////////////////////////////////
      ElseIf Event = #PB_Event_GadgetDrop
        Select EventGadget()
          Case #TargetFiles
                Files$ = EventDropFiles()
                Count  = CountString(Files$, Chr(10)) + 1
                For i = 1 To Count
                  AddGadgetItem(#TargetFiles, -1, StringField(Files$, i, Chr(10)))
                Next i  
        EndSelect  
  EndIf       
  Until Event = #PB_Event_CloseWindow:End
Zuletzt geändert von udg am 14.05.2016 18:35, insgesamt 3-mal geändert.
PB v5.43 LTS + v6.02 LTS | Windows 7 x86 + 11 x64 - Gforce RTX 4090 - AMD Ryzen 9 5900X 12-Core Processor 4.2 GHz - 64,0 GB RAM,
ASUSTEK TUF Gaming X570 Plus
ASUS ROG Thor-1200P Platinum (1200W, Aura Sync, OLED Display, 0dB-Cooling)
1x 1 TByte Samsung MZ-V7S500BW 970 EVO Plus 1 TB NVMe M.2 Internal SSD
1x 2 TByte Samsung MZ-V7S2T0BW 970 EVO Plus 2 TB NVMe M.2 Internal SSD
von BiSONTE!. Kauft Hardware gern bei ihm.
Monitor:
LG 38GL950G-B 95 (38 Zoll) Ultragear Curved 21: 9 UltraWide QHD IPS
Benutzeravatar
RSBasic
Admin
Beiträge: 8047
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: CreateDirectory

Beitrag von RSBasic »

udg hat geschrieben:( da buggd mein Minimieren Button noch- wenn ich das Tool minimiere und wieder maximiere und dann nur mit der Maus drüber gehe, minimiert es das fenster nochmal ?)

Code: Alles auswählen

If EventType = #PB_EventType_LeftClick
  SetWindowState(#Window_0, #PB_Window_Minimize)
EndIf
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Benutzeravatar
udg
Beiträge: 566
Registriert: 20.06.2013 23:27

Re: CreateDirectory

Beitrag von udg »

habs angepasst. danke Dir :allright:
PB v5.43 LTS + v6.02 LTS | Windows 7 x86 + 11 x64 - Gforce RTX 4090 - AMD Ryzen 9 5900X 12-Core Processor 4.2 GHz - 64,0 GB RAM,
ASUSTEK TUF Gaming X570 Plus
ASUS ROG Thor-1200P Platinum (1200W, Aura Sync, OLED Display, 0dB-Cooling)
1x 1 TByte Samsung MZ-V7S500BW 970 EVO Plus 1 TB NVMe M.2 Internal SSD
1x 2 TByte Samsung MZ-V7S2T0BW 970 EVO Plus 2 TB NVMe M.2 Internal SSD
von BiSONTE!. Kauft Hardware gern bei ihm.
Monitor:
LG 38GL950G-B 95 (38 Zoll) Ultragear Curved 21: 9 UltraWide QHD IPS
Antworten