AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

loadfile aus TMemoryStream

Ein Thema von bluescreen25 · begonnen am 21. Feb 2008 · letzter Beitrag vom 24. Feb 2008
Antwort Antwort
Seite 1 von 2  1 2      
bluescreen25

Registriert seit: 27. Nov 2005
Ort: Geldern
229 Beiträge
 
Delphi 7 Enterprise
 
#1

loadfile aus TMemoryStream

  Alt 21. Feb 2008, 14:49
Ich verzweifel gerade an Memorystreams. Ich versuche Bilddateien in ein Memorystream zu speichern und zu laden.
Da ich keinen besseren Ansatz habe, habe ich 2 Streams angelegt sowie Stringlisten mit Dateinamen,Position und Size.
Diese Sache klappt auch. Das Laden klappt überhaupt nicht mehr, ich bekomme einfach nicht das File wieder zurück.

//Edit: in den pFile-Stream laden klappt, jedoch nicht LoadFromStream (siehe am Ende!)


Delphi-Quellcode:
procedure LoadMemory; //diese procedure klappt !
var DList:TStrings;
    lCount: Integer;

begin
  DList := TStringList.Create; //Hilfsliste
  lFile := TMemoryStream.Create(); //Gesamtstream aller Files
  pFile := TMemoryStream.Create(); //Stream EinzelFile
  Search := True;
  FindAllFiles(DList,Skindateien[0],Skinpfad,'*',True,False,True);//Dateien finden und in Stringlist
                                                       //später austauschen um direkt über
  for lCount := 0 to Skindateien[0].Count - 1 do //FindallFiles in Stream zu packen, da sonst
  begin //2x Zugriff auf ein File
   pFile.LoadFromFile(Skindateien[0].Strings[lCount]);
   Skindateien[1].Add(IntToStr(pFile.Size));
   Skindateien[2].Add(IntToStr(lFile.Position));
   lFile.CopyFrom(pFile,pFile.Size);
   pFile.Position := 0;
  end;
   
   //zu Testzwecken um zu sehen ob bis hier alles klappt:
   //lFile.SaveToFile(ProgrammPfad+'\SkinStream.dat'); gesamter Stream
   //Skindateien[0].SaveToFile('Skindateien.txt'); Filenames
   //Skindateien[1].SaveToFile('SkindateienSize.txt'); FileSizes
   //Skindateien[2].SaveToFile('SkindateienPos.txt'); FilePositionen

  DList.Free;
end;



procedure LoadPicture(aFileName:String);
var lCount,Position,Size : Integer;
begin
  pFile.Clear;
  pFile.Position := 0;
  lFile.Position := 0;
  for lCount := 0 to Skindateien[0].Count - 1 do
  if aFileName = Skindateien[0].Strings[lCount] then break;

  Size := StrToInt(Skindateien[1].Strings[lCount]);
  Position := StrToInt(Skindateien[2].Strings[lCount]);

  lFile.Position := Position;
  pFile.SetSize(Size);
  pFile.CopyFrom(lFile,Size);

  //pFile.SaveToFile(ProgrammPfad+'\pFile'+ IntToStr(lCount)+'.jpg');//klappt ! die Bilder werden auf
end; //der Festplatte gespeichert, sind auch i.O.
Und hier soll das Bild wieder eingesetzt werden:

Delphi-Quellcode:
SkinBackground := TImage.Create(SkinForm);
    with SkinBackground do
    begin
      Parent := SkinForm;
      Name := iString + '_Background';
      SetBounds(0,0, SkinWidth, SkinHeight);
      iString := lowercase(Ini.ReadString(Menu,'Background','0'));
      Picture.RegisterFileFormat('jpg; *.jpeg','JPEG',TBitmap);

     //if FileExists(SkinPfad + iString) then //anstatt
     // Picture.LoadFromFile(SkinPfad + iString); //das hier
       
       LoadPicture(SkinPfad + iString); //soll
       Picture.Bitmap.LoadFromStream(pFile); //dieses hier, gibt aber immer eine exception!
Kann mir jemand das erklären ?


Gruß, bluescreen
...und ich dachte, Delphi ist ein Programmgenerator mit nur einem Button......tzzz
  Mit Zitat antworten Zitat
Benutzerbild von Union
Union

Registriert seit: 18. Mär 2004
Ort: Luxembourg
3.492 Beiträge
 
Delphi 7 Enterprise
 
#2

Re: loadfile aus TMemoryStream

  Alt 21. Feb 2008, 17:30
Der Aufruf von LoadPicture verursacht Position = Size. Du musst Position vor dem Lesen des Streams wieder auf Null setzen.
Also entweder
Delphi-Quellcode:
  LoadPicture(SkinPfad + iString); //soll
  pFile.Position := 0;
  Picture.Bitmap.LoadFromStream(pFile); //dieses hier, gibt aber immer eine exception!
Oder
Delphi-Quellcode:
function LoadPicture...
begin
  ..
  pFile.CopyFrom(lFile,Size);
  pFile.Position := 0;
end;
Ibi fas ubi proxima merces
sudo /Developer/Library/uninstall-devtools --mode=all
  Mit Zitat antworten Zitat
Muetze1
(Gast)

n/a Beiträge
 
#3

Re: loadfile aus TMemoryStream

  Alt 21. Feb 2008, 18:11
Zusätzlich könnte ich mir noch vorstellen, dass der SetSize() Aufruf hier fehl am Platze ist, weil dann vllt. das CopyFrom die Datei in der Länge nochmal hinten anhängt an pFile. Somit hast du die doppelte Grösse und nur in der zweiten Hälfte steht die Datei.
  Mit Zitat antworten Zitat
bluescreen25

Registriert seit: 27. Nov 2005
Ort: Geldern
229 Beiträge
 
Delphi 7 Enterprise
 
#4

Re: loadfile aus TMemoryStream

  Alt 21. Feb 2008, 18:50
Zitat von Muetze1:
Zusätzlich könnte ich mir noch vorstellen, dass der SetSize() Aufruf hier fehl am Platze ist, weil dann vllt. das CopyFrom die Datei in der Länge nochmal hinten anhängt an pFile. Somit hast du die doppelte Grösse und nur in der zweiten Hälfte steht die Datei.
Ich habe das mal soweit gemacht, was du vorgeschlagen hast. Nur scheint etwas mit dem Zählvorgang nicht zu stimmen egal ob ich von 0 nach Ende oder von Ende nach gezählt habe, jedesmal eine exception Listenerror.

Nach einigen Absicherungen und Umwandlung in eine Function jetzt hierdurch ein positives Ergebnis:

Delphi-Quellcode:
function LoadPicture(aFileName:String):Boolean;
var lCount,Position,Size : Integer;
begin
  pFile.Clear;
  pFile.Position := 0;
  lFile.Position := 0;
  for lCount:= 0 to Skindateien[0].Count-1 do
  if (aFileName = Skindateien[0].Strings[lCount]) or (lCount = Skindateien[0].Count-1) then break;

  if aFileName = Skindateien[0].Strings[lCount] then
  begin
    Size := StrToInt(Skindateien[1].Strings[lCount]);
    Position := StrToInt(Skindateien[2].Strings[lCount]);

    lFile.Position := Position;
    pFile.CopyFrom(lFile,Size);

  Result := True;
  end else Result:= False;

  pFile.Position := 0;
end;
Sowie die Nutzung:

Delphi-Quellcode:
if LoadPicture(SkinPfad + Ini.ReadString(Menu,'Button' + IntToStr(iIndex) + 'Up',''))then
   UpPicture.LoadFromStream(pFile);

Jetzt muss nur noch die Laderoutine geändert werden, am besten direkt in den Stream, anstatt über FindallFiles einmal und zum 2.ten Mal nochmal auf das gleiche File zugegriffen wird.

Gruß, bluescreen
...und ich dachte, Delphi ist ein Programmgenerator mit nur einem Button......tzzz
  Mit Zitat antworten Zitat
Muetze1
(Gast)

n/a Beiträge
 
#5

Re: loadfile aus TMemoryStream

  Alt 21. Feb 2008, 19:55
Also ein Listenerror bedeutet, dass du ein Problem mit einer Liste hast und nicht mit einem Stream. Und zu deiner Liste: Du bekommst doch bestimmt einen Compilerhinweis, dass die Schleifenvariable lCount ausserhalb der Schleife undefiniert ist, oder? Den solltest du mal beachten, dann hättest du vllt. gesehen, dass deine lCount Schleife nur die nachfolgende IF Abfrage beinhaltet und somit kannst du lCount danach vergessen. Dadurch kommt es dann zu dem o.g. Fehler.
  Mit Zitat antworten Zitat
bluescreen25

Registriert seit: 27. Nov 2005
Ort: Geldern
229 Beiträge
 
Delphi 7 Enterprise
 
#6

Re: loadfile aus TMemoryStream

  Alt 21. Feb 2008, 20:21
Zitat von Muetze1:
Also ein Listenerror bedeutet, dass du ein Problem mit einer Liste hast und nicht mit einem Stream. Und zu deiner Liste: Du bekommst doch bestimmt einen Compilerhinweis, dass die Schleifenvariable lCount ausserhalb der Schleife undefiniert ist, oder? Den solltest du mal beachten, dann hättest du vllt. gesehen, dass deine lCount Schleife nur die nachfolgende IF Abfrage beinhaltet und somit kannst du lCount danach vergessen. Dadurch kommt es dann zu dem o.g. Fehler.
Das Problem mit der Liste ist, das wahrscheinlich aFilename nicht gefunden wurde.Das hatte ich nicht abgesichert. Der Stream wurde trotzdem behandelt. Mit lCount haste Recht. In meinem Fall kann ich ja nichts anderes in die Schleife packen, nur das Ergebnis absichern....

Die Routine klappt jetzt auch soweit. Ich hatte exceptions aus versch. Gründen. Dir Liste, dann der Stream wp ich die Pos nicht auf 0 gesetzt hatte.

Mit ladenen pngs als PNGObject klappt jetzt alles. Nun die letzten Probleme noch:

- bei Icons über Stream laden, bekomme ich noch nichts Sichtbares
- bei Images über Stream laden , bekomme ich eine exception: Bitmap ist ungültig.

Delphi-Quellcode:
SkinBackground := TImage.Create(SkinForm);
    with SkinBackground do
    begin
      Parent := SkinForm;
      Name := iString + '_Background';
      SetBounds(0,0, SkinWidth, SkinHeight);
      iString := lowercase(Ini.ReadString(Menu,'Background','0'));
      Picture.RegisterFileFormat('jpg; *.jpeg','JPEG',TBitmap);

      //if FileExists(SkinPfad + iString) then
      //Picture.LoadFromFile(SkinPfad + iString);
      if LoadPicture(SkinPfad + iString)then;
      Picture.Bitmap.LoadFromStream(pFile);
Delphi-Quellcode:
var
  Icon : TIcon;
  iIndex: Integer;
begin
  try
  IL := TImageList.Create(Form1);
  IL.Width := 32;
  IL.Height := 32;
  for iIndex := 0 to 34 do
  begin
    Icon := TIcon.Create;
    //if FileExists(SkinPfad + 'icons\' + Ini.ReadString('Icons','Icon' + IntToStr(iIndex) + 'Picture','0')) then
    //Icon.LoadFromFile(SkinPfad + 'icons\' + Ini.ReadString('Icons','Icon' + IntToStr(iIndex) + 'Picture','0'));
    if LoadPicture(SkinPfad + 'icons\' + Ini.ReadString('Icons','Icon' + IntToStr(iIndex) + 'Picture','0'))then
    Icon.LoadFromStream(pFile);
    IL.AddIcon(Icon);
    Icon.Free;
  end;
Gruß, bluescreen
...und ich dachte, Delphi ist ein Programmgenerator mit nur einem Button......tzzz
  Mit Zitat antworten Zitat
Benutzerbild von Union
Union

Registriert seit: 18. Mär 2004
Ort: Luxembourg
3.492 Beiträge
 
Delphi 7 Enterprise
 
#7

Re: loadfile aus TMemoryStream

  Alt 21. Feb 2008, 22:51
Zitat:
bei Icons über Stream laden, bekomme ich noch nichts Sichtbares
Was willst Du auch sehen:
Delphi-Quellcode:
if LoadPicture(SkinPfad + 'icons\' + Ini.ReadString('Icons','Icon' + IntToStr(iIndex) + 'Picture','0'))then
  Icon.LoadFromStream(pFile);
// Das wird gemacht auch wenn LoadPicture fehlschlägt - Einrückung würde helfen das auf den ersten Blick zu sehen
IL.AddIcon(Icon);
// Und das free ist wohl auch daneben. Selbst wenn bisher alles funktioniert hast löschst Du das soeben eingelesene Icon wieder!
Icon.Free;
Zitat:
bei Images über Stream laden , bekomme ich eine exception: Bitmap ist ungültig
Delphi-Quellcode:
//Ist Menu ein String, der sollte die Section angeben?
iString := lowercase(Ini.ReadString(Menu,'Background','0'));
Und hast Du mal daran gedacht den Debugger zu verwenden?
Ibi fas ubi proxima merces
sudo /Developer/Library/uninstall-devtools --mode=all
  Mit Zitat antworten Zitat
bluescreen25

Registriert seit: 27. Nov 2005
Ort: Geldern
229 Beiträge
 
Delphi 7 Enterprise
 
#8

Re: loadfile aus TMemoryStream

  Alt 22. Feb 2008, 14:42
Zitat von Union:
Zitat:
bei Icons über Stream laden, bekomme ich noch nichts Sichtbares
Was willst Du auch sehen:
Delphi-Quellcode:
if LoadPicture(SkinPfad + 'icons\' + Ini.ReadString('Icons','Icon' + IntToStr(iIndex) + 'Picture','0'))then
  Icon.LoadFromStream(pFile);
// Das wird gemacht auch wenn LoadPicture fehlschlägt - Einrückung würde helfen das auf den ersten Blick zu sehen
IL.AddIcon(Icon);
// Und das free ist wohl auch daneben. Selbst wenn bisher alles funktioniert hast löschst Du das soeben eingelesene Icon wieder!
Icon.Free;
Danke für die Tipps. Nur dort ist der Fehler nicht zu suchen. Festgestellt habe ich, das meine Procedure LoadPicture casesensitive ist, im Gegensatz zu LoadfromFile. Der war es nämlich egal ob der komplette Pfad "C:\MeinProgramm\skins\*.*" oder "C:\MeinProgramm\Skins\*.*" hieß. Er hatte die Icons durch meine aFilename einfach nicht gefunden.

Das Icon gebe ich selbstverständlich wieder frei, nachdem ich es in die Imagelist kopiert habe.Wenn du gesehen hast, ist der Aufbau eine Schleife und somit würden nach Füllen der IL einige Icons im Speicher hängen.

Die Absicherung die du meinst, kommt auf jeden Fall rein, es sollte erstmal funktionieren und das tuts ja jetzt auch.

Zitat:
Zitat:
bei Images über Stream laden , bekomme ich eine exception: Bitmap ist ungültig
Delphi-Quellcode:
//Ist Menu ein String, der sollte die Section angeben?
iString := lowercase(Ini.ReadString(Menu,'Background','0'));
Und hast Du mal daran gedacht den Debugger zu verwenden?
In diesem Punkt liegst du leider völlig daneben. Das Problem ist das TImage und das kann mit png,jpg oder Bitmaps füllen.
Um das aus einem Stream wieder ins Image zu bekommen, muss man z.B. über ein TJPEGImage gehen. Deshalb die exception.
Nach einigem Einlesen in Stream in Verbindung mit Images kam ich dann zum Ergebnis.

Delphi-Quellcode:
SkinBackground := TImage.Create(SkinForm);
    with SkinBackground do
    begin
      Parent := SkinForm;
      Name := iString + '_Background';
      SetBounds(0,0, SkinWidth, SkinHeight);
      iString := lowercase(Ini.ReadString(Menu,'Background','0'));
      Picture.RegisterFileFormat('jpg; *.jpeg','JPEG',TBitmap);

      if LoadPicture(SkinPfad + iString)then
      begin
       if ExtractFileExt(SkinPfad + iString) = '.jpgthen
          begin
            TempJpeg := TJPEGImage.Create;
            TempJpeg.LoadFromStream(pFile);
            Picture.Graphic := TempJpeg;
            TempJpeg.Free;
          end else if ExtractFileExt(SkinPfad + iString) = '.pngthen
            begin
              TempPng := TPNGObject.Create;
              TempPng.LoadFromStream(pFile);
              Picture.Graphic := TempPng;
              TempPng.Free;
            end;
       end;
Hier nach der Reihe die verbauten Proceduren und Functionen:

Im Form.Create werden die Streams erstellt...und die Skindateien eingelesen:

Delphi-Quellcode:
procedure LoadMemory;
var lCount: Integer;
    ext :TStrings;
begin
  try
   lFile := TMemoryStream.Create(); //Gesamtstream aller Files
   pFile := TMemoryStream.Create(); //Stream eines ladenen File
   ext := TStringList.Create;
   ext.Add('.jpg');
   ext.Add('.png');
   ext.Add('.ico');
   ext.Add('.bmp');

   FindAllSkinFiles(Skinpfad,Skindateien[0],Skindateien[1],Skindateien[2],ext);
  finally
   ext.Free;
  end;
end;
In FindallSkinFiles fülle ich Stringlisten mit Size,Position und die Streams....wobei ich mir immer noch nicht sicher bin, ob die Dateien nicht zweimal angefasst werden, da Stream.LoadfromFile ja nach Aufspüren eines Files aufgerufen wird. Gibt es da bessere Möglichkeiten ?

Delphi-Quellcode:
procedure FindAllSkinFiles(const Path:String;FileNames,FileSize,FilePosition,Extensions:TStrings);
var Tick:Cardinal;

  procedure DoSearch(const Path:String);
  var SR : TSearchRec;
  begin
    If Findfirst(Path + '*.*',faAnyFile,SR) = 0 then
     try
       repeat
         if GetTickCount >= Tick then
         begin
           Tick:= GetTickCount +100;
           Application.ProcessMessages;
         end;

         If (SR.Attr and faDirectory <> 0) and (SR.Name <> '.') and (SR.Name <> '..') then
           DoSearch(Path + SR.Name + '\')
         else
           If Extensions.IndexOf(ExtractFileExt(SR.Name)) >= 0 then
           begin
             Skindateien[0].Add(Path + SR.Name);
             pFile.LoadFromFile(Path + SR.Name);
             Skindateien[1].Add(IntToStr(pFile.Size));
             Skindateien[2].Add(IntToStr(lFile.Position));
             lFile.CopyFrom(pFile,pFile.Size);
             pFile.Position := 0;
           end;
        until FindNext(SR) <> 0;
     finally
       FindClose(SR);
     end;
    end;

  begin
    try
     Tick := GetTickCount + 100;
     DOSearch(ExtractFilePath(Path));
    finally

    end;
 end;

Die Ladefunktion eines Files aus dem GesamtStream:

Delphi-Quellcode:
function LoadPicture(aFileName:String):Boolean;
var lCount,Position,Size : Integer;
begin
  pFile.Clear;
  pFile.Position := 0;
  lFile.Position := 0;
  for lCount:= 0 to Skindateien[0].Count-1 do
  if (aFileName = Skindateien[0].Strings[lCount]) or (lCount = Skindateien[0].Count-1) then break;

  if aFileName = Skindateien[0].Strings[lCount] then
  begin
    Size := StrToInt(Skindateien[1].Strings[lCount]);
    Position := StrToInt(Skindateien[2].Strings[lCount]);

    lFile.Position := Position;
    pFile.CopyFrom(lFile,Size);

    Result := True;
  end else Result:= False;

  pFile.Position := 0;
end;

Die Verwendung bei PNGObjectsbei Images wie jpg siehe oben)

Delphi-Quellcode:
if LoadPicture(SkinPfad + Ini.ReadString(Menu,'Button' + IntToStr(iIndex) + 'Up',''))then
        UpPicture.LoadFromStream(pFile);

Jemand noch eine Idee zum Laden aller Files in den Stream (FindAllSkinFiles) ?


Gruß, bluescreen
...und ich dachte, Delphi ist ein Programmgenerator mit nur einem Button......tzzz
  Mit Zitat antworten Zitat
busybyte

Registriert seit: 15. Sep 2006
165 Beiträge
 
#9

Re: loadfile aus TMemoryStream

  Alt 22. Feb 2008, 21:23
Warum denn so kompliziert und langsam (stroint/besser noch strtointdef)über 3 Stringlisten?
Willst Du mit Pointer arbeiten?Das wäre natürlich high-end,
vorerst, ist meiner Meinung nach ein Record am übersichtlichsten.

Delphi-Quellcode:
Type
TMeineStreamDaten=Record
//z.B.
MSDDateiname:String;
MSDSize,Position:integer;
//MeinStream:TStream;
.
.
.
end;

Var MeineStreamDaten:Array of TMeineStreamDaten;
cnt1:integer;



Procedure CreateMyStreamData(StreamDatenAnzahl_);
var cnt1:integer;
begin
Setlength(MeineStreamDaten,StreamDatenAnzahl_);
For cnt1:=0 to Length(MeineStreamDaten)-1 do

 with MeineStreamDaten[cnt1] do
  begin
  MsdSize:=Sizeofirgendwas;
  MSDDateiname:='Test'+inttostr(cnt1);
  .
  .
  .
  end;

.
.
.
I love DiscCat
  Mit Zitat antworten Zitat
busybyte

Registriert seit: 15. Sep 2006
165 Beiträge
 
#10

Re: loadfile aus TMemoryStream

  Alt 22. Feb 2008, 22:46
So ich hab mal ein bischen rumgebastelt,keine Ahnung ob das so richtig für Dich ist,
aber das Prinzip sollte irgendwann klar werden.

//Jetzt nach dem 21 Edit und einer durchzechten Nacht,
(man gönnt sich ja sonst nichts), muss ich sagen, so wie es jetzt ist,
ist es gut für viele kleine Bildchen z.b. Icons oder Texturen,
aber dadurch, das alles in einem Memorystream gehalten wird, kommt ab und zu ein Speicherüberlauf.
Ich habe das Gefühl das auch irgendwas mit Findfirst( nicht stimmt,mal sehen, vieleicht hat ein
anderer ne Lösung für nen zünftigen Grafikloader.


Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls,
  ExtCtrls,JPEG;

type

  TSkindatei=Record
  skSize,skPosition:integer;
  skFilename:String;
  //skFilenames:TStrings;
  end;


  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
   Procedure Streamini;
   Procedure Streamfree;
   { Private declarations }
  public
  SkinDateien:Array of TSkinDatei;
  ErrorCode:integer;
  function AddSkindatei(Var DList_:TStringList;SkinDatei_:TSkindatei):Boolean;
  function LoadPicture(aFileName:String):Boolean;
  procedure LoadMemory;
  procedure FindFiles(Var DList_:TStringList);
  procedure CreateBackGround(Filename_:String;Skinwidth,Skinheight:integer;Owner_:TWinControl);
  procedure resetDatas(Var DList1_:TStringList);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
Var
lFile :TMemoryStream; //Gesamtstream aller Files
pFile :TMemoryStream; //Stream EinzelFile
AnzSkinDateien:Longint;
Search :Boolean;
SkinPfad:String;
TestS:String;
SkinBackGround:TImage;
TempJpeg :TJPEGImage;
Extensions:TStringList;

const
   FileFilter = '*.bmp;*.jpg;*.jpeg;*.png;|'+
     '*.bmp;*.jpg;*.jpeg;';

function TForm1.LoadPicture(aFileName:String):Boolean;
var lCount : Integer;
begin
Result:=false;
  pFile.Clear;
  pFile.Position := 0;
  lFile.Position := 0;
  for lCount:= 0 to Length(Skindateien)-1 do
   with Skindateien[lCount] do
    begin
     TestS:=skFilename;
     if ansisameText(aFileName,skFilename) then
      begin
      lFile.Position := skPosition;
      pFile.CopyFrom(lFile,skSize);
      Result := True;
      pFile.Position := 0;
      Exit;
      end;

   end;
end;

Procedure TForm1.CreateBackGround(Filename_:String;Skinwidth,Skinheight:integer;Owner_:TWinControl);
Var ex_:String;
begin
SkinBackground := TImage.Create(Owner_);
    with SkinBackground do
    begin
      Parent := Owner_;
      Name := 'Background_'+inttostr(Parent.ControlCount);
      SetBounds(0,0, SkinWidth, SkinHeight);
      Picture.RegisterFileFormat('jpg;*.bmp; *.jpeg;*.bmp','JPEG',TBitmap);
      ex_:=Lowercase(ExtractFileExt(Filename_));
      begin
       if (Ex_ = '.jpg') or (Ex_='jpeg') then
          begin
            TempJpeg := TJPEGImage.Create;
            TempJpeg.LoadFromStream(pFile);
            Picture.Bitmap.Assign(TempJpeg);
            TempJpeg.Free;
          end
          else
          if (Ex_ = '.png') then
            begin
             { TempPng := TPNGObject.Create;
              TempPng.LoadFromStream(pFile);
              Picture.Bitmap.Assign(TempJpeg);
              TempPng.Free;
              }

            end
           else
           if (Ex_='.bmp') then
           Picture.Bitmap.LoadFromStream(pFile);

      end;


    end;
end;


procedure TForm1.LoadMemory;
var DList:TStringList;
    lCount: Integer;
begin
DList := TStringList.Create; //Hilfsliste
  try
  resetDatas(DList);
  Search := True;
  FindFiles(DList); //Dateien finden und in Stringlist
                                  //später austauschen
  //zu Testzwecken um zu sehen ob bis hier alles klappt:
  Memo1.Lines.Assign(DList);
  finally DList.Free; end;
end;

Function TForm1.AddSkindatei(Var DList_:TStringList;SkinDatei_:TSkindatei):Boolean;
Var L1:integer;
begin
//Setlength verbraucht viel zeit deswegen gleich ein paar mehr
while AnzSkinDateien>Length(SkinDateien)-1 do
Setlength(SkinDateien,AnzSkinDateien+100);
Skindateien[AnzSkinDateien]:=SkinDatei_;
inc(AnzSkinDateien);
DList_.Add(SkinDatei_.skFilename);
end;


procedure TForm1.Button1Click(Sender: TObject);
Var Filename_:String;
begin
with Opendialog1 do
begin

 Filter:=FileFilter;
  if execute then
    begin
    Filename_:=Filename;
    SkinPfad:= extractfilepath(Filename_);
    Label1.Caption:='';
    LoadMemory;
    Label1.Caption:=inttostr(Length(SkinDateien));

      if not LoadPicture(Filename_) then
       begin
       case Errorcode of
       1:Showmessage('Überlauf!');
       2:Showmessage('Keine Übereinstimmung oder ungültige Datei!');
       end;
       exit;
       end;
    CreateBackGround(Filename_,150,150,Form1);
    end;
 end;
end;


procedure TForm1.resetDatas(Var DList1_:TStringList);
begin
DList1_.Clear;
Memo1.Clear;
lFile.Clear;
pFile.Clear;
end;


procedure TForm1.FindFiles(Var DList_:TStringList);
var Tick:Cardinal; TmpSkinDatei:TSkinDatei;
S:String;

  procedure DoSearch(const Path:String);
  var SR : TSearchRec;
  begin

    If Findfirst(Path + '*.*',faAnyFile,SR) = 0 then
     try
       repeat
         if GetTickCount >= Tick then
         begin
           Tick:= GetTickCount +100;
           Application.ProcessMessages;
         end;

         If (SR.Attr and faDirectory <> 0) and (SR.Name <> '.') and (SR.Name <> '..') then
           DoSearch(Path + SR.Name + '\')

         else
          if Extensions.IndexOf(ExtractFileExt(SR.Name)) >= 0 then
            with TmpSkinDatei do
             begin
             S:=Path + SR.Name;
             pFile.Clear;
             pFile.LoadFromFile(S);
             skSize:=pFile.Size;
              while (lFile.Size+skSize>160000000) do
               begin
               ErrorCode:=1;
               exit;
               end;

             skPosition:=lFile.Position;
             skFilename:=S;
             AddSkindatei(DList_,TmpSkinDatei);
             //pFile.Position := 0;
             lFile.CopyFrom(pFile,pFile.Size);
             end;

        until FindNext(SR) <> 0;
     finally
       FindClose(SR);
     end;
    end;

begin
    try
     Tick := GetTickCount + 100;
     AnzSkinDateien:=0;
     lFile.Position:=0;
     pFile.Position:=0;
     resetDatas(DList_);
     DOSearch(SkinPfad);

     Setlength(SkinDateien,AnzSkinDateien); //Tatsächliche Länge setzen
    except Setlength(SkinDateien,0);
    end;
end;


Procedure TForm1.Streamini;
begin
lFile := TMemoryStream.Create(); //Gesamtstream aller Files
pFile := TMemoryStream.Create(); //Stream EinzelFile
SkinPfad:='C:\Windows\';
Extensions:=TStringList.Create;
  with Extensions do
    try
    Add('.bmp');
    Add('.jpg');
    Add('.jpeg');
    Add('.png');
    except Extensions.Free; end;

    with Memo1 do
    begin
    Clear;
    Align:=alRight;
    ScrollBars:=ssBoth;
    end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
ErrorCode:=0;
Streamini;
end;

Procedure TForm1.Streamfree;
begin
  Setlength(Skindateien,0);
  freeandnil(lFile);
  freeandnil(pFile);
  freeandnil(Extensions);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Streamfree;
end;


end.
I love DiscCat
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 2  1 2      


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 17:22 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz