FileListBox ohne endung

[SaFu]

Hi

also ich findes es sehr beeindruckend das marabu eigentlich immer ne anwort hat und auch immer
zuhelfen versucht danke erstmal

aber bei diesem code vertehe ich nur bahnhof kann mir das vielleicht einer erklären, zeile für zeile ich habe echt den drang das auch zuverstehn und nicht einfach zu kopieren

z.b.
- ffoExcludeExt darüber steht nichts in der Delphi hilfe

- faArchive hier bekomme ich einen fehler (undefinierter bezeichner)

kann man hier vieleicht mal eine kleine schulung ansetzen über findnext, findfirst usw????

Danke euch schonmal

[DeddyH]

Ich will es mal versuchen:

Delphi-Quellcode:

//Definition zweier eigener Datentypen, wobei der 2. in der Funktion verwendet wird.
//Dieser kann eine leere Menge, eine Menge mit einer oder beiden Optionen sein.
type
  TFindFilesOption = (ffoExcludePath, ffoExcludeExt);
  TFindFilesOptions = set of TFindFilesOption;

function FindFiles (
  const fileExpr: String;         // vollständiger Dateiname mit wildcards
  files: TStrings;                // Ergebnisliste
  options: TFindFilesOptions = [] // Stdandardanzeige mit Pfad und Erweiterung
): Boolean;                       // Erfolgreich bei True
var
  sr: TSearchRec;
  path: string;
  extWanted: Boolean;
begin
  Result := True;
  //Ergebnisliste leeren
  files.Clear;
  //optische Aktualisierung abschalten
  files.BeginUpdate;
  //hier wird ausgewertet, ob der Pfad mit angezeigt werden soll
  if ffoExcludePath in options
    then path := ''
    else path := ExtractFilePath(fileExpr);
  extWanted := not (ffoExcludeExt in options);
  //erste Datei ermitteln
  if FindFirst(fileExpr, faArchive, sr) = 0 then
  begin
    //wenn ein Dateieintrag gefunden wurde, solange weitermachen,
    //bis kein weiterer Eintrag mehr kommt
    repeat
      //auswerten, ob Dateiendung angezeigt werden soll und String 
      //entsprechend aufbereiten
      if extWanted
        then files.Add(path + sr.Name)
        else files.Add(ChangeFileExt(path + sr.Name, ''));
    until FindNext(sr) <> 0;
    //Suchhandle wieder freigeben
    FindClose(sr);
  //kein Eintrag gefunden, Funktionsergebnis auf false setzen
  end else Result := False;
  //Anzeige aktualisieren
  files.EndUpdate;
end;

[SaFu]

Danke schon ist es besser vom verständnis her
hier ist mal mein code so versuch ich es gerade aber es tut sich nichts ich poste mal aus vollstädigkeitshalber mal alles

Delphi-Quellcode:

unit Unit8;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, ExtCtrls, DBCtrls,DateUtils, FileCtrl;

type
  TFindFilesOption = (ffoExcludePath, ffoExcludeExt);
  TFindFilesOptions = set of TFindFilesOption;

  TForm8 = class(TForm)
    Button3: TButton;
    Button4: TButton;
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Memo3: TMemo;
    Memo4: TMemo;
    Memo5: TMemo;
    Memo6: TMemo;
    Memo7: TMemo;
    Memo8: TMemo;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    Panel6: TPanel;
    Panel7: TPanel;
    Panel8: TPanel;
    Panel9: TPanel;
    Panel10: TPanel;
    Panel11: TPanel;
    Panel12: TPanel;
    Panel14: TPanel;
    StringGrid1: TStringGrid;
    Timer6: TTimer;
    Button1: TButton;
    FileListBox1: TFileListBox;
    FileListBox2: TFileListBox;
    Label7: TLabel;
    Label8: TLabel;
    Button2: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Panel12MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure Timer6Timer(Sender: TObject);
    procedure FileListBox1Change(Sender: TObject);
    procedure FileListBox2Change(Sender: TObject);
    procedure Button2Click(Sender: TObject);



  private
  {Private-Deklarationen }
   Lb,Celltext,liste1,liste2,Liste3,Liste4,name :String;
   n :integer;
   monocolor :boolean;
   Textformat :cardinal;
   pt: TPoint;
   lehrerl :TFileName;
   procedure Gridlade;
   procedure Gridelade2;
   procedure blauezelle;
   procedure Memolade;
   procedure Memolade2;
   procedure bilderlade;
   procedure bilderlade2;
   function FindFiles (const fileExpr: String;files: TStrings; options: TFindFilesOptions = []): Boolean;
  public
    { Public-Deklarationen }
  end;

var
  Form8: TForm8;

implementation

uses Unit2, Unit5, Unit7, Unit3, Unit9, Unit4;

{$R *.dfm}
// Sämtliche Quellen Angaben stehen auf der Form7 (sind die gleichen)
procedure TForm8.FormShow(Sender: TObject);
Var i :integer;
begin
  Form8.Top:= 0;
  Form8.Left:= 0;

  Liste1:= (ExtractFilePath(ParamStr(0)) +('Vertretungspläne\'+(IntToStr(YearOf(Date)))+'_KW_'+(IntToStr(WeekOfTheYear(Date)))));
  FileListBox1.Directory:= Liste1;

  Liste2:= (ExtractFilePath(ParamStr(0)) +('Vertretungspläne\'+(IntToStr(YearOf(Date)))+'_KW_'+(IntToStr(WeekOfTheYear(Date)+1))));
  FileListBox2.Directory := Liste2;

  for i:=0 to ComponentCount-1 do //XP Anzeige
  if Components[i] is TPanel then (Components[i] as TPanel).ParentBackground:= False;

  Label15.Caption:= '   Lehrer' + #13#10 + 'auswählen';
  Label1.Caption := '';
  Label14.Caption := 'VERTRETUNGSPLAN für Koll. ';
  Label9.Caption:= 'Kalenderwoche: ';
  Label10.Caption:= 'Woche: ';

  StringGrid1.Cells[0,0] := 'Wochentag';
  StringGrid1.Cells[0,1]:= 'Montag';
  StringGrid1.Cells[0,5]:= 'Dienstag';
  StringGrid1.Cells[0,9]:= 'Mittwoch';
  StringGrid1.Cells[0,13]:= 'Donnerstag';
  StringGrid1.Cells[0,17]:= 'Freitag';
  StringGrid1.Cells[0,21]:= 'Samstag';
  StringGrid1.Cells[1,0]:= 'Klasse';
  StringGrid1.Cells[2,0]:= '1';
  StringGrid1.Cells[3,0]:= '2';
  StringGrid1.Cells[4,0]:= '3';
  StringGrid1.Cells[5,0]:= '4';
  StringGrid1.Cells[6,0]:= '5';
  StringGrid1.Cells[7,0]:= '6';
  StringGrid1.Cells[8,0]:= ' ';
  StringGrid1.Cells[9,0]:= '7';
  StringGrid1.Cells[10,0]:= '8';
end;

//==============Eigenschaften Zellen============================================
procedure TForm8.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  Textformat:= DT_SINGLELINE;
   with (Sender as TStringGrid) do
   begin
     Celltext:= Cells[ACol, ARow];
     monocolor:= True; //Standardeinstellung der Zellen ist einfarbig

    if (Cells[ACol,ARow] = 'fa') or (Cells[ACol,ARow] = 'FA')then
       begin
        Canvas.Brush.Color:= ClRed; //Zellenfarbe
        Canvas.Font.Color:= ClWhite; //Schriftfarbe
        Canvas.Font.Style:= Canvas.Font.Style + [fsBold]; //Text fett
       end;

    if (Cells[ACol,ARow] = 'np') or (Cells[ACol,ARow] = 'NP')then
       begin
        Canvas.Brush.Color:= ClBlue; //Zellenfarbe
        Canvas.Font.Color:= ClWhite; //Schriftfarbe
        Canvas.Font.Style:= Canvas.Font.Style + [fsBold]; //Text fett
       end;

    if (Cells[ACol,ARow] = 'aa') or (Cells[ACol,ARow] = 'AA')then
       begin
        Canvas.Brush.Color:= ClGreen; //Zellenfarbe
        Canvas.Font.Color:= ClWhite; //Schriftfarbe
        Canvas.Font.Style:= Canvas.Font.Style + [fsBold]; //Text fett
       end;

    if (monocolor) then
       begin
        //Hintergrund überschreiben
        SetBkMode(StringGrid1.Canvas.Handle, OPAQUE);
        Canvas.FillRect(Rect)
       end ;

    if  (ACol = 1) or  (ACol = 0) then
       begin
        // Text wird zentriert
        Textformat:= Textformat or DT_CENTER or DT_VCENTER;
        Canvas.Font.Style:= Canvas.Font.Style + [fsBold]; //Text fett
       end;

    if  (ACol > 1)  then //Zentrieren für alle Zellen
       begin
        Textformat:= Textformat or DT_CENTER or DT_VCENTER; //Text wird zentriert
       end;
  //Hier wird nun der Text ausgegeben
  DrawText(Canvas.Handle, PChar(Celltext), Length(celltext),Rect,Textformat);
end;

begin  //Linien zwischen Zellen erzeugen
 n:= 0 ;
 repeat
 n:= n+4;
    if (ARow = n) and (ACol >= StringGrid1.FixedCols) then
    begin
      StringGrid1.Canvas.Pen.Color:= clBlack; //Linienfarbe
      StringGrid1.Canvas.Pen.Width:= 2; //Stärke der Linie
      StringGrid1.Canvas.MoveTo(Rect.Left,Rect.Bottom);
      StringGrid1.Canvas.LineTo(Rect.Right,Rect.Bottom);
    end;
 until n= 24;
end;
end;


//========StringGrid Laden======================================================
procedure TForm8.Gridlade;  
var x, y, row, col,len :Word;
    Grid1 :TFileName;
    FileStream :TMemoryStream;
    buff :string;
begin
  FileStream:= TMemoryStream.Create; //MemoryStream erzeugen

  Grid1:= FileListbox1.FileName;
  FileStream.LoadFromFile(Grid1);

  FileStream.Read(row, SizeOf(Word));
  FileStream.Read(col, SizeOf(Word));

  for x:= 0 to row do
   for y:= 0 to col do
    begin
     FileStream.Read(len, SizeOf(Word));
     SetLength(buff, len);
     FileStream.Read(buff[1], len);
     StringGrid1.Cells[y,x]:= buff;
    end;
   FileStream.Free;
end;

procedure TForm8.Gridelade2;
var x, y, row, col,len :Word;
    Grid2 :TFileName;
    FileStream :TMemoryStream;
    buff :string;
begin
  FileStream:= TMemoryStream.Create; //MemoryStream erzeugen

  Grid2:= FileListbox2.FileName;
  FileStream.LoadFromFile(Grid2);

  FileStream.Read(row, SizeOf(Word));
  FileStream.Read(col, SizeOf(Word));

  for x:= 0 to row do
   for y:= 0 to col do
    begin
     FileStream.Read(len, SizeOf(Word));
     SetLength(buff, len);
     FileStream.Read(buff[1], len);
     StringGrid1.Cells[y,x]:= buff;
    end;
   FileStream.Free;
end;
//=======Memos laden============================================================
procedure TForm8.Memolade;     
Var  memos :TFileName;
     FileStream :TMemoryStream;
     i,l :Integer;
     s :String;
begin
  FileStream := TMemoryStream.Create; //FileStream erzeugen

  //Übergabe der Datei
  memos:=(ExtractFilepath(FileListBox1.FileName) + 'Bemerkungen\' + ExtractFileName(FileListBox1.FileName));
  FileStream.LoadFromFile(memos);

  l:= 0;
  FileStream.Position:= 0; //FileStream Position = Anfang

  for i := 1 to 9 do //Schleifendurchlauf durch Komponenten
  begin
    FileStream.Read(l, SizeOf(Integer)); //Größe des FileStream lesen
    setlength(s, l);
    FileStream.Read(s[1], l);

    case i of
      1: Memo3.Text:= s;
      2: Memo4.Text:= s;
      3: Memo5.Text:= s;
      4: Memo6.Text:= s;
      5: Memo7.Text:= s;
      6: Memo8.Text:= s;
      7: Label9.Caption:= s; //Kalenderwoche
      8: Label10.Caption:= s; //Woche
      9: Label14.Caption:= s; //Lehrernamen
    end;

  end;
  FileStream.Free; //Datei freigeben
end;

//==laden der Momos2============================================================
procedure TForm8.Memolade2;
Var  memos2 :TFileName;
     FileStream2 :TMemoryStream;
     i,l :Integer;
     s :String;
begin
  FileStream2 := TMemoryStream.Create; //FileStream erzeugen

  //Übergabe der Datei
  memos2:=(ExtractFilepath(FileListBox2.FileName) + 'Bemerkungen\' + ExtractFileName(FileListBox2.FileName));
  FileStream2.LoadFromFile(memos2);

  l:= 0;
  FileStream2.Position:= 0; //FileStream Position = Anfang

  for i := 1 to 9 do //Schleifendurchlauf durch Komponenten
  begin
    FileStream2.Read(l, SizeOf(Integer)); //Größe des FileStream lesen
    setlength(s, l);
    FileStream2.Read(s[1], l);

    case i of
      1: Memo3.Text:= s;
      2: Memo4.Text:= s;
      3: Memo5.Text:= s;
      4: Memo6.Text:= s;
      5: Memo7.Text:= s;
      6: Memo8.Text:= s;
      7: Label9.Caption:= s; //Kalenderwoche
      8: Label10.Caption:= s; //Woche
      9: Label14.Caption:= s; //Lehrernamen
    end;

  end;
  FileStream2.Free; //Datei freigeben
end;

//====Blaue Zelle entfernen======================================================
procedure TForm8.blauezelle; //Quelle: Delphi7 Kochbuch
var StringRec :TgridRect;
begin
  with StringRec do begin
    Top:= -1;
    Left:=Left -1;
    Right:= -1;
    Bottom:= -1;
  end;
 StringGrid1.Selection:= StringRec
end;

//=======Panel zum Sperren der Maus============================
procedure TForm8.Panel12MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  with FileListBox1 do
   pt := Point( Left + 100, Top + 100);
     Mouse.CursorPos := ClientToScreen(pt);
end;


//===========Laden der dateien=======================
procedure TForm8.FileListBox1Change(Sender: TObject);
begin
  liste3:= LowerCase(ExtractFileExt(FileListBox1.Filename));  //Pfad in Variable übergeben RTF mit Pfadangabe
    if (liste3 = '.txt') then
      begin
       Gridlade;
       memolade;
       bilderlade;
     end;
 end;

//==============Bilder laden========================
procedure TForm8.bilderlade;
begin
blauezelle;
  if FileListbox1.ItemIndex > -1  then
   begin
     FileListBox1.ItemIndex; //Markierte Spalte finden

     Lb:= FileListBox1.Items[FileListBox1.ItemIndex]; //Makierung übergeben in Variable Lb
     Label14.Caption:= 'VERTRETUNGSPLAN für Koll. '+ Lb;

       if not FileExists (ExtractFilePath(ParamStr(0))+'Lehrer_Fotos\'+Lb+'.jpg') then
         begin
          Image1.Visible:= False;
          Label6.Visible:= False;
         end

       else
         begin

          Image1.Picture.LoadFromFile(ExtractFilePath(ParamStr(0))+'Lehrer_Fotos\'+ Lb +'.jpg') ;
          Image1.Visible:= True;
          Label6.Visible:= True;

           if Panel14.Visible = True then
             begin
              Label6.Caption := 'Bild des Lehrers '+ LB;
             end

           else
            begin
             Label6.Visible:= False;
            end;
          end;
    end
 else
  begin
   // Kein Inhalt, dient nur zur Fehlervermeidung
 end;
end;

//==================Bilder laden vom lehrer=======================
procedure TForm8.bilderlade2;
begin
blauezelle;
  if FileListbox2.ItemIndex > -1  then
   begin
     FileListBox2.ItemIndex; //Markierte Spalte finden

     Lb:= FileListBox2.Items[FileListBox2.ItemIndex]; //Makierung übergeben in Variable Lb
     Label14.Caption:= 'VERTRETUNGSPLAN für Koll. '+ Lb;

       if not FileExists (ExtractFilePath(ParamStr(0))+'Lehrer_Fotos\'+Lb+'.jpg') then
         begin
          Image1.Visible:= False;
          Label6.Visible:= False;
         end

       else
         begin

          Image1.Picture.LoadFromFile(ExtractFilePath(ParamStr(0))+'Lehrer_Fotos\'+ Lb +'.jpg') ;
          Image1.Visible:= True;
          Label6.Visible:= True;

           if Panel14.Visible = True then
             begin
              Label6.Caption := 'Bild des Lehrers '+ LB;
             end

           else
            begin
             Label6.Visible:= False;
            end;
          end;
    end
 else
  begin
   // Kein Inhalt, dient nur zur Fehlervermeidung
 end;
end;


procedure TForm8.FileListBox2Change(Sender: TObject);
begin
  liste4:= LowerCase(ExtractFileExt(FileListBox2.Filename));  //Pfad in Variable übergeben RTF mit Pfadangabe
    if (liste4 = '.txt') then
      begin
       Gridelade2;
       Memolade2;
       bilderlade2;
     end;
 end;


//========Anwort von marabu=========================
function TForm8.FindFiles(const fileExpr: String; files: TStrings;
  options: TFindFilesOptions): Boolean;
var
  sr: TSearchRec;
  path: string;
  extWanted: Boolean;
begin
path:= (ExtractFilePath(ParamStr(0)) +('Vertretungspläne\'+(IntToStr(YearOf(Date)))+'_KW_'+(IntToStr(WeekOfTheYear(Date)))));
showmessage(path);
  Result := True;
  files.Clear;
  files.BeginUpdate;
  if ffoExcludePath in options
    then path := ''
    else path := ExtractFilePath(fileExpr);
  extWanted := not (ffoExcludeExt in options);
  if FindFirst(fileExpr, faArchive, sr) = 0 then
  begin
    repeat
      if extWanted
        then files.Add(path + sr.Name)
        else files.Add(ChangeFileExt(path + sr.Name, ''));
    until FindNext(sr) <> 0;
    FindClose(sr);
  end else Result := False;
  files.EndUpdate;
end;

procedure TForm8.Button2Click(Sender: TObject);
begin
  FindFiles(ExtractFilePath(ParamStr(0)) +('Vertretungspläne\'+(IntToStr(YearOf(Date)))+'_KW_'+(IntToStr(WeekOfTheYear(Date)))), ListBox1.Items, [ffoExcludePath, ffoExcludeExt]);
end;

[DeddyH]

Und so?

Delphi-Quellcode:

procedure TForm8.Button2Click(Sender: TObject);
begin
  FindFiles(ExtractFilePath(ParamStr(0)) +('Vertretungspläne\'+(IntToStr(YearOf(Date)))+'_KW_'+(IntToStr(WeekOfTheYear(Date)))) + '\*', ListBox1.Items, [ffoExcludePath, ffoExcludeExt]);
end;

[SaFu]

Na da werd ich ja verrückt das geht so, das * steht jetzt für die endung????

[DeddyH]

Das * steht für alle Dateien und Ordner.

[SaFu]

na super da bin ich ja ein ganzes stück weiter gekommen mit meinem wissen

aber warum bekomme ich noch diese meldungen

[Warnung] Unit7.pas(8): Unit 'ShellCtrls' ist plattformspezifisch
[Warnung] Unit7.pas(663): Symbol 'Win32Check' ist plattformspezifisch
[Warnung] Unit8.pas(512): Symbol 'faArchive' ist plattformspezifisch
[Warnung] Unit8.pas(7): Unit 'FileCtrl' ist plattformspezifisch

es geht zwar woher kommt das aber

[SirThornberry]

die Meldungen sind doch eigenltich eindeutig. Diese kommen weil die verwendeten dinge plattformspezifisch (betriebssystemspezifisch) sind und auch so markiert sind.

[SaFu]

das heisst auf einem anderen betriebsystem würden die dinge nicht richtig bzw garnicht funktionieren??

[DeddyH]

Jep. Wenn Du Deinen Code in ein CLX-Projekt kopieren würdest, würde es nicht kompiliert werden.