|
![]() |
|
Registriert seit: 15. Sep 2006 165 Beiträge |
#1
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
|
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs 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
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |