glxtreem-commits Mailing List for GLXTreem
Brought to you by:
andreaz
Menu
▾
▴
glxtreem-commits — Commits
You can subscribe to this list here.
| 2004 |
Jan
(61) |
Feb
(1) |
Mar
(18) |
Apr
(14) |
May
(1) |
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|---|
|
From: Andreas L. <an...@us...> - 2004-05-11 17:11:11
|
Update of /cvsroot/glxtreem/GLXtreem/Source/models In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17530/models Log Message: Directory /cvsroot/glxtreem/GLXtreem/Source/models added to the repository |
|
From: Markus L?d. <dan...@us...> - 2004-04-08 01:54:47
|
Update of /cvsroot/glxtreem/GLXtreem/Source In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16620/Source Added Files: GLXSound.pas Log Message: added GLXSound and GLXSoundEditor --- NEW FILE: GLXSound.pas --- unit GLXSound; interface uses SysUtils,Classes,Controls,GLXResource, fmod, fmodtypes, fmoderrors, fmodpresets; type TGLXSound = class(TGLXResource,IEditor) private FName : String; FData : TMemoryStream; FSample : PFSoundSample; FChannel : Integer; FVolume : Byte; FLoop : Boolean; FSurround : Boolean; FLoaded : Boolean; protected procedure CreateSample; public {@exclude} constructor Create; override; {@exclude} destructor Destroy; override; procedure LoadFromStream(Stream:TStream); override; procedure SaveToStream(Stream:TStream); override; procedure Load(FileName:String); procedure Play; procedure Stop; function Name:String; function Length:Integer; //IEditor function Edit:Boolean; property Volume : Byte read FVolume write FVolume; property Loop : Boolean read FLoop write FLoop; {Sets a surround sound status. This surround sound is a fake dolby trick that effectively pans the channel to the center, but inverts the waveform in one speaker to make it sound fuller or spacier, or like it is coming out of space between the 2 speakers. Panning is ignored while surround is in effect.} property Surround : Boolean read FSurround write FSurround; end; implementation uses GLXSoundEditor; const BLOCKSIZE = 4096; constructor TGLXSound.Create; begin inherited Create; FName := ''; FData := TMemoryStream.Create; FSample := nil; FChannel := -1; FVolume := 255; FLoop := false; FSurround := false; end; destructor TGLXSound.Destroy; begin if FSample<>nil then FSOUND_Sample_Free(FSample); FData.Free; inherited Destroy; end; procedure TGLXSound.CreateSample; var Error : TFModErrors; begin if FLoaded then begin if FSample<>nil then FSOUND_Sample_Free(FSample); FSample := FSOUND_Sample_Load(FSOUND_FREE,FData.Memory,FSOUND_LOADMEMORY or FSOUND_2D or FSOUND_LOOP_OFF,0,FData.Size); Error := FSOUND_GetError(); case Error of FMOD_ERR_FILE_FORMAT: raise Exception.create('Unknown file format!'); end; end; end; procedure TGLXSound.LoadFromStream(Stream:TStream); var Reader : TReader; Size : Integer; begin inherited; Reader := TReader.Create(Stream,BLOCKSIZE); try FName := Reader.ReadString; FVolume := Reader.ReadInteger; FLoop := Reader.ReadBoolean; FSurround := Reader.ReadBoolean; Size := Reader.ReadInteger; Reader.FlushBuffer; FData.Position:=0; FData.CopyFrom(Stream,Size); FLoaded := Size>0; CreateSample; finally Reader.Free; end; end; procedure TGLXSound.SaveToStream(Stream:TStream); var Writer : TWriter; Size : Integer; begin inherited; Writer:=TWriter.Create(Stream,BLOCKSIZE); try Writer.WriteString(FName); Writer.WriteInteger(FVolume); Writer.WriteBoolean(FLoop); Writer.WriteBoolean(FSurround); FData.Position := 0; Size := FData.Size; Writer.WriteInteger(Size); Writer.FlushBuffer; Stream.CopyFrom(FData,Size); // FData.SaveToStream(Stream); finally Writer.Free; end; end; procedure TGLXSound.Load(FileName:String); var FileStream : TFileStream; begin if FileExists(FileName) then begin FName := ExtractFilename(Filename); FileStream := TFileStream.Create(FileName,fmOpenRead); FData.Clear; FData.Position := 0; try FData.CopyFrom(FileStream,FileStream.Size); FLoaded := FData.Position>0; finally FileStream.Free; end; CreateSample; end else raise Exception.CreateFmt('File %s not found!',[FileName]); end; procedure TGLXSound.Play; begin //Play sound paused FChannel := FSOUND_PlaySoundEx(FSOUND_FREE,FSample,nil,true); if FLoop then begin FSOUND_SetLoopMode(FChannel,FSOUND_LOOP_NORMAL); end else begin FSOUND_SetLoopMode(FChannel,FSOUND_LOOP_OFF); end; if FSurround then begin FSOUND_SetSurround(FChannel,true); end else begin FSOUND_SetSurround(FChannel,false); end; FSOUND_SetVolume(FChannel,FVolume); FSOUND_SetPaused(FChannel, False); end; procedure TGLXSound.Stop; begin FSOUND_StopSound(FChannel) end; function TGLXSound.Name:String; begin if FSample<>nil then begin result:=String(FSOUND_Sample_GetName(FSample)); if result='' then result:=FName; end else begin result:=''; end; end; function TGLXSound.Length:Integer; begin if FSample<>nil then begin result:=FSOUND_Sample_GetLength(FSample); end else begin result:=0; end; end; function TGLXSound.Edit:Boolean; var MyForm : TGLXSoundEditorForm; begin MyForm:=TGLXSoundEditorForm.Create(Nil); MyForm.Sound:=Self; if MyForm.ShowModal=mrOK then begin result:=true; end else result:=false; MyForm.Free; end; initialization //Autodetect best output FSOUND_SetOutput(TFSoundOutputTypes(-1)); //Take default sound driver FSOUND_SetDriver(0); //Autodetect Mixer FSOUND_SetMixer(FSOUND_MIXER_QUALITY_AUTODETECT); //Initialize fmod if not FSOUND_Init(44100,32,0) then begin FSOUND_Close(); raise Exception.Create('Could not initialize FMOD!'); end; RegisterResourceClass(TGLXSound); finalization UnRegisterResourceClass(TGLXSound); FSOUND_Close(); end. |
|
From: Markus L?d. <dan...@us...> - 2004-04-08 01:51:55
|
Update of /cvsroot/glxtreem/GLXtreem/Source/fmod In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15852/Source/fmod Modified Files: fmod.pas fmoddyn.pas fmodtypes.pas Added Files: fmod.dll Log Message: updated fmod to 3.71 Index: fmod.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/fmod/fmod.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** fmod.pas 10 Mar 2004 16:58:15 -0000 1.1 --- fmod.pas 8 Apr 2004 01:38:49 -0000 1.2 *************** *** 4,8 **** { NOTE: For the demos to run you must have either fmod.dll (in Windows) ! or libfmod-3.70.so (in Linux) installed. In Windows, copy the fmod.dll file found in the api directory to either of --- 4,8 ---- { NOTE: For the demos to run you must have either fmod.dll (in Windows) ! or libfmod-3.71.so (in Linux) installed. In Windows, copy the fmod.dll file found in the api directory to either of *************** *** 11,20 **** - Windows\System (95/98) or WinNT\System32 (NT/2000/XP) ! In Linux, make sure you are signed in as root and copy the libfmod-3.70.so file from the api directory to your /usr/lib/ directory. Then via a command line, navigate to the /usr/lib/ directory and create ! a symbolic link between libfmod-3.70.so and libfmod.so. This is done with the following command (assuming you are in /usr/lib/)... ! ln -s libfmod-3.70.so libfmod.so. } { =============================================================================================== } --- 11,20 ---- - Windows\System (95/98) or WinNT\System32 (NT/2000/XP) ! In Linux, make sure you are signed in as root and copy the libfmod-3.71.so file from the api directory to your /usr/lib/ directory. Then via a command line, navigate to the /usr/lib/ directory and create ! a symbolic link between libfmod-3.71.so and libfmod.so. This is done with the following command (assuming you are in /usr/lib/)... ! ln -s libfmod-3.71.so libfmod.so. } { =============================================================================================== } Index: fmoddyn.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/fmod/fmoddyn.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** fmoddyn.pas 10 Mar 2004 16:58:15 -0000 1.1 --- fmoddyn.pas 8 Apr 2004 01:38:49 -0000 1.2 *************** *** 4,8 **** { NOTE: For the demos to run you must have either fmod.dll (in Windows) ! or libfmod-3.7.so (in Linux) installed. In Windows, copy the fmod.dll file found in the api directory to either of --- 4,8 ---- { NOTE: For the demos to run you must have either fmod.dll (in Windows) ! or libfmod-3.71.so (in Linux) installed. In Windows, copy the fmod.dll file found in the api directory to either of *************** *** 11,20 **** - Windows\System (95/98) or WinNT\System32 (NT/2000/XP) ! In Linux, make sure you are signed in as root and copy the libfmod-3.7.so file from the api directory to your /usr/lib/ directory. Then via a command line, navigate to the /usr/lib/ directory and create ! a symbolic link between libfmod-3.7.so and libfmod.so. This is done with the following command (assuming you are in /usr/lib/)... ! ln -s libfmod-3.7.so libfmod.so. } { =============================================================================================== } --- 11,20 ---- - Windows\System (95/98) or WinNT\System32 (NT/2000/XP) ! In Linux, make sure you are signed in as root and copy the libfmod-3.71.so file from the api directory to your /usr/lib/ directory. Then via a command line, navigate to the /usr/lib/ directory and create ! a symbolic link between libfmod-3.71.so and libfmod.so. This is done with the following command (assuming you are in /usr/lib/)... ! ln -s libfmod-3.71.so libfmod.so. } { =============================================================================================== } Index: fmodtypes.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/fmod/fmodtypes.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** fmodtypes.pas 10 Mar 2004 16:58:15 -0000 1.1 --- fmodtypes.pas 8 Apr 2004 01:38:49 -0000 1.2 *************** *** 4,8 **** { NOTE: For the demos to run you must have either fmod.dll (in Windows) ! or libfmod-3.70.so (in Linux) installed. In Windows, copy the fmod.dll file found in the api directory to either of --- 4,8 ---- { NOTE: For the demos to run you must have either fmod.dll (in Windows) ! or libfmod-3.71.so (in Linux) installed. In Windows, copy the fmod.dll file found in the api directory to either of *************** *** 11,20 **** - Windows\System (95/98) or WinNT\System32 (NT/2000/XP) ! In Linux, make sure you are signed in as root and copy the libfmod-3.70.so file from the api directory to your /usr/lib/ directory. Then via a command line, navigate to the /usr/lib/ directory and create ! a symbolic link between libfmod-3.70.so and libfmod.so. This is done with the following command (assuming you are in /usr/lib/)... ! ln -s libfmod-3.70.so libfmod.so. } { =============================================================================================== } --- 11,20 ---- - Windows\System (95/98) or WinNT\System32 (NT/2000/XP) ! In Linux, make sure you are signed in as root and copy the libfmod-3.71.so file from the api directory to your /usr/lib/ directory. Then via a command line, navigate to the /usr/lib/ directory and create ! a symbolic link between libfmod-3.71.so and libfmod.so. This is done with the following command (assuming you are in /usr/lib/)... ! ln -s libfmod-3.71.so libfmod.so. } { =============================================================================================== } *************** *** 72,76 **** const ! FMOD_VERSION: Single = 3.70; { --- 72,76 ---- const ! FMOD_VERSION: Single = 3.71; { *************** *** 304,316 **** you can specify that will really alter the behaviour of how it is loaded, are the following. ! FSOUND_LOOP_OFF ! FSOUND_LOOP_NORMAL ! FSOUND_LOOP_BIDI ! FSOUND_HW3D ! FSOUND_2D ! FSOUND_STREAMABLE ! FSOUND_LOADMEMORY ! FSOUND_LOADRAW ! FSOUND_MPEGACCURATE See flag descriptions for what these do. --- 304,312 ---- you can specify that will really alter the behaviour of how it is loaded, are the following. ! Looping behaviour - FSOUND_LOOP_OFF, FSOUND_LOOP_NORMAL, FSOUND_LOOP_BIDI ! Load destination - FSOUND_HW3D, FSOUND_HW2D, FSOUND_2D ! Loading behaviour - FSOUND_NONBLOCKING, FSOUND_LOADMEMORY, FSOUND_LOADRAW, FSOUND_MPEGACCURATE, FSOUND_MPEGHALFRATE, FSOUND_FORCEMONO ! Playback behaviour - FSOUND_STREAMABLE, FSOUND_ENABLEFX ! PlayStation 2 only - FSOUND_USECORE0, FSOUND_USECORE1, FSOUND_LOADMEMORYIOP See flag descriptions for what these do. --- NEW FILE: fmod.dll --- (This appears to be a binary file; contents omitted.) |
|
From: Markus L?d. <dan...@us...> - 2004-04-08 01:48:25
|
Update of /cvsroot/glxtreem/GLXtreem/Source/Designtime In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15496/Source/Designtime Modified Files: GLXRegister.pas GLXStringListEditor.dfm Added Files: GLXSoundEditor.dfm GLXSoundEditor.pas Log Message: added GLXSound and GLXSoundEditor --- NEW FILE: GLXSoundEditor.dfm --- object GLXSoundEditorForm: TGLXSoundEditorForm Left = 544 Top = 303 Width = 330 Height = 178 Caption = 'GLXSoundEditorForm' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] Icon.Data = { 0000010001001010000001000800680500001600000028000000100000002000 0000010008000000000000000000000000000000000000000000000000000000 0000A77E7000A9807300A4786E0098686500BA958700EAD7A400EAD59E00E0C0 9700A5776C00A1746B00E1D4D300FFFEEE00F7CC8C00F0B47300F7C78800FCE3 A500C2A08800CEB29300FFFEDD00F4D1A500EEBA7B00F2C78F00F8E1AB00FCF0 BA00FCFACA00A3776F00AA7F7300FAE0A400F0B77800F6DDA600FEFBCC00FFFF D300FFFFD100FFFFD700D9C5A700A3756C00B18A7800FFDE9900E9A16700F4D1 9900FEFCCC00FFFFD500FFFFDA00FFFFDC00EFE6C500A97E7500B0897800FEDA 9700EDB47800FBEEBB00FFFFF400FFFFE200E9DDBC00A67B7300FAD19200FEF4 C200FFFFD000FFFFF600FFFFFC00B6938400C0917D00FCE9AC00FFFFCC00FFFF CF00FFFFDE00FFFFFA00E3D3D100996965003BABFF00A1CAE700AD867900A983 7300E0CFB100FFFFDD00FCF8CF00CCB29F0038A5FE00329DFF00156DCE00444F 5B009C6B6500AF887B00AF887E00AA80750037A4FE00359EFF000F6FDE003560 8B00A67B7F00379FFF000E6DDE00355F8900BB7F790032A0FE0037A1FF00106F E200325F8B00B67D79005084B2000F6FE100325F8C00B87E7A00314B6200AC7D 7E00000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000FFFFFF000067 6800000000000000000000000000636465660000000000000000000000005E5F 606162000000000000000000000000555A5B5C5D000000000000000000000000 55565758590000000000000000000000004D4E4F500051525354000000000000 000045464748492B4A4B4C0A00000000000000003D3E3F403941424344000000 000000002F3738392B3A3B3B3C0000000000002F303132202C33333435360000 00000025262728292A2B2C222D2E00000000001B1C1D151E1F20212223240000 0000000012131415161718191A000000000000000A0B0C0D0E0F101109000000 0000000000040506070809090000000000000000000000010203000000009FFF 00000FFF000007FF000083FF0000C1FF0000E10F0000F0030000FC010000FC01 0000F8000000F8000000F8000000FC010000FC010000FE030000FF8F0000} OldCreateOrder = False PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel Left = 8 Top = 68 Width = 35 Height = 13 Caption = 'Volume' end object Panel1: TPanel Left = 0 Top = 109 Width = 322 Height = 35 Align = alBottom BevelOuter = bvNone TabOrder = 0 DesignSize = ( 322 35) object Button1: TButton Left = 243 Top = 4 Width = 75 Height = 25 Anchors = [akTop, akRight] Caption = '&OK' TabOrder = 0 OnClick = Button1Click end object Button2: TButton Left = 8 Top = 4 Width = 75 Height = 25 Caption = '&Play' TabOrder = 1 OnClick = Button2Click end object Button3: TButton Left = 88 Top = 4 Width = 75 Height = 25 Caption = '&Stop' TabOrder = 2 OnClick = Button3Click end end object Button4: TButton Left = 232 Top = 16 Width = 75 Height = 25 Caption = '&Load Sound' TabOrder = 1 OnClick = Button4Click end object NameEdit: TEdit Left = 8 Top = 16 Width = 217 Height = 21 ReadOnly = True TabOrder = 2 end object cbLoop: TCheckBox Left = 8 Top = 40 Width = 97 Height = 17 Caption = 'Loop' TabOrder = 3 OnClick = cbLoopClick end object cbSurround: TCheckBox Left = 96 Top = 40 Width = 97 Height = 17 Caption = 'Surround' TabOrder = 4 OnClick = cbSurroundClick end object tbVolume: TTrackBar Left = 48 Top = 64 Width = 265 Height = 33 Max = 255 Orientation = trHorizontal Frequency = 1 Position = 255 SelEnd = 0 SelStart = 0 TabOrder = 5 TickMarks = tmBoth TickStyle = tsNone OnChange = tbVolumeChange end object OpenDialog: TOpenDialog DefaultExt = '*.wav' Filter = 'Sound Files (*.WAV;*.MP2;*.MP3;*.OGG)|*.WAV;*.MP2;*.MP3;*.OGG' Options = [ofHideReadOnly, ofNoChangeDir, ofFileMustExist, ofEnableSizing] Title = 'Open Sound' Left = 176 Top = 8 end end Index: GLXStringListEditor.dfm =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/Designtime/GLXStringListEditor.dfm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** GLXStringListEditor.dfm 1 Apr 2004 01:14:21 -0000 1.1 --- GLXStringListEditor.dfm 8 Apr 2004 01:35:21 -0000 1.2 *************** *** 1,5 **** object GLXStringListEditorForm: TGLXStringListEditorForm ! Left = 361 ! Top = 157 Width = 381 Height = 249 --- 1,5 ---- object GLXStringListEditorForm: TGLXStringListEditorForm ! Left = 370 ! Top = 198 Width = 381 Height = 249 --- NEW FILE: GLXSoundEditor.pas --- unit GLXSoundEditor; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, GLXSound, ComCtrls; type TGLXSoundEditorForm = class(TForm) Panel1: TPanel; Button1: TButton; Button4: TButton; OpenDialog: TOpenDialog; Button2: TButton; Button3: TButton; NameEdit: TEdit; cbLoop: TCheckBox; cbSurround: TCheckBox; tbVolume: TTrackBar; Label1: TLabel; procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Button1Click(Sender: TObject); procedure cbLoopClick(Sender: TObject); procedure cbSurroundClick(Sender: TObject); procedure tbVolumeChange(Sender: TObject); private fSound : TGLXSound; procedure SetSound(ASound:TGLXSound); public property Sound : TGLXSound read fSound write SetSound; end; implementation {$R *.dfm} procedure TGLXSoundEditorForm.SetSound(ASound:TGLXSound); begin fSound:=ASound; if Assigned(fSound) then begin Caption := fSound.Ident; NameEdit.Text := Format('%s (Length=%d)',[fSound.Name,fSound.Length]); cbLoop.Checked := fSound.Loop; cbSurround.Checked := fSound.Surround; tbVolume.Position := fSound.Volume; end; end; procedure TGLXSoundEditorForm.Button2Click(Sender: TObject); begin if Assigned(fSound) then fSound.Play; end; procedure TGLXSoundEditorForm.Button3Click(Sender: TObject); begin if Assigned(fSound) then fSound.Stop; end; procedure TGLXSoundEditorForm.Button4Click(Sender: TObject); begin if OpenDialog.Execute then begin fSound.Load(OpenDialog.FileName); NameEdit.Text:=Format('%s (Length=%d)',[fSound.Name,fSound.Length]); end; end; procedure TGLXSoundEditorForm.Button1Click(Sender: TObject); begin if Assigned(fSound) then begin fSound.Dirty:=true; end; ModalResult:=mrOK; end; procedure TGLXSoundEditorForm.cbLoopClick(Sender: TObject); begin if Assigned(fSound) then begin fSound.Loop:=cbLoop.Checked; end; end; procedure TGLXSoundEditorForm.cbSurroundClick(Sender: TObject); begin if Assigned(fSound) then begin fSound.Surround:=cbSurround.Checked; end; end; procedure TGLXSoundEditorForm.tbVolumeChange(Sender: TObject); begin if Assigned(fSound) then begin fSound.Volume := tbVolume.Position; end; end; end. Index: GLXRegister.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/Designtime/GLXRegister.pas,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** GLXRegister.pas 1 Apr 2004 22:29:19 -0000 1.4 --- GLXRegister.pas 8 Apr 2004 01:35:21 -0000 1.5 *************** *** 42,45 **** --- 42,47 ---- GLXScreens, + GLXSound, + GLXResource, GLXResourceSourceEditor; |
|
From: Markus L?d. <dan...@us...> - 2004-04-08 01:46:15
|
Update of /cvsroot/glxtreem/GLXtreem/Source In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15265/Source Modified Files: GLXResource.pas Log Message: added GLXSound and GLXSoundEditor Index: GLXResource.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/GLXResource.pas,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** GLXResource.pas 1 Apr 2004 22:25:58 -0000 1.3 --- GLXResource.pas 8 Apr 2004 01:33:10 -0000 1.4 *************** *** 887,891 **** result:=false; if FileExists(ExtractFilepath(Application.Exename)+fFilename) then begin ! FStream := TFileStream.Create(ExtractFilepath(Application.Exename)+fFilename,fmOpenRead or fmShareDenyWrite); try FStream.Seek(-2*SizeOf(Integer),soFromEnd); --- 887,891 ---- result:=false; if FileExists(ExtractFilepath(Application.Exename)+fFilename) then begin ! FStream := TFileStream.Create(fFilename,fmOpenRead or fmShareDenyWrite); try FStream.Seek(-2*SizeOf(Integer),soFromEnd); *************** *** 908,913 **** Size : Integer; begin ! if FileExists(ExtractFilepath(Application.Exename)+fFilename) then begin ! FStream := TFileStream.Create(ExtractFilepath(Application.Exename)+fFilename,fmOpenReadWrite or fmShareDenyRead); try FStream.Seek(0,soFromEnd); --- 908,913 ---- Size : Integer; begin ! if FileExists(fFilename) then begin ! FStream := TFileStream.Create(fFilename,fmOpenReadWrite or fmShareDenyRead); try FStream.Seek(0,soFromEnd); *************** *** 919,923 **** FStream.Free; end; ! end else raise Exception.CreateFmt(NOFILE,[ExtractFilepath(Application.Exename)+fFilename]); end; --- 919,923 ---- FStream.Free; end; ! end else raise Exception.CreateFmt(NOFILE,[fFilename]); end; *************** *** 927,934 **** Inv : TGLXInventory; begin ! if FileExists(ExtractFilepath(Application.Exename)+fFilename) then begin Inv := GetInv(Ident); if Assigned(Inv) then begin ! FStream := TFileStream.Create(ExtractFilepath(Application.Exename)+fFilename,fmOpenRead or fmShareDenyWrite); try FStream.Position := Inv.Offset; --- 927,934 ---- Inv : TGLXInventory; begin ! if FileExists(fFilename) then begin Inv := GetInv(Ident); if Assigned(Inv) then begin ! FStream := TFileStream.Create(fFilename,fmOpenRead or fmShareDenyWrite); try FStream.Position := Inv.Offset; *************** *** 952,957 **** try //Copy all resources into memory ! if FileExists(ExtractFilepath(Application.Exename)+fFilename) then begin ! FStream := TFileStream.Create(ExtractFilepath(Application.Exename)+fFilename,fmOpenRead or fmShareDenyWrite); try for i:=0 to GetInvCount-1 do begin --- 952,957 ---- try //Copy all resources into memory ! if FileExists(fFilename) then begin ! FStream := TFileStream.Create(fFilename,fmOpenRead or fmShareDenyWrite); try for i:=0 to GetInvCount-1 do begin *************** *** 969,973 **** //Write all resources back to the file MStream.Position := 0; ! FStream := TFileStream.Create(ExtractFilepath(Application.Exename)+fFilename,fmCreate or fmShareDenyRead); try for i:=0 to GetInvCount-1 do begin --- 969,973 ---- //Write all resources back to the file MStream.Position := 0; ! FStream := TFileStream.Create(fFilename,fmCreate or fmShareDenyRead); try for i:=0 to GetInvCount-1 do begin *************** *** 999,1007 **** i : Integer; begin ! if FileExists(ExtractFilepath(Application.Exename)+fFilename) then begin MStream := TMemoryStream.Create; try //Copy all resources into memory ! FStream := TFileStream.Create(ExtractFilepath(Application.Exename)+fFilename,fmOpenRead or fmShareDenyWrite); try for i:=0 to GetInvCount-1 do begin --- 999,1007 ---- i : Integer; begin ! if FileExists(fFilename) then begin MStream := TMemoryStream.Create; try //Copy all resources into memory ! FStream := TFileStream.Create(fFilename,fmOpenRead or fmShareDenyWrite); try for i:=0 to GetInvCount-1 do begin *************** *** 1018,1022 **** //Write all resources back to the file MStream.Position := 0; ! FStream := TFileStream.Create(ExtractFilepath(Application.Exename)+fFilename,fmCreate or fmShareDenyRead); try for i:=0 to GetInvCount-1 do begin --- 1018,1022 ---- //Write all resources back to the file MStream.Position := 0; ! FStream := TFileStream.Create(fFilename,fmCreate or fmShareDenyRead); try for i:=0 to GetInvCount-1 do begin |
|
From: Markus L?d. <dan...@us...> - 2004-04-08 01:45:12
|
Update of /cvsroot/glxtreem/GLXtreem/Packages In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15041/Packages Modified Files: GLXtreem_6.dpk GLXtreem_6.res Log Message: added fmod Index: GLXtreem_6.dpk =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Packages/GLXtreem_6.dpk,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** GLXtreem_6.dpk 10 Mar 2004 23:43:42 -0000 1.1 --- GLXtreem_6.dpk 8 Apr 2004 01:32:08 -0000 1.2 *************** *** 32,36 **** rtl, vcl, ! vclx; contains --- 32,37 ---- rtl, vcl, ! vclx, ! VclSmp; contains *************** *** 44,48 **** GLXNotification in '..\Source\GLXNotification.pas', GLXPrimitives in '..\Source\GLXPrimitives.pas', ! GLXTexture in '..\Source\GLXTexture.pas'; end. --- 45,50 ---- GLXNotification in '..\Source\GLXNotification.pas', GLXPrimitives in '..\Source\GLXPrimitives.pas', ! GLXTexture in '..\Source\GLXTexture.pas', ! fmod in '..\Source\fmod\fmod.pas'; end. Index: GLXtreem_6.res =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Packages/GLXtreem_6.res,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 Binary files /tmp/cvs6J0VX8 and /tmp/cvsW6lOcX differ |
|
From: Markus L?d. <dan...@us...> - 2004-04-01 22:41:22
|
Update of /cvsroot/glxtreem/GLXtreem/Source/Designtime In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27298/Source/Designtime Modified Files: GLXRegister.pas GLXResourceSourceEditor.dfm GLXResourceSourceEditor.pas Added Files: GLXResourceEditor.dfm GLXResourceEditor.pas Log Message: Improved resource handling --- NEW FILE: GLXResourceEditor.dfm --- object GLXResourceEditorForm: TGLXResourceEditorForm Left = 533 Top = 350 BorderIcons = [biSystemMenu, biMinimize] BorderStyle = bsSingle Caption = 'GLXResourceEditorForm' ClientHeight = 136 ClientWidth = 285 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] Icon.Data = { 0000010001001010000001000800680500001600000028000000100000002000 0000010008000000000000000000000000000000000000000000000000000000 0000011FFA00811E0000761E0700111FB8000274AC00FEFEFE003C5CFB008FFE FF00DCE3FE00CED7FE008097FC00491F3F0089FAFF0089FAFE003859FB00092A FA00AABAFC00EAEEFE000C2EFA003557FB007F1E010083F2FE0082F3FE0083F2 FC00CAD4FE002B4DFB00284BFB000120FA007AEBFE00F8FAFE006480FB003F5F FB0070E3FB00BAF4FE00758EFC00A5B6FC00D4F7FA0068DAFB00A7EFFC0074E5 FB00ACF0F4005ED3FA00A1E9FC0069DCFA006ADCFA0069DCFB006ADCFB006ADD FB002FA6CF00A9EEF30057CAF80099E3FB005ED1FA005FD1FA005ED1F8002CA1 CE00A3E9F3004FC4F70092DDFB0054C7F80054C7F70053C7F80053C7F700279D CE009DE3F20048BCF6008CD8FA004BBFF7004ABFF6004ABFF7004BBFF6002398 CC0097E0F2000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000FFFFFF000005 050505050505050505050505000005420543444546464546454748490500053A 053B3C3D3E3D3C3C3C3F4041050005330534353535353536373738390500052A 052B2C2D2E2E2F2E2C3031320500052605272802020202020202022905000521 0500220206060623240602250500051D05050502061E1F012006020505000516 17171802191A011B1C0A0200000005060D0E0E020F1011121314150000000005 06080802090A06060B010C000000000005050502060606060607010000000000 0000000202020202020304010000000000000000000000000000000101010000 0000000000000000000000000001000000000000000000000000000000008003 0000000100000001000000010000000100000001000010010000000100000007 00000007000080070000C0070000F8030000FFF80000FFFE0000FFFF0000} OldCreateOrder = False Position = poOwnerFormCenter DesignSize = ( 285 136) PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel Left = 8 Top = 8 Width = 28 Height = 13 Caption = 'Name' end object Label2: TLabel Left = 8 Top = 32 Width = 58 Height = 13 Caption = 'Compressed' end object Label3: TLabel Left = 8 Top = 56 Width = 73 Height = 13 Caption = 'Cache Strategy' end object Label4: TLabel Left = 8 Top = 80 Width = 57 Height = 13 Caption = 'Cache Time' end object EditName: TEdit Left = 88 Top = 4 Width = 190 Height = 21 Anchors = [akLeft, akTop, akRight] TabOrder = 0 end object Button1: TButton Left = 208 Top = 109 Width = 75 Height = 25 Anchors = [akRight, akBottom] Caption = '&OK' Default = True ModalResult = 1 TabOrder = 4 OnClick = Button1Click end object Button2: TButton Left = 128 Top = 109 Width = 75 Height = 25 Anchors = [akRight, akBottom] Cancel = True Caption = '&Cancel' ModalResult = 2 TabOrder = 5 end object cbCompressed: TCheckBox Left = 88 Top = 32 Width = 17 Height = 17 TabOrder = 1 end object cbCache: TComboBox Left = 88 Top = 52 Width = 190 Height = 21 Style = csDropDownList Anchors = [akLeft, akTop, akRight] ItemHeight = 13 TabOrder = 2 OnChange = cbCacheChange Items.Strings = ( 'Do not cache this resource' 'Keep resource in cache' 'Keep unused resources x seconds in cache') end object seCacheTime: TSpinEdit Left = 88 Top = 76 Width = 190 Height = 22 Anchors = [akLeft, akTop, akRight] Enabled = False MaxValue = 0 MinValue = 0 TabOrder = 3 Value = 0 end end Index: GLXRegister.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/Designtime/GLXRegister.pas,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** GLXRegister.pas 1 Apr 2004 15:44:10 -0000 1.3 --- GLXRegister.pas 1 Apr 2004 22:29:19 -0000 1.4 *************** *** 52,56 **** // TDXDrawDisplayProperty //------------------------------------------------------------------------------ ! Type TGLXDrawDisplayProperty = class(TClassProperty) public function GetAttributes: TPropertyAttributes; override; --- 52,57 ---- // TDXDrawDisplayProperty //------------------------------------------------------------------------------ ! Type ! TGLXDrawDisplayProperty = class(TClassProperty) public function GetAttributes: TPropertyAttributes; override; *************** *** 60,63 **** --- 61,70 ---- end; + TGLXResourceSourceEditor = class(TComponentEditor) + private + fForm : TGLXResourceSourceEditorForm; + public + procedure Edit; override; + end; *************** *** 156,158 **** --- 163,181 ---- + + //------------------------------------------------------------------------------ + // TGLXResourceSourceEditor + //------------------------------------------------------------------------------ + + procedure TGLXResourceSourceEditor.Edit; + var + MyForm : TGLXResourceSourceEditorForm; + begin + MyForm := TGLXResourceSourceEditorForm.Create(nil); + MyForm.ResourceSource := TGLXResourceSource(Component); + MyForm.ShowModal; + MyForm.Free; + end; + + end. Index: GLXResourceSourceEditor.dfm =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/Designtime/GLXResourceSourceEditor.dfm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** GLXResourceSourceEditor.dfm 1 Apr 2004 01:14:21 -0000 1.1 --- GLXResourceSourceEditor.dfm 1 Apr 2004 22:29:19 -0000 1.2 *************** *** 1,7 **** object GLXResourceSourceEditorForm: TGLXResourceSourceEditorForm ! Left = 298 ! Top = 135 ! Width = 676 ! Height = 217 Caption = 'Resource Source' Color = clBtnFace --- 1,7 ---- object GLXResourceSourceEditorForm: TGLXResourceSourceEditorForm ! Left = 475 ! Top = 185 ! Width = 679 ! Height = 225 Caption = 'Resource Source' Color = clBtnFace *************** *** 63,68 **** Left = 0 Top = 22 ! Width = 668 ! Height = 161 Align = alClient Columns = < --- 63,68 ---- Left = 0 Top = 22 ! Width = 671 ! Height = 139 Align = alClient Columns = < *************** *** 104,107 **** --- 104,109 ---- TabOrder = 0 ViewStyle = vsReport + OnColumnClick = ListViewColumnClick + OnCompare = ListViewCompare OnDblClick = ListViewDblClick end *************** *** 109,113 **** Left = 0 Top = 0 ! Width = 668 Height = 22 AutoSize = True --- 111,115 ---- Left = 0 Top = 0 ! Width = 671 Height = 22 AutoSize = True *************** *** 143,146 **** --- 145,238 ---- end end + object Panel1: TPanel + Left = 0 + Top = 161 + Width = 671 + Height = 30 + Align = alBottom + BevelOuter = bvNone + TabOrder = 2 + DesignSize = ( + 671 + 30) + object Image1: TImage + Left = 4 + Top = 4 + Width = 24 + Height = 24 + Cursor = crHandPoint + Picture.Data = { + 07544269746D6170F6060000424DF60600000000000036000000280000001800 + 0000180000000100180000000000C0060000120B0000120B0000000000000000 + 0000FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF797877787776 + 767675FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00 + FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF7B + 7A7981807FC0C0BF9A9A99807F7E73737270706FFF00FFFF00FFFF00FFFF00FF + FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00 + FFFF00FF7D7B7A929191EDEDEDF2F2F2E0E0E0DADADAC1C1C19998987979786D + 6D6C6C6B6AFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF + FF00FFFF00FFFF00FF7F7E7D939392F6F6F6FFFFFFF4F4F4E5E5E5E0E0E0D9D9 + D9D4D4D42380230E690D346A33516950686867676766FF00FFFF00FFFF00FFFF + 00FFFF00FFFF00FFFF00FFFF00FF807F7EACACABF6F6F6FFFFFFFFFFFFF7F7F7 + EAEAEAE5E5E5E0E0E0D9D9D9248124016801016801016801789D789696967574 + 74646463626260FF00FFFF00FFFF00FFFF00FF828180ADACACFFFFFFFFFFFFFF + FFFFFFFFFFFAFAFAEFEFEFEAEAEAE5E5E5DEDEDE258225016801016801016801 + 86AB86BFBFBFBDBDBDB1B1B160605FFF00FFFF00FFFF00FF838382CECECEFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFCFCFCF4F4F4EFEFEFEAEAEAE5E5E526832601 + 680101680101680189AF89C4C4C4BFBFBFBDBDBD60605FFF00FFFF00FF868483 + B7B7B6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFEFEFAFAFAF4F4F4EFEF + EFEAEAEA2786270168010168010168018EB28EC9C9C9C4C4C4BFBFBF60605FFF + 00FFFF00FF868483C0BFBFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FEFEFEFAFAFAF4F4F4EFEFEF28872801680101680101680191B791CECECEC9C9 + C9C4C4C460605FFF00FFFF00FF868483C0BFBFFFFFFFFFFFFFFFFFFFEAF0EAAF + C5AFAFC5AFFFFFFFFEFEFEFEFEFEFAFAFAF4F4F4288828016801016801016801 + 95BB95D4D4D4CECECEC9C9C960605FFF00FFFF00FF868483C0BFBFFFFFFFFFFF + FFAFC5AF114711003A00003A00467446FEFEFEFEFEFEFEFEFEFAFAFA29892901 + 680101680101680198BF98D9D9D9D3D3D3CECECE60605FFF00FFFF00FF868483 + C0BFBFEAF0EA56815600360007660C139020004B00004100467446FEFEFEFEFE + FEFEFEFEFAFAFACEE2CE81BA81509E50ADCAADDEDEDED8D8D8D3D3D360605FFF + 00FFFF00FF868483C0BFBF114711003F00148F232DD44E28CB44139320004B00 + 003F00467446FEFEFEFEFEFEFEFEFEFAFAFAF4F4F4EEEEEEE9E9E9E3E3E3DEDE + DED8D8D860605F003500FF00FF868483003500075F0C2BC44A33DC582DD44E28 + CB4423C43B108F1C004B00003A00467446FEFEFEFEFEFEFEFEFEFAFAFAF3F3F3 + EEEEEEE9E9E9E3E3E387A187063A06004100FF00FF003A001B992F3FED6C39E5 + 6333DC582DD44E28CB4423C43B1DBC330D8A17004B00003A00467446FEFEFEFE + FEFEFEFEFEFAFAFAF3F3F3EEEEEE4E784E003500004600FF00FFFF00FF056409 + 45F6773FED6C39E56333DC582DD44E28CB4423C43B1DBC3318B42A0B8612004B + 00003A00467446FEFEFEFEFEFEFEFEFED0DCD01C4E1C003600004900FF00FFFF + 00FFFF00FF05640934D1593FED6C39E56333DC582DD44E28CB4423C43B1DBC33 + 18B42A13AC2209810F004B00003A00467446FEFEFE9AB59A073A07003A00004B + 00FF00FFFF00FFFF00FFFF00FFFF00FF0564092FCB5139E56333DC582DD44E28 + CB4423C43B1DBC3318B42A13AC220FA41A067D0A004B00003A001C501C003000 + 004100004B00FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF05640934D9 + 5A33DC582DD44E28CB4423C43B1DBC3318B42A19B52C0DA1180B9D1304780700 + 4B00003C00004200004B00FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF + FF00FFFF00FF086A0D2ED1502DD44E28CB4423C43B1DBC332CD14B34DD590187 + 0309991007960D027404004B00004B00FF00FFFF00FFFF00FFFF00FFFF00FFFF + 00FFFF00FFFF00FFFF00FFFF00FFFF00FF07690C29CA4728CB4423C43B1DBC33 + 2DD34D34DD59008100008300058209005601FF00FFFF00FFFF00FFFF00FFFF00 + FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF05640924 + C23F23C43B1DBC332DD34D34DD59008100008100056409FF00FFFF00FFFF00FF + FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00 + FFFF00FFFF00FF0462071FBB351BB42E0564090F6919014F02016402056409FF + 00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF + FF00FFFF00FFFF00FFFF00FFFF00FFFF00FF056409056409FF00FF0048000042 + 00004A01FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF + 00FF} + Transparent = True + OnClick = Image1Click + end + object Button1: TButton + Left = 598 + Top = 4 + Width = 64 + Height = 25 + Anchors = [akTop, akRight] + Caption = '&OK' + Default = True + ModalResult = 1 + TabOrder = 0 + end + end object ActionList: TActionList Images = ActionImagesH *************** *** 162,165 **** --- 254,258 ---- object actOpen: TAction Caption = '&Open' + Hint = 'Opens the editor for the selection resource, if one exists' ImageIndex = 2 OnExecute = actOpenExecute *************** *** 168,171 **** --- 261,265 ---- object actProperties: TAction Caption = '&Properties' + Hint = 'Opens the property editor for the selected resource' ImageIndex = 3 OnExecute = actPropertiesExecute Index: GLXResourceSourceEditor.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/Designtime/GLXResourceSourceEditor.pas,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** GLXResourceSourceEditor.pas 1 Apr 2004 17:51:13 -0000 1.2 --- GLXResourceSourceEditor.pas 1 Apr 2004 22:29:19 -0000 1.3 *************** *** 5,10 **** uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ! ActnList, ToolWin, ComCtrls, Menus, ImgList, DesignEditors, StdCtrls, ! GLXResource; type --- 5,10 ---- uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ! ActnList, ToolWin, ComCtrls, Menus, ImgList, StdCtrls, ! GLXResource,GLXResourceEditor, ExtCtrls,registry,ShellAPI; type *************** *** 30,33 **** --- 30,36 ---- Properties1: TMenuItem; Delete1: TMenuItem; + Panel1: TPanel; + Button1: TButton; + Image1: TImage; procedure FormShow(Sender: TObject); procedure actDeleteExecute(Sender: TObject); *************** *** 37,42 **** procedure actOpenExecute(Sender: TObject); procedure ListViewDblClick(Sender: TObject); private ! fSource : TGLXResourceSource; procedure AddResource(Sender:TObject); public --- 40,50 ---- procedure actOpenExecute(Sender: TObject); procedure ListViewDblClick(Sender: TObject); + procedure Image1Click(Sender: TObject); + procedure ListViewColumnClick(Sender: TObject; Column: TListColumn); + procedure ListViewCompare(Sender: TObject; Item1, Item2: TListItem; + Data: Integer; var Compare: Integer); private ! fSource : TGLXResourceSource; ! fColumnToSort : Integer; procedure AddResource(Sender:TObject); public *************** *** 45,55 **** end; - TGLXResourceSourceEditor = class(TComponentEditor) - private - fForm : TGLXResourceSourceEditorForm; - public - procedure Edit; override; - end; - implementation --- 53,56 ---- *************** *** 57,60 **** --- 58,85 ---- {$R *.DFM} + procedure OpenURL(Url: string); + var + ts: string; + begin + with TRegistry.Create do + try + rootkey := HKEY_CLASSES_ROOT; + OpenKey('\htmlfile\shell\open\command', False); + try + ts := ReadString(''); + except + ts := ''; + end; + CloseKey; + finally + Free; + end; + if ts = '' then Exit; + // remove quotes and commandline parameters + ts := Copy(ts, Pos('"', ts) + 1, Length(ts)); + ts := Copy(ts, 1, Pos('"', ts) - 1); + ShellExecute(0, 'open', PChar(ts), PChar(url), nil, SW_SHOW); + end; + procedure TGLXResourceSourceEditorForm.UpdateList; var *************** *** 205,210 **** procedure TGLXResourceSourceEditorForm.actPropertiesExecute(Sender:TObject); begin ! ; end; --- 230,249 ---- procedure TGLXResourceSourceEditorForm.actPropertiesExecute(Sender:TObject); + var + Resource : TGLXResource; + MyForm : TGLXResourceEditorForm; begin ! Resource:=fSource.Load(ListView.Selected.Caption); ! try ! MyForm := TGLXResourceEditorForm.Create(Self); ! MyForm.Resource := Resource; ! if MyForm.ShowModal=mrOK then begin ! fSource.Save(Resource); ! UpdateList; ! end; ! finally ! Resource.Free; ! MyForm.Free; ! end; end; *************** *** 215,230 **** - //------------------------------------------------------------------------------ - // TGLXResourceSourceEditor - //------------------------------------------------------------------------------ ! procedure TGLXResourceSourceEditor.Edit; var ! MyForm : TGLXResourceSourceEditorForm; begin ! MyForm := TGLXResourceSourceEditorForm.Create(nil); ! MyForm.ResourceSource := TGLXResourceSource(Component); ! MyForm.ShowModal; ! MyForm.Free; end; --- 254,279 ---- ! procedure TGLXResourceSourceEditorForm.Image1Click(Sender: TObject); ! begin ! OpenURL('glxtreem.sourceforge.net'); ! end; ! ! procedure TGLXResourceSourceEditorForm.ListViewColumnClick(Sender:TObject; Column:TListColumn); ! begin ! fColumnToSort := Column.Index; ! (Sender as TCustomListView).AlphaSort; ! end; ! ! procedure TGLXResourceSourceEditorForm.ListViewCompare(Sender:TObject; Item1,Item2:TListItem; Data:Integer; var Compare:Integer); var ! ix: Integer; begin ! if fColumnToSort = 0 then ! Compare := CompareText(Item1.Caption,Item2.Caption) ! else begin ! ix := fColumnToSort - 1; ! Compare := CompareText(Item1.SubItems[ix],Item2.SubItems[ix]); ! end; end; --- NEW FILE: GLXResourceEditor.pas --- unit GLXResourceEditor; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Spin, StdCtrls,GLXResource; type TGLXResourceEditorForm = class(TForm) Label1: TLabel; EditName: TEdit; Button1: TButton; Button2: TButton; cbCompressed: TCheckBox; Label2: TLabel; cbCache: TComboBox; Label3: TLabel; Label4: TLabel; seCacheTime: TSpinEdit; procedure Button1Click(Sender: TObject); procedure cbCacheChange(Sender: TObject); private fResource : TGLXResource; procedure SetResource(AResource:TGLXResource); public property Resource : TGLXResource read fResource write SetResource; end; implementation {$R *.DFM} procedure TGLXResourceEditorForm.SetResource(AResource:TGLXResource); begin fResource := AResource; if Assigned(fResource) then begin EditName.Text := fResource.Ident; cbCompressed.Checked := fResource.Compress; cbCache.ItemIndex := Integer(fResource.CacheOption); seCacheTime.Value := Round(fResource.Cachetime); end; cbCacheChange(Self); end; procedure TGLXResourceEditorForm.Button1Click(Sender: TObject); begin if Assigned(fResource) then begin fResource.Ident := EditName.Text; fResource.Compress := cbCompressed.Checked; fResource.CacheOption := TGLXCacheOption(cbCache.ItemIndex); fResource.Cachetime := seCacheTime.Value; end; end; procedure TGLXResourceEditorForm.cbCacheChange(Sender: TObject); begin seCacheTime.Enabled:=cbCache.ItemIndex=2; end; end. |
|
From: Markus L?d. <dan...@us...> - 2004-04-01 22:38:00
|
Update of /cvsroot/glxtreem/GLXtreem/Source In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26706/Source Modified Files: GLXResource.pas Log Message: Removed dirty check Index: GLXResource.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/GLXResource.pas,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** GLXResource.pas 1 Apr 2004 15:44:11 -0000 1.2 --- GLXResource.pas 1 Apr 2004 22:25:58 -0000 1.3 *************** *** 28,32 **** interface uses ! Classes, Controls, SysUtils, Contnrs, ZLib, HashTables; type --- 28,32 ---- interface uses ! Classes, Controls, SysUtils, Contnrs, ZLib, HashTables,Forms; type *************** *** 225,232 **** TGLXResourceFileSource = class(TGLXResourceSource) private ! fFilename : String; protected ! procedure SetFilename(Filename:String); public --- 225,232 ---- TGLXResourceFileSource = class(TGLXResourceSource) private ! fFilename : TFilename; protected ! procedure SetFilename(Filename:TFilename); public *************** *** 243,247 **** published ! property Filename : String read fFilename write SetFilename; end; --- 243,247 ---- published ! property Filename : TFilename read fFilename write SetFilename; end; *************** *** 751,757 **** //Only save if the resource is new or dirty ! if (Assigned(Inv) and (Resource.Dirty)) or ! (not Assigned(Inv)) then ! begin MStream := TMemoryStream.Create; MStream2 := TMemoryStream.Create; --- 751,757 ---- //Only save if the resource is new or dirty ! // if (Assigned(Inv) and (Resource.Dirty)) or ! // (not Assigned(Inv)) then ! // begin MStream := TMemoryStream.Create; MStream2 := TMemoryStream.Create; *************** *** 799,803 **** MStream2.Free; MStream.Free; ! end; end; end; --- 799,803 ---- MStream2.Free; MStream.Free; ! // end; end; end; *************** *** 860,864 **** //------------------------------------------------------------------------------ ! procedure TGLXResourceFileSource.SetFilename(Filename:String); begin fFilename:=Filename; --- 860,864 ---- //------------------------------------------------------------------------------ ! procedure TGLXResourceFileSource.SetFilename(Filename:TFilename); begin fFilename:=Filename; *************** *** 886,891 **** begin result:=false; ! if FileExists(fFilename) then begin ! FStream := TFileStream.Create(fFilename,fmOpenRead or fmShareDenyWrite); try FStream.Seek(-2*SizeOf(Integer),soFromEnd); --- 886,891 ---- begin result:=false; ! if FileExists(ExtractFilepath(Application.Exename)+fFilename) then begin ! FStream := TFileStream.Create(ExtractFilepath(Application.Exename)+fFilename,fmOpenRead or fmShareDenyWrite); try FStream.Seek(-2*SizeOf(Integer),soFromEnd); *************** *** 908,913 **** Size : Integer; begin ! if FileExists(fFilename) then begin ! FStream := TFileStream.Create(fFilename,fmOpenReadWrite or fmShareDenyRead); try FStream.Seek(0,soFromEnd); --- 908,913 ---- Size : Integer; begin ! if FileExists(ExtractFilepath(Application.Exename)+fFilename) then begin ! FStream := TFileStream.Create(ExtractFilepath(Application.Exename)+fFilename,fmOpenReadWrite or fmShareDenyRead); try FStream.Seek(0,soFromEnd); *************** *** 919,923 **** FStream.Free; end; ! end else raise Exception.CreateFmt(NOFILE,[fFilename]); end; --- 919,923 ---- FStream.Free; end; ! end else raise Exception.CreateFmt(NOFILE,[ExtractFilepath(Application.Exename)+fFilename]); end; *************** *** 927,934 **** Inv : TGLXInventory; begin ! if FileExists(fFilename) then begin Inv := GetInv(Ident); if Assigned(Inv) then begin ! FStream := TFileStream.Create(fFilename,fmOpenRead or fmShareDenyWrite); try FStream.Position := Inv.Offset; --- 927,934 ---- Inv : TGLXInventory; begin ! if FileExists(ExtractFilepath(Application.Exename)+fFilename) then begin Inv := GetInv(Ident); if Assigned(Inv) then begin ! FStream := TFileStream.Create(ExtractFilepath(Application.Exename)+fFilename,fmOpenRead or fmShareDenyWrite); try FStream.Position := Inv.Offset; *************** *** 952,957 **** try //Copy all resources into memory ! if FileExists(fFilename) then begin ! FStream := TFileStream.Create(fFilename,fmOpenRead or fmShareDenyWrite); try for i:=0 to GetInvCount-1 do begin --- 952,957 ---- try //Copy all resources into memory ! if FileExists(ExtractFilepath(Application.Exename)+fFilename) then begin ! FStream := TFileStream.Create(ExtractFilepath(Application.Exename)+fFilename,fmOpenRead or fmShareDenyWrite); try for i:=0 to GetInvCount-1 do begin *************** *** 969,973 **** //Write all resources back to the file MStream.Position := 0; ! FStream := TFileStream.Create(fFilename,fmCreate or fmShareDenyRead); try for i:=0 to GetInvCount-1 do begin --- 969,973 ---- //Write all resources back to the file MStream.Position := 0; ! FStream := TFileStream.Create(ExtractFilepath(Application.Exename)+fFilename,fmCreate or fmShareDenyRead); try for i:=0 to GetInvCount-1 do begin *************** *** 999,1007 **** i : Integer; begin ! if FileExists(fFilename) then begin MStream := TMemoryStream.Create; try //Copy all resources into memory ! FStream := TFileStream.Create(fFilename,fmOpenRead or fmShareDenyWrite); try for i:=0 to GetInvCount-1 do begin --- 999,1007 ---- i : Integer; begin ! if FileExists(ExtractFilepath(Application.Exename)+fFilename) then begin MStream := TMemoryStream.Create; try //Copy all resources into memory ! FStream := TFileStream.Create(ExtractFilepath(Application.Exename)+fFilename,fmOpenRead or fmShareDenyWrite); try for i:=0 to GetInvCount-1 do begin *************** *** 1018,1022 **** //Write all resources back to the file MStream.Position := 0; ! FStream := TFileStream.Create(fFilename,fmCreate or fmShareDenyRead); try for i:=0 to GetInvCount-1 do begin --- 1018,1022 ---- //Write all resources back to the file MStream.Position := 0; ! FStream := TFileStream.Create(ExtractFilepath(Application.Exename)+fFilename,fmCreate or fmShareDenyRead); try for i:=0 to GetInvCount-1 do begin |
|
From: Andreas L. <an...@us...> - 2004-04-01 18:03:15
|
Update of /cvsroot/glxtreem/GLXtreem/Source In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3770/Source Modified Files: GLXTexture.pas Log Message: texture in the resource editor Index: GLXTexture.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/GLXTexture.pas,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** GLXTexture.pas 28 Mar 2004 20:06:25 -0000 1.3 --- GLXTexture.pas 1 Apr 2004 17:51:13 -0000 1.4 *************** *** 29,37 **** Uses ! Classes, Types, Windows, SysUtils, Graphics, Jpeg, dglOpenGL, GraphicEx, ! GLXNotification, GLXClasses; --- 29,39 ---- Uses ! Classes, Types, Windows, SysUtils, Graphics, Jpeg, Controls, dglOpenGL, GraphicEx, ! GLXNotification, GLXClasses, ! ! GLXResource; *************** *** 298,301 **** --- 300,326 ---- + //------------------------------------------------------------------------------ + {@Exclude} + Type TGLXTextureResource = class(TGLXResource, IEditor) + private + FTexture: TGLXTexture; + public + {@exclude} + constructor Create; override; + {@exclude} + destructor Destroy; override; + + { Loads the resource from a stream. } + procedure LoadFromStream(Stream:TStream); override; + { Saves the resource to a stream. } + procedure SaveToStream(Stream:TStream); override; + + { Edits the contents of the resource } + Function Edit : Boolean; + { Returns the real resource } + Function getResource: TObject; + end; + + //------------------------------------------------------------------------------ *************** *** 329,332 **** --- 354,358 ---- implementation + Uses GLXTextureEditor; //------------------------------------------------------------------------------ *************** *** 528,531 **** --- 554,559 ---- var Bitmap: TBitmap; begin + IF not Assigned(glDeleteTextures) then Exit; + Delete; *************** *** 923,926 **** --- 951,955 ---- Stream.Write(FTransparentColor, SizeOf(FTransparentColor)); + Stream.Write(MemSize, SizeOf(MemSize)); Stream.CopyFrom(MemStream, MemSize); *************** *** 1105,1107 **** --- 1134,1202 ---- + + + + + + + + + // TGLXTextureResource + //============================================================================== + constructor TGLXTextureResource.Create; + begin + inherited; + FTexture:=TGLXTexture.Create; + end; + + //------------------------------------------------------------------------------ + destructor TGLXTextureResource.Destroy; + begin + FTexture.Free; + inherited; + end; + + //------------------------------------------------------------------------------ + function TGLXTextureResource.Edit: Boolean; + var theForm : TTGLXTextureEditorForm; + begin + theForm:=TTGLXTextureEditorForm.Create(nil); + theForm.Texture:=FTexture; + + Result:= theForm.ShowModal = mrOK; + + theForm.Free; + end; + + //------------------------------------------------------------------------------ + function TGLXTextureResource.getResource: TObject; + begin + Result:=FTexture; + end; + + //------------------------------------------------------------------------------ + procedure TGLXTextureResource.LoadFromStream(Stream: TStream); + begin + inherited; + FTexture.LoadFromStream(Stream); + end; + + //------------------------------------------------------------------------------ + procedure TGLXTextureResource.SaveToStream(Stream: TStream); + begin + inherited; + FTexture.SaveToStream(Stream); + end; + + + + //------------------------------------------------------------------------------ + initialization + //Register + RegisterResourceClass(TGLXTextureResource); + // RegisterResourceClass(TGLXTextureResource, 'TGLXTexture'); + + finalization + //Unregister + UnRegisterResourceClass(TGLXTextureResource); end. |
|
From: Andreas L. <an...@us...> - 2004-04-01 18:03:15
|
Update of /cvsroot/glxtreem/GLXtreem/Source/Designtime In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3770/Source/Designtime Modified Files: GLXResourceSourceEditor.pas Added Files: GLXTextureEditor.dfm GLXTextureEditor.pas Log Message: texture in the resource editor Index: GLXResourceSourceEditor.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/Designtime/GLXResourceSourceEditor.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** GLXResourceSourceEditor.pas 1 Apr 2004 01:14:21 -0000 1.1 --- GLXResourceSourceEditor.pas 1 Apr 2004 17:51:13 -0000 1.2 *************** *** 192,195 **** --- 192,196 ---- try ResEdit:=Resource as IEditor; + if ResEdit.Edit then begin fSource.Save(Resource); --- NEW FILE: GLXTextureEditor.pas --- unit GLXTextureEditor; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, GLXTexture, StdCtrls, ExtCtrls, ExtDlgs; type TTGLXTextureEditorForm = class(TForm) InfoLabel: TLabel; Load: TButton; OpenPictureDialog1: TOpenPictureDialog; Button1: TButton; Bevel1: TBevel; Panel1: TPanel; Shape: TShape; ViewBox: TImage; NoneLabel: TLabel; Bevel2: TBevel; Button2: TButton; Button3: TButton; procedure LoadClick(Sender: TObject); procedure UpdatePreview(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure Button1Click(Sender: TObject); procedure OKButtonClick(Sender: TObject); procedure CancelButtonClick(Sender: TObject); private { Private declarations } FTexture: TGLXTexture; FPreview: TBitmap; procedure SetTexture(const Value: TGLXTexture); public { Public declarations } Property Texture: TGLXTexture write SetTexture; end; var Form: TTGLXTextureEditorForm; implementation {$R *.dfm} //------------------------------------------------------------------------------ procedure TTGLXTextureEditorForm.FormCreate(Sender: TObject); begin FPreview:= TBitmap.Create; end; //------------------------------------------------------------------------------ procedure TTGLXTextureEditorForm.FormDestroy(Sender: TObject); begin FPreview.Free; end; //------------------------------------------------------------------------------ procedure TTGLXTextureEditorForm.SetTexture(const Value: TGLXTexture); begin FTexture:=Value; UpdatePreview(nil); end; //------------------------------------------------------------------------------ procedure TTGLXTextureEditorForm.LoadClick(Sender: TObject); begin IF OpenPictureDialog1.Execute then begin FTexture.LoadTexture(OpenPictureDialog1.FileName); end; UpdatePreview(nil); end; //------------------------------------------------------------------------------ procedure TTGLXTextureEditorForm.Button1Click(Sender: TObject); begin Case FTexture.Format of gtNone : ; gtBitmap: begin FTexture.Bitmap.Width:=0; FTexture.Bitmap.Height:=0; end; gtJpeg : begin FTexture.Jpeg .Width:=0; FTexture.Jpeg .Height:=0; end; gtTarga : begin FTexture.Targa .Width:=0; FTexture.Targa .Height:=0; end; gtPng : begin FTexture.Png .Width:=0; FTexture.Png .Height:=0; end; end; FTexture.Format:=gtNone; UpdatePreview(nil); end; //------------------------------------------------------------------------------ procedure TTGLXTextureEditorForm.UpdatePreview(Sender: TObject); begin Case FTexture.Format of gtNone : ViewBox.Picture.Graphic := nil; gtBitmap: ViewBox.Picture.Assign( FTexture.Bitmap ); gtJpeg : ViewBox.Picture.Assign( FTexture.Jpeg ); gtTarga : ViewBox.Picture.Assign( FTexture.Targa ); gtPng : ViewBox.Picture.Assign( FTexture.Png ); end; Case FTexture.Format of gtNone : InfoLabel.Caption:='No image'#13; gtBitmap: InfoLabel.Caption:='Image: bmp'#13; gtJpeg : InfoLabel.Caption:='Image: jpg'#13; gtTarga : InfoLabel.Caption:='Image: tga'#13; gtPng : InfoLabel.Caption:='Image: png'#13; end; NoneLabel.Visible:= FTexture.Format = gtNone; InfoLabel.Visible:= FTexture.Format <> gtNone; InfoLabel.Caption:=InfoLabel.Caption + Format('Width: %d'#13'Height: %d', [FTexture.Width, FTexture.Height]); end; //------------------------------------------------------------------------------ procedure TTGLXTextureEditorForm.OKButtonClick(Sender: TObject); begin ModalResult:=mrOK; end; //------------------------------------------------------------------------------ procedure TTGLXTextureEditorForm.CancelButtonClick(Sender: TObject); begin ModalResult:=mrCancel; end; end. --- NEW FILE: GLXTextureEditor.dfm --- object TGLXTextureEditorForm: TTGLXTextureEditorForm Left = 573 Top = 352 BorderStyle = bsToolWindow Caption = 'TGLXTextureEditorForm' ClientHeight = 306 ClientWidth = 356 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False OnCreate = FormCreate OnDestroy = FormDestroy PixelsPerInch = 96 TextHeight = 13 object Bevel2: TBevel Left = 272 Top = 72 Width = 73 Height = 81 end object InfoLabel: TLabel Left = 280 Top = 80 Width = 44 Height = 13 Caption = 'InfoLabel' end object Bevel1: TBevel Left = 8 Top = 8 Width = 257 Height = 289 Shape = bsFrame end object Load: TButton Left = 24 Top = 264 Width = 75 Height = 25 Caption = '&Load...' TabOrder = 0 OnClick = LoadClick end object Button1: TButton Left = 104 Top = 264 Width = 75 Height = 25 Caption = '&Clear' TabOrder = 1 OnClick = Button1Click end object Panel1: TPanel Left = 16 Top = 16 Width = 241 Height = 241 BevelOuter = bvNone BorderStyle = bsSingle Color = clWhite TabOrder = 2 object Shape: TShape Left = -10 Top = -10 Width = 251 Height = 251 Brush.Color = clBlack Brush.Style = bsDiagCross end object ViewBox: TImage Left = 6 Top = 6 Width = 228 Height = 228 Center = True Stretch = True end object NoneLabel: TLabel Left = 102 Top = 112 Width = 32 Height = 13 Alignment = taCenter Caption = '(None)' end end object Button2: TButton Left = 272 Top = 8 Width = 75 Height = 25 Caption = 'Ok' Default = True TabOrder = 3 OnClick = OKButtonClick end object Button3: TButton Left = 272 Top = 40 Width = 75 Height = 25 Cancel = True Caption = 'Cancel' TabOrder = 4 OnClick = OKButtonClick end object OpenPictureDialog1: TOpenPictureDialog Filter = 'All (*.bmp, *.tga, *.jpg)|*.bmp;*.tga;*.jpg|Windows Bitmap (*.bm' + 'p)|*.bmp|Truevision Targa (*.tga)|*.tga|JPEG Image File (*.jpg)|' + '*.jpg' Options = [ofHideReadOnly, ofAllowMultiSelect, ofEnableSizing] Left = 34 Top = 39 end end |
|
From: Andreas L. <an...@us...> - 2004-04-01 15:56:11
|
Update of /cvsroot/glxtreem/GLXtreem/Source In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10957/Source Modified Files: GLXResource.pas GLXTerrain.pas Log Message: Was a bug in glxRegister... TGLXResourceSource is now abstract Index: GLXTerrain.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/GLXTerrain.pas,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** GLXTerrain.pas 29 Mar 2004 14:55:09 -0000 1.2 --- GLXTerrain.pas 1 Apr 2004 15:44:11 -0000 1.3 *************** *** 195,199 **** // TNodeLoader //============================================================================== ! type TGLXNodeLoader = class(TThread) private { Private declarations } --- 195,199 ---- // TNodeLoader //============================================================================== ! type TGLXTerrainNodeLoader = class(TThread) private { Private declarations } *************** *** 268,272 **** ! var NodeLoader: TGLXNodeLoader; implementation --- 268,272 ---- ! var NodeLoader: TGLXTerrainNodeLoader; implementation *************** *** 420,424 **** //Thread TGLXNodeLoader //============================================================================== ! constructor TGLXNodeLoader.Create; begin inherited Create(False); --- 420,424 ---- //Thread TGLXNodeLoader //============================================================================== ! constructor TGLXTerrainNodeLoader.Create; begin inherited Create(False); *************** *** 430,434 **** //------------------------------------------------------------------------------ ! destructor TGLXNodeLoader.Destroy; begin LoadList.Free; --- 430,434 ---- //------------------------------------------------------------------------------ ! destructor TGLXTerrainNodeLoader.Destroy; begin LoadList.Free; *************** *** 438,442 **** //------------------------------------------------------------------------------ ! procedure TGLXNodeLoader.Execute; begin repeat --- 438,442 ---- //------------------------------------------------------------------------------ ! procedure TGLXTerrainNodeLoader.Execute; begin repeat *************** *** 455,459 **** //------------------------------------------------------------------------------ ! procedure TGLXNodeLoader.LoadNode; var Stream : TFileStream; begin --- 455,459 ---- //------------------------------------------------------------------------------ ! procedure TGLXTerrainNodeLoader.LoadNode; var Stream : TFileStream; begin *************** *** 487,512 **** // Assign the node Synchronize(AssignNode); - - { - - Exit; - Stream.Read(FVertexData.numVertices , SizeOf(FVertexData.numVertices)); - Stream.Read(FVertexData.numNormals , SizeOf(FVertexData.numNormals )); - Stream.Read(FVertexData.numTexCoordsA, SizeOf(FVertexData.numTexCoordsA)); - Stream.Read(FVertexData.numTexCoordsB, SizeOf(FVertexData.numTexCoordsB)); - - SetLength(FVertexData.theVertices , FVertexData.numVertices ); - SetLength(FVertexData.theNormals , FVertexData.numNormals ); - SetLength(FVertexData.theTexCoordsA, FVertexData.numTexCoordsA); - SetLength(FVertexData.theTexCoordsB, FVertexData.numTexCoordsB); - - Stream.Read(FVertexData.theVertices [0], SizeOf(FVertexData.theVertices [0]) * FVertexData.numVertices); - Stream.Read(FVertexData.theNormals [0], SizeOf(FVertexData.theNormals [0]) * FVertexData.numNormals); - Stream.Read(FVertexData.theTexCoordsA[0], SizeOf(FVertexData.theTexCoordsA[0]) * FVertexData.numTexCoordsA); - Stream.Read(FVertexData.theTexCoordsB[0], SizeOf(FVertexData.theTexCoordsB[0]) * FVertexData.numTexCoordsB); - - Stream.Free; - - Self.Synchronize(AssignNode); } end; --- 487,490 ---- *************** *** 515,519 **** //------------------------------------------------------------------------------ ! procedure TGLXNodeLoader.BuildVertexData(Width, Height: Integer); var SwitchSides: Boolean; var X, Y : Integer; --- 493,497 ---- //------------------------------------------------------------------------------ ! procedure TGLXTerrainNodeLoader.BuildVertexData(Width, Height: Integer); var SwitchSides: Boolean; var X, Y : Integer; *************** *** 602,606 **** //------------------------------------------------------------------------------ ! procedure TGLXNodeLoader.AssignNode; begin CurrentNode.FTexture :=CreateTexture(TextureWidth, TextureHeight, GL_RGB, Addr(TextureData[0])); --- 580,584 ---- //------------------------------------------------------------------------------ ! procedure TGLXTerrainNodeLoader.AssignNode; begin CurrentNode.FTexture :=CreateTexture(TextureWidth, TextureHeight, GL_RGB, Addr(TextureData[0])); *************** *** 907,911 **** //------------------------------------------------------------------------------ initialization ! NodeLoader:=TGLXNodeLoader.Create; finalization NodeLoader.Terminate; --- 885,889 ---- //------------------------------------------------------------------------------ initialization ! NodeLoader:=TGLXTerrainNodeLoader.Create; finalization NodeLoader.Terminate; Index: GLXResource.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/GLXResource.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** GLXResource.pas 1 Apr 2004 01:10:58 -0000 1.1 --- GLXResource.pas 1 Apr 2004 15:44:11 -0000 1.2 *************** *** 185,193 **** procedure LoadInventory; ! function LoadResourceTable(Stream:TStream):Boolean; virtual; ! procedure SaveResourceTable(Stream:TStream); virtual; ! procedure LoadResource(Ident:String; Stream:TStream); virtual; ! procedure SaveResource(Ident:String; Stream:TStream; Size:Integer); virtual; ! procedure DeleteResource(Ident:String); virtual; public --- 185,193 ---- procedure LoadInventory; ! function LoadResourceTable(Stream:TStream):Boolean; virtual; abstract; ! procedure SaveResourceTable(Stream:TStream); virtual; abstract; ! procedure LoadResource(Ident:String; Stream:TStream); virtual;abstract; ! procedure SaveResource(Ident:String; Stream:TStream; Size:Integer); virtual; abstract; ! procedure DeleteResource(Ident:String); virtual; abstract; public *************** *** 639,643 **** end; end; ! function TGLXResourceSource.LoadResourceTable(Stream:TStream):Boolean; begin --- 639,643 ---- end; end; ! { function TGLXResourceSource.LoadResourceTable(Stream:TStream):Boolean; begin *************** *** 664,668 **** raise Exception.CreateFmt(NOTOVERWRITTEN,['DeleteResource',ClassName]); end; ! //------------------------------------------------------------------------------ --- 664,668 ---- raise Exception.CreateFmt(NOTOVERWRITTEN,['DeleteResource',ClassName]); end; ! } //------------------------------------------------------------------------------ |
|
From: Andreas L. <an...@us...> - 2004-04-01 15:56:10
|
Update of /cvsroot/glxtreem/GLXtreem/Source/Designtime In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10957/Source/Designtime Modified Files: GLXRegister.pas Log Message: Was a bug in glxRegister... TGLXResourceSource is now abstract Index: GLXRegister.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/Designtime/GLXRegister.pas,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** GLXRegister.pas 1 Apr 2004 01:15:07 -0000 1.2 --- GLXRegister.pas 1 Apr 2004 15:44:10 -0000 1.3 *************** *** 33,38 **** GLXTimer, GLXCamera, GLXScreens, ! GLXResource,GLXResourceSourceEditor; --- 33,47 ---- GLXTimer, GLXCamera, + GLXImageList, + GLXFont, + GLXParticleEngine, + GLXMilkshape3D, + + + GLXTexture, GLXScreens, ! ! GLXResource, ! GLXResourceSourceEditor; *************** *** 61,65 **** procedure Register; begin - RegisterPropertyEditor(TypeInfo(TGLXDrawDisplay ), nil, '', TGLXDrawDisplayProperty); RegisterComponentEditor(TGLXResourceSource,TGLXResourceSourceEditor); --- 70,73 ---- *************** *** 69,76 **** TGLXDraw, TGLXTimer, ! TGLXCamera//, // TGLXCameraPath ] ); end; --- 77,95 ---- TGLXDraw, TGLXTimer, ! TGLXCamera, ! TGLXCameraPath, ! TGLXImageList, ! TGLXFont, ! TGLXParticles, ! TGLXMilkshape3D ! //, // TGLXCameraPath ] ); + + RegisterPropertyEditor (TypeInfo(TGLXDrawDisplay ), nil, '', TGLXDrawDisplayProperty); + + + end; |
|
From: Markus L?d. <dan...@us...> - 2004-04-01 01:27:08
|
Update of /cvsroot/glxtreem/GLXtreem/Source/Designtime In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16362/Source/Designtime Modified Files: GLXRegister.pas Log Message: Added Resource Stuff Index: GLXRegister.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/Designtime/GLXRegister.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** GLXRegister.pas 10 Mar 2004 16:57:31 -0000 1.1 --- GLXRegister.pas 1 Apr 2004 01:15:07 -0000 1.2 *************** *** 33,38 **** GLXTimer, GLXCamera, ! GLXScreens ! ; --- 33,38 ---- GLXTimer, GLXCamera, ! GLXScreens, ! GLXResource,GLXResourceSourceEditor; *************** *** 63,67 **** --- 63,70 ---- RegisterPropertyEditor(TypeInfo(TGLXDrawDisplay ), nil, '', TGLXDrawDisplayProperty); + RegisterComponentEditor(TGLXResourceSource,TGLXResourceSourceEditor); + RegisterComponents('GLXTreem', [ + TGLXResourceFileSource, TGLXDraw, TGLXTimer, |
|
From: Markus L?d. <dan...@us...> - 2004-04-01 01:26:16
|
Update of /cvsroot/glxtreem/GLXtreem/Source/Designtime In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16071/Source/Designtime Added Files: GLXResourceSourceEditor.dfm GLXResourceSourceEditor.pas GLXStringListEditor.dfm GLXStringListEditor.pas Log Message: Initial Commit --- NEW FILE: GLXStringListEditor.dfm --- object GLXStringListEditorForm: TGLXStringListEditorForm Left = 361 Top = 157 Width = 381 Height = 249 Caption = 'GLXStringListEditorForm' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] Icon.Data = { 0000010001001010000001000800680500001600000028000000100000002000 0000010008000000000000000000000000000000000000000000000000000000 0000A77E7000A9807300A4786E0098686500BA958700EAD7A400EAD59E00E0C0 9700A5776C00A1746B00E1D4D300FFFEEE00F7CC8C00F0B47300F7C78800FCE3 A500C2A08800CEB29300FFFEDD00F4D1A500EEBA7B00F2C78F00F8E1AB00FCF0 BA00FCFACA00A3776F00AA7F7300FAE0A400F0B77800F6DDA600FEFBCC00FFFF D300FFFFD100FFFFD700D9C5A700A3756C00B18A7800FFDE9900E9A16700F4D1 9900FEFCCC00FFFFD500FFFFDA00FFFFDC00EFE6C500A97E7500B0897800FEDA 9700EDB47800FBEEBB00FFFFF400FFFFE200E9DDBC00A67B7300FAD19200FEF4 C200FFFFD000FFFFF600FFFFFC00B6938400C0917D00FCE9AC00FFFFCC00FFFF CF00FFFFDE00FFFFFA00E3D3D100996965003BABFF00A1CAE700AD867900A983 7300E0CFB100FFFFDD00FCF8CF00CCB29F0038A5FE00329DFF00156DCE00444F 5B009C6B6500AF887B00AF887E00AA80750037A4FE00359EFF000F6FDE003560 8B00A67B7F00379FFF000E6DDE00355F8900BB7F790032A0FE0037A1FF00106F E200325F8B00B67D79005084B2000F6FE100325F8C00B87E7A00314B6200AC7D 7E00000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000FFFFFF000067 6800000000000000000000000000636465660000000000000000000000005E5F 606162000000000000000000000000555A5B5C5D000000000000000000000000 55565758590000000000000000000000004D4E4F500051525354000000000000 000045464748492B4A4B4C0A00000000000000003D3E3F403941424344000000 000000002F3738392B3A3B3B3C0000000000002F303132202C33333435360000 00000025262728292A2B2C222D2E00000000001B1C1D151E1F20212223240000 0000000012131415161718191A000000000000000A0B0C0D0E0F101109000000 0000000000040506070809090000000000000000000000010203000000009FFF 00000FFF000007FF000083FF0000C1FF0000E10F0000F0030000FC010000FC01 0000F8000000F8000000F8000000FC010000FC010000FE030000FF8F0000} OldCreateOrder = False Position = poScreenCenter PixelsPerInch = 96 TextHeight = 13 object Memo1: TMemo Left = 0 Top = 0 Width = 373 Height = 186 Align = alClient ScrollBars = ssBoth TabOrder = 0 end object Panel1: TPanel Left = 0 Top = 186 Width = 373 Height = 29 Align = alBottom BevelOuter = bvNone TabOrder = 1 DesignSize = ( 373 29) object Button1: TButton Left = 294 Top = 4 Width = 75 Height = 25 Anchors = [akTop, akRight] Caption = '&OK' TabOrder = 0 OnClick = Button1Click end end end --- NEW FILE: GLXStringListEditor.pas --- unit GLXStringListEditor; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, GLXResource; type TGLXStringListEditorForm = class(TForm) Memo1: TMemo; Panel1: TPanel; Button1: TButton; procedure Button1Click(Sender: TObject); private fStringList : TGLXStringList; procedure SetStringList(List:TGLXStringList); public property StringList : TGLXStringList read fStringList write SetStringList; end; implementation {$R *.dfm} procedure TGLXStringListEditorForm.SetStringList(List:TGLXStringList); begin fStringList:=List; if Assigned(fStringList) then begin Caption:=fStringList.Ident; Memo1.Lines.Clear; Memo1.Lines.AddStrings(fStringList.StringList); end; end; procedure TGLXStringListEditorForm.Button1Click(Sender: TObject); begin if Assigned(fStringList) then begin fStringList.StringList.Clear; fStringList.StringList.AddStrings(Memo1.Lines); fStringList.Dirty:=true; end; ModalResult:=mrOK; end; end. --- NEW FILE: GLXResourceSourceEditor.dfm --- object GLXResourceSourceEditorForm: TGLXResourceSourceEditorForm Left = 298 Top = 135 Width = 676 Height = 217 Caption = 'Resource Source' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] Icon.Data = { 0000010001001010000001000800680500001600000028000000100000002000 0000010008000000000000000000000000000000000000000000000000000000 0000A77E7000A9807300A4786E0098686500BA958700EAD7A400EAD59E00E0C0 9700A5776C00A1746B00E1D4D300FFFEEE00F7CC8C00F0B47300F7C78800FCE3 A500C2A08800CEB29300FFFEDD00F4D1A500EEBA7B00F2C78F00F8E1AB00FCF0 BA00FCFACA00A3776F00AA7F7300FAE0A400F0B77800F6DDA600FEFBCC00FFFF [...1378 lines suppressed...] Top = 60 end object pmAction: TPopupMenu Images = ActionImagesH Left = 112 Top = 60 object New1: TMenuItem Action = actNew end object Open1: TMenuItem Action = actOpen end object Properties1: TMenuItem Action = actProperties end object Delete1: TMenuItem Action = actDelete end end end --- NEW FILE: GLXResourceSourceEditor.pas --- unit GLXResourceSourceEditor; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ActnList, ToolWin, ComCtrls, Menus, ImgList, DesignEditors, StdCtrls, GLXResource; type TGLXResourceSourceEditorForm = class(TForm) ListView: TListView; ToolBar1: TToolBar; ActionList: TActionList; ActionImagesH: TImageList; actDelete: TAction; actNew: TAction; tbNew: TToolButton; tbDelete: TToolButton; ActionImagesD: TImageList; ActionImages: TImageList; pmResourceTypeList: TPopupMenu; actOpen: TAction; actProperties: TAction; tbOpen: TToolButton; tbOptions: TToolButton; pmAction: TPopupMenu; New1: TMenuItem; Open1: TMenuItem; Properties1: TMenuItem; Delete1: TMenuItem; procedure FormShow(Sender: TObject); procedure actDeleteExecute(Sender: TObject); procedure actDeleteUpdate(Sender: TObject); procedure actNewExecute(Sender: TObject); procedure actPropertiesExecute(Sender: TObject); procedure actOpenExecute(Sender: TObject); procedure ListViewDblClick(Sender: TObject); private fSource : TGLXResourceSource; procedure AddResource(Sender:TObject); public procedure UpdateList; property ResourceSource : TGLXResourceSource read fSource write fSource; end; TGLXResourceSourceEditor = class(TComponentEditor) private fForm : TGLXResourceSourceEditorForm; public procedure Edit; override; end; implementation {$R *.DFM} procedure TGLXResourceSourceEditorForm.UpdateList; var Inventory : TStringList; i : Integer; NewItem : TListItem; Inv : TGLXInventory; SelIdent : String; begin if Assigned(ListView.selected) then begin SelIdent:=ListView.Selected.Caption; end else begin SelIdent:=''; end; Inventory := TStringList.Create; try if Assigned(fSource) then begin fSource.GetList(Inventory); ListView.Items.Clear; for i:=0 to Inventory.Count-1 do begin Inv := fSource.GetInv(Inventory.Strings[i]); NewItem := ListView.Items.Add; NewItem.Caption := Inventory.Strings[i]; NewItem.SubItems.Add(Inv.ResourceClassName); NewItem.SubItems.Add(Format('%d Byte(s)',[Inv.Size])); NewItem.SubItems.Add(Format('%d Byte(s)',[Inv.OSize])); if Inv.Compressed then NewItem.SubItems.Add('True') else NewItem.SubItems.Add('False'); if (Inv.OSize>0) then NewItem.SubItems.Add(Format('%.1f%%',[Inv.Size*100/Inv.OSize])) else NewItem.SubItems.Add(Format('%.1f%%',[100.0])); NewItem.SubItems.Add(DateTimeToStr(Inv.Modified)); end; end; finally Inventory.Free; end; if SelIdent<>'' then begin for i:=0 to ListView.Items.Count-1 do begin if ListView.Items[i].Caption=SelIdent then begin ListView.Items[i].Selected:=true; break; end; end; end; end; procedure TGLXResourceSourceEditorForm.FormShow(Sender: TObject); begin UpdateList; end; procedure TGLXResourceSourceEditorForm.AddResource(Sender:TObject); var ClassName : String; Ident : String; ResClass : TGLXResourceClass; NewResource : TGLXResource; i : Integer; begin if (Sender is TMenuItem) and Assigned(fSource) then begin ClassName := (Sender as TMenuItem).Caption; while Pos('&',ClassName)>0 do Delete(ClassName,Pos('&',ClassName),1); ResClass := GetResourceClass(ClassName); if Assigned(ResClass) then begin NewResource := ResClass.Create; i := 0; repeat Ident:=Format('New%d',[i]); inc(i); until not fSource.Contains(Ident); NewResource.Ident:=Ident; fSource.Save(NewResource); UpdateList; end; end; end; //New Action ------------------------------------------------------------------- procedure TGLXResourceSourceEditorForm.actNewExecute(Sender: TObject); var p : TPoint; NewItem : TMenuItem; RCList : TStringList; i : Integer; begin pmResourceTypeList.Items.Clear; RCList := TStringList.Create; try GetResourceClassList(RCList); for i:=0 to RCList.Count-1 do begin NewItem := TMenuItem.Create(Self); NewItem.Caption := RCList.Strings[i]; NewItem.OnClick := AddResource; pmResourceTypeList.Items.Add(NewItem); end; finally RCList.Free; end; //Show Menu p.x:=tbNew.Left+12; p.y:=tbNew.Top+12; p:=tbNew.ClientToScreen(p); pmResourceTypeList.Popup(p.x,p.y); end; //Delete Action ---------------------------------------------------------------- procedure TGLXResourceSourceEditorForm.actDeleteUpdate(Sender:TObject); begin (Sender as TAction).enabled:=ListView.Selected<>nil; end; procedure TGLXResourceSourceEditorForm.actDeleteExecute(Sender:TObject); begin if Assigned(fSource) then begin fSource.Delete(ListView.Selected.Caption); UpdateList; end; end; //Open Action ------------------------------------------------------------------ procedure TGLXResourceSourceEditorForm.actOpenExecute(Sender:TObject); var Resource : TGLXResource; ResEdit : IEditor; begin Resource:=fSource.Load(ListView.Selected.Caption); try ResEdit:=Resource as IEditor; if ResEdit.Edit then begin fSource.Save(Resource); UpdateList; end; except if Assigned(Resource) then Resource.Free; end; end; //Properties Action ------------------------------------------------------------ procedure TGLXResourceSourceEditorForm.actPropertiesExecute(Sender:TObject); begin ; end; procedure TGLXResourceSourceEditorForm.ListViewDblClick(Sender:TObject); begin if ListView.Selected<>nil then actOpen.Execute; end; //------------------------------------------------------------------------------ // TGLXResourceSourceEditor //------------------------------------------------------------------------------ procedure TGLXResourceSourceEditor.Edit; var MyForm : TGLXResourceSourceEditorForm; begin MyForm := TGLXResourceSourceEditorForm.Create(nil); MyForm.ResourceSource := TGLXResourceSource(Component); MyForm.ShowModal; MyForm.Free; end; end. |
|
From: Markus L?d. <dan...@us...> - 2004-04-01 01:22:51
|
Update of /cvsroot/glxtreem/GLXtreem/Source In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15645/Source Added Files: GLXResource.pas HashTables.pas Log Message: Initial Commit --- NEW FILE: HashTables.pas --- unit HashTables; interface uses SysUtils, Classes, Math, Windows; const EMPTY = Pointer(-1); DELETED = Pointer(-2); type THashTable = class(TObject) private Alpha: Double; FTable: PPointerList; FCount: Integer; FCapacity: Integer; FMaximumFillRatio: Double; FPosition: Integer; FCollisions: Integer; FInsertions: Integer; function GetAverageCollision: Real; procedure SetMaximumFillRatio(Value: Double); protected procedure Error(const msg: string); function Get(Key: Integer): Pointer; virtual; function GetIndex(Key: Integer): Integer; procedure Grow; virtual; function Hash(Key: Integer): Integer; virtual; procedure Put(Key: Integer; Item: Pointer); virtual; procedure Rehash(OldTable: PPointerList; OldCount: Integer); procedure SetCapacity(NewCapacity: Integer); public constructor Create; destructor Destroy; override; procedure Clear; virtual; function Current: Pointer; virtual; function DeleteCurrent: Pointer; function First: Pointer; virtual; function Insert(Key: Integer; Item: Pointer): Pointer; virtual; function Next: Pointer; virtual; function NextSame(Key: Integer): Pointer; function Remove(Key: Integer): Pointer; virtual; procedure Pack; property Capacity: Integer read FCapacity write SetCapacity; property Count: Integer read FCount; property MaximumFillRatio: Double read FMaximumFillRatio write SetMaximumFillRatio; property Items[Key: Integer]: Pointer read Get write Put; default; property AverageCollisions: Real read GetAverageCollision; end; TStringTableNode = record FKey: string; FObject: TObject; end; PStringTableNode = ^TStringTableNode; TStringTable = class(THashTable) private function ConvertKey(const Key: string): Integer; function FindKey(const Key: string; var Node: PStringTableNode): Boolean; protected function Get(const Key: string): TObject; reintroduce; procedure Put(const Key: string; Item: TObject); reintroduce; public destructor Destroy; override; procedure Clear; override; function Current: TObject; reintroduce; function CurrentKey: string; reintroduce; function First: TObject; reintroduce; function Insert(const Key: string; Item: TObject): Pointer; reintroduce; function Next: TObject; reintroduce; function Remove(const Key: string): TObject; reintroduce; property Items[const Key: string]: TObject read Get write Put; default; end; EHashTableError = class(Exception); implementation constructor THashTable.Create; begin Alpha := (Sqrt(5.0) - 1) / 2.0; FMaximumFillRatio := 0.8; SetCapacity(256); end; destructor THashTable.Destroy; begin FreeMem(FTable, FCapacity * (SizeOf(Pointer) * 2)); end; procedure THashTable.Clear; begin FCount := 0; FPosition := -2; FillChar(FTable^, FCapacity * (SizeOf(Pointer) * 2), Char(EMPTY)); end; function THashTable.Current: Pointer; begin if (FPosition >= 0) and (FPosition < FCapacity) and (FTable[FPosition] <> EMPTY) and (FTable[FPosition] <> DELETED) then Result := FTable[FPosition + 1] else Result := nil; end; function THashTable.DeleteCurrent: Pointer; begin FTable[FPosition] := DELETED; Result := FTable[FPosition + 1]; Dec(FCount); end; procedure THashTable.Error(const msg: string); begin raise EHashTableError.Create(msg); end; function THashTable.First: Pointer; begin FPosition := -2; Result := Next; end; function THashTable.Get(Key: Integer): Pointer; begin FPosition := GetIndex(Key); if Integer(FTable[FPosition]) = Key then Result := FTable[FPosition + 1] else Result := nil; end; function THashTable.GetAverageCollision: Real; begin if FInsertions = 0 then Result := 0.0 else Result := FCollisions / FInsertions; end; function THashTable.GetIndex(Key: Integer): Integer; var I: Integer; begin Result := Hash(Key) * 2; I := 0; while (I < FCapacity) and (FTable[Result] <> Pointer(Key)) and (FTable[Result] <> EMPTY) do begin Inc(Result, 2); Inc(I); Result := Result mod (FCapacity * 2); end; end; procedure THashTable.Grow; begin SetCapacity(FCapacity * 2); end; function THashTable.Hash(Key: Integer): Integer; begin if Key < 0 then Error('Keys must be positive'); Result := Trunc(FCapacity * Frac(Alpha * Key)); end; function THashTable.Insert(Key: Integer; Item: Pointer): Pointer; begin if (FCount + 1) >= Round(FCapacity * FMaximumFillRatio) then Grow; Inc(FCount); FPosition := Hash(Key) * 2; while (FTable[FPosition] <> EMPTY) and (FTable[FPosition] <> DELETED) do begin Inc(FCollisions); Inc(FPosition, 2); FPosition := FPosition mod (FCapacity * 2); end; FTable[FPosition] := Pointer(Key); FTable[FPosition + 1] := Item; Result := @FTable[FPosition + 1]; Inc(FInsertions) end; function THashTable.Next: Pointer; begin Inc(FPosition, 2); while (FPosition < (FCapacity * 2)) and ((FTable[FPosition] = EMPTY) or (FTable[FPosition] = DELETED)) do Inc(FPosition, 2); if FPosition < (FCapacity * 2) then Result := FTable[FPosition + 1] else Result := nil; end; function THashTable.NextSame(Key: Integer): Pointer; var oldpos: Integer; begin oldpos := FPosition; Inc(FPosition, 2); while (FPosition <> oldpos) and (FTable[FPosition] <> EMPTY) and (FTable[FPosition] <> Pointer(Key)) do begin Inc(FPosition, 2); FPosition := FPosition mod (FCapacity * 2); end; if FTable[FPosition] = Pointer(Key) then Result := FTable[FPosition + 1] else Result := nil; end; procedure THashTable.Pack; begin SetCapacity(Round(FCount * (1 / FMaximumFillRatio)) + 2); end; procedure THashTable.Put(Key: Integer; Item: Pointer); begin FPosition := GetIndex(Key); if Integer(FTable[FPosition]) = Key then FTable[FPosition + 1] := Item else Insert(Key, Item); end; function THashTable.Remove(Key: Integer): Pointer; begin FPosition := GetIndex(Key); if Integer(FTable[FPosition]) = Key then begin FTable[FPosition] := DELETED; Result := FTable[FPosition + 1]; Dec(FCount); end else Result := nil; end; procedure THashTable.Rehash(OldTable: PPointerList; OldCount: Integer); var I: Integer; begin I := 0; while FCount < OldCount do begin while (OldTable[I] = EMPTY) or (OldTable[I] = DELETED) do Inc(I, 2); Insert(Integer(OldTable[I]), OldTable[I + 1]); Inc(I, 2); end; end; procedure THashTable.SetCapacity(NewCapacity: Integer); var OldTable: Pointer; OldCapacity, OldCount: Integer; begin if (FCount >= Round(NewCapacity * FMaximumFillRatio)) or (NewCapacity > (MaxListSize div 2)) then Error('Invalid capacity'); if NewCapacity <> FCapacity then begin OldTable := FTable; FTable := AllocMem(NewCapacity * (SizeOf(Pointer) * 2)); OldCapacity := FCapacity; FCapacity := NewCapacity; OldCount := FCount; FPosition := -1; Clear; ReHash(OldTable, OldCount); FreeMem(OldTable, OldCapacity * (SizeOf(Pointer) * 2)); end; end; procedure THashTable.SetMaximumFillRatio(Value: Double); begin if (Value < 0.5) or (Value > 1.0) then Error('Maximum fill ratio must be between 0.5 and 1.0'); FMaximumFillRatio := Value; if FCount > Round(FCapacity * FMaximumFillRatio) then Grow; end; { TStringTable } procedure TStringTable.Clear; var pt: PStringTableNode; begin pt := PStringTableNode(inherited First); while pt <> nil do begin Dispose(pt); pt := inherited Next; end; inherited Clear; end; function TStringTable.ConvertKey(const Key: string): Integer; var i: Integer; begin Result := 0; for i := 1 to Length(Key) do Result := (131 * Result) + Ord(Key[i]); Result := Abs(Result); end; function TStringTable.Current: TObject; var pt: PStringTableNode; begin pt := inherited Current; if pt <> nil then Result := pt^.FObject else Result := nil; end; function TStringTable.CurrentKey: string; var pt: PStringTableNode; begin pt := inherited Current; if pt <> nil then Result := pt^.FKey else Result := ''; end; destructor TStringTable.Destroy; begin Clear; inherited Destroy; end; function TStringTable.FindKey(const Key: string; var Node: PStringTableNode): Boolean; var k: Integer; begin k := ConvertKey(Key); Node := inherited Get(k); while (Node <> nil) and (Node^.FKey <> Key) do NextSame(k); Result := (Node <> nil); end; function TStringTable.First: TObject; var pt: PStringTableNode; begin pt := inherited First; if pt <> nil then Result := pt^.FObject else Result := nil; end; function TStringTable.Get(const Key: string): TObject; var pt: PStringTableNode; begin if FindKey(Key, pt) then Result := pt^.FObject else Result := nil; end; function TStringTable.Insert(const Key: string; Item: TObject): Pointer; var pt: PStringTableNode; begin New(pt); pt^.FKey := Key; pt^.FObject := Item; inherited Insert(ConvertKey(Key), pt); Result := @(pt^.FObject); end; function TStringTable.Next: TObject; var pt: PStringTableNode; begin pt := inherited Next; if pt <> nil then Result := pt^.FObject else Result := nil; end; procedure TStringTable.Put(const Key: string; Item: TObject); var pt: PStringTableNode; begin if FindKey(Key, pt) then pt^.FObject := Item else Insert(Key, Item); end; function TStringTable.Remove(const Key: string): TObject; var pt: PStringTableNode; begin if FindKey(Key, pt) then begin DeleteCurrent; Result := pt^.FObject; Dispose(pt); end else Result := nil; end; end. --- NEW FILE: GLXResource.pas --- //////////////////////////////////////////////////////////////////////////////// // // // GLXTreem // // // // Date : 2004-03-16 // // // // The contents of this file are used with permission, subject to // // the Mozilla Public License Version 1.1 (the "License"); you may // // not use this file except in compliance with the License. You may // // obtain a copy of the License at // // http://www.mozilla.org/MPL/MPL-1.1.html // // // // Software distributed under the License is distributed on an // // "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or // // implied. See the License for the specific language governing // // rights and limitations under the License. // // // //////////////////////////////////////////////////////////////////////////////// [...1032 lines suppressed...] initialization ResourceTypeList := TStringTable.Create; SourceList := TObjectList.Create(false); //Register RegisterResourceClass(TGLXResource); RegisterResourceClass(TGLXStringList); finalization //Unregister UnRegisterResourceClass(TGLXStringList); UnRegisterResourceClass(TGLXResource); //Cleanup ClearResourceTypeList; SourceList.Free; ResourceTypeList.Free; end. |
Update of /cvsroot/glxtreem/GLXtreem/Source/GraphicEx In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14901/Source/GraphicEx Added Files: JCAPIMIN.OBJ JCAPISTD.OBJ JCCOEFCT.OBJ JCCOLOR.OBJ JCDCTMGR.OBJ JCHUFF.OBJ JCINIT.OBJ JCMAINCT.OBJ JCMARKER.OBJ JCMASTER.OBJ JCOMAPI.OBJ JCPARAM.OBJ JCPHUFF.OBJ JCPREPCT.OBJ JCSAMPLE.OBJ JCTRANS.OBJ JDAPIMIN.OBJ JDAPISTD.OBJ JDATADST.OBJ JDATASRC.OBJ JDCOEFCT.OBJ JDCOLOR.OBJ JDDCTMGR.OBJ JDHUFF.OBJ JDINPUT.OBJ JDMAINCT.OBJ JDMARKER.OBJ JDMASTER.OBJ JDMERGE.OBJ JDPHUFF.OBJ JDPOSTCT.OBJ JDSAMPLE.OBJ JDTRANS.OBJ JERROR.OBJ JFDCTFLT.OBJ JFDCTFST.OBJ JFDCTINT.OBJ JIDCTFLT.OBJ JIDCTFST.OBJ JIDCTINT.OBJ JIDCTRED.OBJ JMEMMGR.OBJ JMEMNOBS.OBJ JPEGTRAN.OBJ JQUANT1.OBJ JQUANT2.OBJ JUTILS.OBJ Log Message: Initial Commit --- NEW FILE: JFDCTFST.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JDATASRC.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JUTILS.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JCPREPCT.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JDCOLOR.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JIDCTINT.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JFDCTINT.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JCAPIMIN.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JQUANT2.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JCDCTMGR.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JCMAINCT.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JDATADST.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JIDCTFLT.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JCMASTER.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JPEGTRAN.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JCCOEFCT.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JCPARAM.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JIDCTRED.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JCCOLOR.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JCTRANS.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JMEMMGR.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JMEMNOBS.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JDMARKER.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JDMAINCT.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JERROR.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JDAPISTD.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JFDCTFLT.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JCMARKER.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JCPHUFF.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JDAPIMIN.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JDCOEFCT.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JDSAMPLE.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JDHUFF.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JIDCTFST.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JCHUFF.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JDMASTER.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JDTRANS.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JDMERGE.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JCINIT.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JDPHUFF.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JDINPUT.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JDDCTMGR.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JQUANT1.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JCAPISTD.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JCOMAPI.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JDPOSTCT.OBJ --- (This appears to be a binary file; contents omitted.) --- NEW FILE: JCSAMPLE.OBJ --- (This appears to be a binary file; contents omitted.) |
|
From: Andreas L. <an...@us...> - 2004-03-29 15:06:43
|
Update of /cvsroot/glxtreem/GLXtreem/Source In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7344/Source Modified Files: GLXImageList.pas GLXTerrain.pas Log Message: Improved huge terrain renderer Index: GLXTerrain.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/GLXTerrain.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** GLXTerrain.pas 28 Mar 2004 20:06:25 -0000 1.1 --- GLXTerrain.pas 29 Mar 2004 14:55:09 -0000 1.2 *************** *** 84,87 **** --- 84,89 ---- end; + Type THeightMapData = Array of Single; + // TGLXImageItem *************** *** 93,97 **** private { Private declarations } ! FData : Array of Single; FWidth : Integer; // The width of the data FHeight: Integer; // The height of the data --- 95,99 ---- private { Private declarations } ! FData : THeightMapData; FWidth : Integer; // The width of the data FHeight: Integer; // The height of the data *************** *** 198,209 **** LoadList : TList; CurrentNode: TGLXTerrainNode; TextureWidth : Integer; TextureHeight: Integer; TextureData : TTextureData24; ! FVertexData : TVertexData; Procedure AssignNode; procedure LoadNode; protected procedure Execute; override; --- 200,216 ---- LoadList : TList; CurrentNode: TGLXTerrainNode; + VertexData : TVertexData; TextureWidth : Integer; TextureHeight: Integer; TextureData : TTextureData24; ! ! HeightmapWidth : Integer; ! HeightmapHeight: Integer; ! HeightmapData : THeightMapData; Procedure AssignNode; procedure LoadNode; + procedure BuildVertexData(Width, Height: Integer); protected procedure Execute; override; *************** *** 453,456 **** --- 460,466 ---- Stream:= TFileStream.Create(CurrentNode.FileName, fmOpenRead); + // Read the texture + //******************** + Stream.Read(TextureWidth , SizeOf(TextureWidth )); Stream.Read(TextureHeight, SizeOf(TextureHeight)); *************** *** 460,463 **** --- 470,494 ---- Stream.Read(TextureData[0], SizeOf(TextureData[0]) * TextureWidth * TextureHeight); + // Read the heightmap + //******************** + + Stream.Read(HeightmapWidth , SizeOf(HeightmapWidth )); + Stream.Read(HeightmapHeight, SizeOf(HeightmapHeight)); + + SetLength(HeightmapData, HeightmapWidth * HeightmapHeight); + + Stream.Read(HeightmapData[0], SizeOf(HeightmapData[0]) * HeightmapWidth * HeightmapHeight); + + Stream.Free; + + // build the vertex data + BuildVertexData(HeightmapWidth, HeightmapHeight); + + // Assign the node + Synchronize(AssignNode); + + { + + Exit; Stream.Read(FVertexData.numVertices , SizeOf(FVertexData.numVertices)); Stream.Read(FVertexData.numNormals , SizeOf(FVertexData.numNormals )); *************** *** 477,488 **** Stream.Free; ! Self.Synchronize(AssignNode); end; //------------------------------------------------------------------------------ procedure TGLXNodeLoader.AssignNode; begin CurrentNode.FTexture :=CreateTexture(TextureWidth, TextureHeight, GL_RGB, Addr(TextureData[0])); ! CurrentNode.FVertexData:=FVertexData; CurrentNode.FLoading :=False; CurrentNode.FLoaded :=True; --- 508,609 ---- Stream.Free; ! Self.Synchronize(AssignNode); } end; + + + + //------------------------------------------------------------------------------ + procedure TGLXNodeLoader.BuildVertexData(Width, Height: Integer); + var SwitchSides: Boolean; + var X, Y : Integer; + + //--------------------------------------------------------------- + Procedure Vertex(X,Y,Z: Single); + begin + Inc(VertexData.numVertices); + SetLength(VertexData.theVertices , VertexData.numVertices ); + + VertexData.theVertices[VertexData.numVertices-1].X:=X; + VertexData.theVertices[VertexData.numVertices-1].Y:=Y; + VertexData.theVertices[VertexData.numVertices-1].Z:=Z; + end; + + //--------------------------------------------------------------- + Procedure TexCoordA(U,V: Single); + begin + Inc(VertexData.numTexCoordsA); + SetLength(VertexData.theTexCoordsA, VertexData.numTexCoordsA); + + VertexData.theTexCoordsA[VertexData.numTexCoordsA-1].X:=U; + VertexData.theTexCoordsA[VertexData.numTexCoordsA-1].Y:=V; + end; + + //--------------------------------------------------------------- + Procedure TexCoordB(U,V: Single); + begin + Inc(VertexData.numTexCoordsB); + SetLength(VertexData.theTexCoordsB, VertexData.numTexCoordsB); + + VertexData.theTexCoordsB[VertexData.numTexCoordsB-1].X:=U; + VertexData.theTexCoordsB[VertexData.numTexCoordsB-1].Y:=V; + end; + + //--------------------------------------------------------------- + function getHeight(X,Y: Integer): Single; + begin + Result:=HeightmapData[X + Y * Width]; + end; + + begin + // Clear all vertexdata + VertexData.numVertices :=0; + VertexData.numNormals :=0; + VertexData.numTexCoordsA:=0; + VertexData.numTexCoordsB:=0; + + SwitchSides:=True; + X:=0; + While X < Width do begin + Y:=0; + While Y < Height do begin + + IF SwitchSides then begin + TexCoordA(1, 0); + TexCoordB((X+1) / Width , Y / Height); + + Vertex(X+1, getHeight(X+1, Y), Y); + + TexCoordA(0, 0); + TexCoordB(X / Width , Y / Height); + + Vertex(X, getHeight(X, Y), Y); + end else begin + + TexCoordA(1, 1); + TexCoordB((X+1) / Width , Y / Height); + + Vertex(X+1, getHeight(X+1, Y), Y); + + + TexCoordA(0, 1); + TexCoordB(X / Width , Y / Height); + + Vertex(X, getHeight(X, Y), Y); + end; + Inc(Y); + + SwitchSides:= not SwitchSides; + end; + Inc(X); + end; + end; + + //------------------------------------------------------------------------------ procedure TGLXNodeLoader.AssignNode; begin CurrentNode.FTexture :=CreateTexture(TextureWidth, TextureHeight, GL_RGB, Addr(TextureData[0])); ! CurrentNode.FVertexData:=VertexData; CurrentNode.FLoading :=False; CurrentNode.FLoaded :=True; *************** *** 615,622 **** //------------------------------------------------------------------------------ procedure TGLXTerrainNode.Load; - var Stream : TFileStream; - var TextureWidth : Integer; - var TextureHeight: Integer; - var TextureData : TTextureData24; begin IF FLoading or FLoaded then Exit; --- 736,739 ---- Index: GLXImageList.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/GLXImageList.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** GLXImageList.pas 28 Mar 2004 20:06:25 -0000 1.1 --- GLXImageList.pas 29 Mar 2004 14:55:09 -0000 1.2 *************** *** 142,147 **** ! { Renders the image to the screen.<br><br>To be used in orthogonal mode.} ! procedure Draw(X, Y, PatternIndex: Integer); --- 142,153 ---- ! { Draws the image to the screen.<br><br>To be used in orthogonal mode.} ! procedure Draw (X, Y, PatternIndex: Integer); ! { Stretch draw the image to the screen.<br><br>To be used in orthogonal mode.} ! Procedure StrechDraw(X, Y, Width, Height, PatternIndex: Integer); overload; ! { Stretch draw the image to the screen.<br><br>To be used in orthogonal mode.} ! Procedure StrechDraw(Rect : TRect ; PatternIndex: Integer); overload; ! { Draw the image to the screen.<br><br>To be used in orthogonal mode.} ! procedure DrawRotate(X, Y, Width, Height, PatternIndex: Integer; CenterX, CenterY, Angle: Single); overload; *************** *** 550,555 **** --- 556,603 ---- end; + //------------------------------------------------------------------------------ + procedure TGLXImageItem.StrechDraw(Rect: TRect; PatternIndex: Integer); + begin + glPushAttrib(GL_ENABLE_BIT); + glEnable (GL_TEXTURE_2D); + glEnable (GL_BLEND); + glDisable (GL_DEPTH_TEST); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + Bind; + + glBegin(GL_QUADS); + with FPatterns[PatternIndex] do begin + glTexCoord2f(Left , Bottom); glVertex2i(Rect.Left , Rect.Top); + glTexCoord2f(Right, Bottom); glVertex2i(Rect.Right, Rect.Top); + glTexCoord2f(Right, Top ); glVertex2i(Rect.Right, Rect.Bottom); + glTexCoord2f(Left , Top ); glVertex2i(Rect.Left , Rect.Bottom); + end; + glEnd(); + glPopAttrib(); + end; + + //------------------------------------------------------------------------------ + procedure TGLXImageItem.StrechDraw(X, Y, Width, Height, PatternIndex: Integer); + begin + StrechDraw(Rect(X,Y, X + Width, Y + Height), PatternIndex); + end; + //------------------------------------------------------------------------------ + procedure TGLXImageItem.DrawRotate(X, Y, Width, Height, PatternIndex: Integer; CenterX, CenterY, Angle: Single); + var Rect: TRect; + begin + glPushMatrix(); + glLoadIdentity(); + Rect.Left :=-Round( CenterX * Width ); + Rect.Top :=-Round( CenterY * Height); + Rect.Right := Round((1-CenterX) * Width ); + Rect.Bottom:= Round((1-CenterY) * Height); + glTranslatef(X,Y,0); + glRotatef (Angle, 0,0,1); + StrechDraw (Rect,PatternIndex); + glPopMatrix(); + end; + |
|
From: <an...@us...> - 2004-03-12 07:50:41
|
Update of /cvsroot/glxtreem/GLXtreem/Source In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv12511/Source Modified Files: GLXDraws.pas GLXNotification.pas GLXPrimitives.pas GLXTexture.pas GLXTimer.pas Log Message: Added help context and various other changes Index: GLXDraws.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/GLXDraws.pas,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** GLXDraws.pas 11 Mar 2004 01:16:53 -0000 1.2 --- GLXDraws.pas 12 Mar 2004 07:31:20 -0000 1.3 *************** *** 3,7 **** // GLXTreem // // // ! // Date : 2004-03- 08 // // // // The contents of this file are used with permission, subject to // --- 3,7 ---- // GLXTreem // // // ! // Date : 2004-03-08 // // // // The contents of this file are used with permission, subject to // *************** *** 22,26 **** @author(Andreas Lago: an...@li...) @created(Mar 8, 2004) ! @lastmod(Mar 8, 2004) } --- 22,26 ---- @author(Andreas Lago: an...@li...) @created(Mar 8, 2004) ! @lastmod(Mar 12, 2004) } *************** *** 33,37 **** Windows, Forms, Classes, Controls, Messages, Graphics, Sysutils, ! GLXCamera, GLXTimer, GLXScreens, dglOpenGL; --- 33,37 ---- Windows, Forms, Classes, Controls, Messages, Graphics, Sysutils, ! GLXCamera, GLXTimer, GLXScreens, GLXNotification, dglOpenGL; *************** *** 39,44 **** //------------------------------------------------------------------------------ ! {@exclude} ! Type TGLXDrawOption = (doInitialize, doFullScreen, doAutosize); //------------------------------------------------------------------------------ {@exclude} --- 39,53 ---- //------------------------------------------------------------------------------ ! { Options for the glxdraw.<br><br>Can be any of the following values.<br><br> } ! Type TGLXDrawOption = ( ! { Automaticcaly initialize renderer on program start. } ! doInitialize, ! { Fullscreen is used when next call to SetScreenMode. } ! doFullScreen, ! { Automatically resize the surface size when the component is resized. } ! doAutosize ! ); ! ! //------------------------------------------------------------------------------ {@exclude} *************** *** 118,135 **** procedure SetStencilBits(const Value: Integer); procedure SetZBits (const Value: Integer); - protected - {@exclude} - Procedure UpdateOpenGL; public {@exclude} Constructor Create(AOwner: TObject); published ! property ColorBits : Integer read fColorBits write SetColorBits; ! property ZBits : Integer read fZBits write SetZBits; ! property StencilBits : Integer read fStencilBits write SetStencilBits; ! property AccumBits : Integer read fAccumBits write SetAccumBits; ! property AuxBuffers : Integer read fAuxBuffers write SetAuxBuffers; ! { Specifies if the scene is to be rendered using depth testing. } property doDepthTest : Boolean read FdoDepthTest write SetDepthTest; --- 127,148 ---- procedure SetStencilBits(const Value: Integer); procedure SetZBits (const Value: Integer); public {@exclude} Constructor Create(AOwner: TObject); + {@ Updates the opengl context. } + Procedure Update; published + { Specifies the number of color bits. } + property numColorBits : Integer read FColorBits write SetColorBits; + { Specifies the number of z bits. } + property numZBits : Integer read FZBits write SetZBits; + { Specifies the number of stencil bits. } + property numStencilBits : Integer read FStencilBits write SetStencilBits; + { Specifies the number of accum bits. } + property numAccumBits : Integer read FAccumBits write SetAccumBits; + { Specifies the number of auxillary buffers. } + property numAuxBuffers : Integer read FAuxBuffers write SetAuxBuffers; ! { Specifies if the scene is to be rendered using depth testing. } property doDepthTest : Boolean read FdoDepthTest write SetDepthTest; *************** *** 142,146 **** { Specifies if the scene is to be rendered with culling. } property doCulling : Boolean read FdoCulling write SetCulling; ! { Specifies if the scene is to be rendered with line stripple. } property doLineStripple: Boolean read FdoLineStripple write SetLineStripple; end; --- 155,159 ---- { Specifies if the scene is to be rendered with culling. } property doCulling : Boolean read FdoCulling write SetCulling; ! { Specifie if the scene is to be rendered with line stripple. } property doLineStripple: Boolean read FdoLineStripple write SetLineStripple; end; *************** *** 188,197 **** function GetDisplay: TGLXDrawDisplay; ! procedure SetCamera (const Value: TGLXCamera); ! procedure SetOptions (const Value: TGLXDrawOptions); ! procedure SetDisplay (const Value: TGLXDrawDisplay); ! procedure SetTimer(const Value: TGLXTimer); protected - { Protected declarations } {@exclude} procedure Paint; override; --- 201,209 ---- function GetDisplay: TGLXDrawDisplay; ! procedure SetCamera (const Value: TGLXCamera); ! procedure SetOptions(const Value: TGLXDrawOptions); ! procedure SetDisplay(const Value: TGLXDrawDisplay); ! procedure SetTimer (const Value: TGLXTimer); protected {@exclude} procedure Paint; override; *************** *** 275,281 **** ! // Events property OnSetup : TNotifyEvent read FOnSetup write FOnSetup; property OnInitialize : TNotifyEvent read FonInitialize write FonInitialize; property OnRender : TGLXTimerEvent read FOnRender write FOnRender; --- 287,295 ---- ! { This event is called just before opengl initialization, use to setup screen mode. } property OnSetup : TNotifyEvent read FOnSetup write FOnSetup; + { This event is called when opengl is initialized. } property OnInitialize : TNotifyEvent read FonInitialize write FonInitialize; + { This event is called by the onTimer event if the timer is assigned. } property OnRender : TGLXTimerEvent read FOnRender write FOnRender; *************** *** 355,363 **** inherited Create(AOwner); ! FRC :=0; ! Camera :=nil; ! Timer :=nil; RenderOptions:= TGLXRenderOptions.Create(self); ! Options :=[doInitialize, doAutosize]; end; --- 369,377 ---- inherited Create(AOwner); ! FRC := 0; ! Camera := nil; ! Timer := nil; RenderOptions:= TGLXRenderOptions.Create(self); ! Options := [doInitialize, doAutosize]; end; *************** *** 429,434 **** Procedure TGLXDraw.Render(FrameTime: Single); begin - Activate; - If Assigned(Camera) then begin Camera.Style:= csPerspective; --- 443,446 ---- *************** *** 441,446 **** Flip; - - Deactivate; end; --- 453,456 ---- *************** *** 460,471 **** FDC := GetDC(Handle); ! if FDC=0 then raise Exception.Create('Could not get device context!'); // Create the rendering context with RenderOptions do ! FRC := CreateRenderingContext(FDC, [opDoubleBuffered], ColorBits, ZBits, StencilBits, AccumBits, AuxBuffers,0); ! if FRC=0 then raise Exception.Create('Could not create rendering context!'); // Activate the rendering context ActivateRenderingContext(DC, RC); --- 470,481 ---- FDC := GetDC(Handle); ! if FDC = 0 then raise Exception.Create('Could not get device context!'); // Create the rendering context with RenderOptions do ! FRC := CreateRenderingContext(FDC, [opDoubleBuffered], numColorBits, numZBits, numStencilBits, numAccumBits, numAuxBuffers,0); ! if FRC = 0 then raise Exception.Create('Could not create rendering context!'); // Activate the rendering context ActivateRenderingContext(DC, RC); *************** *** 473,477 **** SetBounds(Left, Top, Width, Height); ! RenderOptions.UpdateOpenGL; if Assigned(FOnInitialize) then FOnInitialize(Self); --- 483,489 ---- SetBounds(Left, Top, Width, Height); ! RenderOptions.Update; ! ! GLXNotifications.Notify([glx_ContextCreated]); if Assigned(FOnInitialize) then FOnInitialize(Self); *************** *** 574,580 **** procedure TGLXDraw.SetTimer(const Value: TGLXTimer); begin - IF Assigned(Timer) then Timer.Unsubscribe(TimerEvent); FTimer := Value; ! IF Assigned(Timer) then Timer.Subscribe(TimerEvent); end; --- 586,591 ---- procedure TGLXDraw.SetTimer(const Value: TGLXTimer); begin FTimer := Value; ! IF Assigned(Timer) then Timer.OnTimer:=TimerEvent; end; *************** *** 620,638 **** begin Bitmap:=TBitmap.Create; ! Bitmap.Width := Self.Width; ! Bitmap.Height:= Self.Height; ! if (GetDeviceCaps(dc, RASTERCAPS) AND RC_PALETTE = RC_PALETTE) then begin ! GetMem(lpPal, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY))); ! FillChar(lpPal^, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)), #0); ! lpPal^.palVersion := $300; ! lpPal^.palNumEntries := GetSystemPaletteEntries(DC, 0, 256, lpPal^.palPalEntry); ! if (lpPal^.PalNumEntries <> 0) then begin ! Bitmap.Palette := CreatePalette(lpPal^); ! end; ! FreeMem(lpPal, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY))); end; - BitBlt(Bitmap.Canvas.Handle, 0, 0, Self.Width, Self.Height, DC, 0, 0, SRCCOPY); - Bitmap.SaveToFile(FileName); - Bitmap.Free; end; --- 631,652 ---- begin Bitmap:=TBitmap.Create; ! try ! Bitmap.Width := Self.Width; ! Bitmap.Height:= Self.Height; ! if (GetDeviceCaps(dc, RASTERCAPS) AND RC_PALETTE = RC_PALETTE) then begin ! GetMem(lpPal, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY))); ! FillChar(lpPal^, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)), #0); ! lpPal^.palVersion := $300; ! lpPal^.palNumEntries := GetSystemPaletteEntries(DC, 0, 256, lpPal^.palPalEntry); ! if (lpPal^.PalNumEntries <> 0) then begin ! Bitmap.Palette := CreatePalette(lpPal^); ! end; ! FreeMem(lpPal, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY))); ! end; ! BitBlt(Bitmap.Canvas.Handle, 0, 0, Self.Width, Self.Height, DC, 0, 0, SRCCOPY); ! Bitmap.SaveToFile(FileName); ! finally ! Bitmap.Free; end; end; *************** *** 787,798 **** constructor TGLXRenderOptions.Create(AOwner: TObject); begin ! fColorBits := 32; ! fZBits := 16; ! fStencilBits := 0; ! fAccumBits := 0; ! fAuxBuffers := 0; ! FdoDepthtest:=True; FOwner:=AOwner; end; --- 801,818 ---- constructor TGLXRenderOptions.Create(AOwner: TObject); begin ! FColorBits := 32; ! FZBits := 16; ! FStencilBits := 0; ! FAccumBits := 0; ! FAuxBuffers := 0; ! FdoDepthTest := True; ! FdoWireframe := False; ! FdoTexturing := False; ! FdoBlending := False; ! FdoLineStripple:= False; ! FdoCulling := False; ! FOwner:=AOwner; end; *************** *** 800,804 **** //------------------------------------------------------------------------------ ! procedure TGLXRenderOptions.UpdateOpenGL; begin IF (FOwner <> nil) and (TGLXDraw(Fowner).RC <> 0) then begin --- 820,824 ---- //------------------------------------------------------------------------------ ! procedure TGLXRenderOptions.Update; begin IF (FOwner <> nil) and (TGLXDraw(Fowner).RC <> 0) then begin *************** *** 866,870 **** begin FdoWireframe:= Value; ! UpdateOpenGL; end; --- 886,890 ---- begin FdoWireframe:= Value; ! Update; end; *************** *** 873,877 **** begin FdoBlending := Value; ! UpdateOpenGL; end; --- 893,897 ---- begin FdoBlending := Value; ! Update; end; *************** *** 880,884 **** begin FdoCulling := Value; ! UpdateOpenGL; end; --- 900,904 ---- begin FdoCulling := Value; ! Update; end; *************** *** 887,891 **** begin FdoLineStripple := Value; ! UpdateOpenGL; end; --- 907,911 ---- begin FdoLineStripple := Value; ! Update; end; *************** *** 894,898 **** begin FdoTexturing := Value; ! UpdateOpenGL; end; --- 914,918 ---- begin FdoTexturing := Value; ! Update; end; *************** *** 901,905 **** begin FdoDepthtest:= Value; ! UpdateOpenGL; end; --- 921,925 ---- begin FdoDepthtest:= Value; ! Update; end; *************** *** 945,954 **** initialization //Has to be initialized only once per Application InitOpenGL; - - - end. --- 965,973 ---- + + //------------------------------------------------------------------------------ initialization //Has to be initialized only once per Application InitOpenGL; end. Index: GLXNotification.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/GLXNotification.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** GLXNotification.pas 10 Mar 2004 16:55:30 -0000 1.1 --- GLXNotification.pas 12 Mar 2004 07:31:20 -0000 1.2 *************** *** 1,5 **** --- 1,30 ---- + //////////////////////////////////////////////////////////////////////////////// + // // + // GLXTreem // + // // + // Date : 2004-03-12 // + // // + // The contents of this file are used with permission, subject to // + // the Mozilla Public License Version 1.1 (the "License"); you may // + // not use this file except in compliance with the License. You may // + // obtain a copy of the License at // + // http://www.mozilla.org/MPL/MPL-1.1.html // + // // + // Software distributed under the License is distributed on an // + // "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or // + // implied. See the License for the specific language governing // + // rights and limitations under the License. // + // // + //////////////////////////////////////////////////////////////////////////////// + + { + @created(Mar 8, 2004) + @lastmod(Mar 12, 2004) + } + unit GLXNotification; interface + uses Classes; Index: GLXPrimitives.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/GLXPrimitives.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** GLXPrimitives.pas 10 Mar 2004 16:55:30 -0000 1.1 --- GLXPrimitives.pas 12 Mar 2004 07:31:20 -0000 1.2 *************** *** 108,112 **** ! var BufferItems: Array[TPrimitive] of TBufferItem; var BufferData : TBufferData; var BufferSize : Integer; --- 108,112 ---- ! var BufferItems: Array[TPrimitive] of TBufferItem; var BufferData : TBufferData; var BufferSize : Integer; Index: GLXTexture.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/GLXTexture.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** GLXTexture.pas 10 Mar 2004 16:55:30 -0000 1.1 --- GLXTexture.pas 12 Mar 2004 07:31:20 -0000 1.2 *************** *** 260,264 **** Procedure CreateData(Bitmap: TBitmap; var Data: TTextureData24); overload; var X, Y: Integer; ! var Pix : TRGBTriple; var Line: PRGBTripleArray; begin --- 260,264 ---- Procedure CreateData(Bitmap: TBitmap; var Data: TTextureData24); overload; var X, Y: Integer; ! var Index : Integer; var Line: PRGBTripleArray; begin *************** *** 267,276 **** For Y:=0 to Bitmap.Height-1 do begin Line := Bitmap.ScanLine[Bitmap.Height-Y-1]; For X:=0 to Bitmap.Width-1 do begin ! Pix:=Line[X]; ! Data[X+(Y*Bitmap.Width)].Red :=Pix.rgbtRed; ! Data[X+(Y*Bitmap.Width)].Green:=Pix.rgbtGreen; ! Data[X+(Y*Bitmap.Width)].Blue :=Pix.rgbtBlue; end; end; --- 267,277 ---- For Y:=0 to Bitmap.Height-1 do begin Line := Bitmap.ScanLine[Bitmap.Height-Y-1]; + Index:= Bitmap.Width * Y; For X:=0 to Bitmap.Width-1 do begin ! Data[Index].Red :=Line[X].rgbtRed; ! Data[Index].Green:=Line[X].rgbtGreen; ! Data[Index].Blue :=Line[X].rgbtBlue; ! Inc(Index); end; end; *************** *** 280,286 **** //------------------------------------------------------------------------------ Procedure CreateData(Bitmap: TBitmap; var Data: TTextureData32); overload; ! var X, Y: Integer; ! var Pix : TRGBQuad ; ! var Line: PRGBQuadArray; begin SetLength(Data, Bitmap.Width * Bitmap.Height); --- 281,287 ---- //------------------------------------------------------------------------------ Procedure CreateData(Bitmap: TBitmap; var Data: TTextureData32); overload; ! var X, Y : Integer; ! var Index : Integer; ! var Line : PRGBQuadArray; begin SetLength(Data, Bitmap.Width * Bitmap.Height); *************** *** 288,298 **** For Y:=0 to Bitmap.Height-1 do begin Line := Bitmap.ScanLine[Bitmap.Height-Y-1]; For X:=0 to Bitmap.Width-1 do begin ! Pix:=Line[X]; ! Data[X+(Y*Bitmap.Width)].Red :=Pix.rgbRed; ! Data[X+(Y*Bitmap.Width)].Green:=Pix.rgbGreen; ! Data[X+(Y*Bitmap.Width)].Blue :=Pix.rgbBlue; ! Data[X+(Y*Bitmap.Width)].Alpha:=Pix.rgbReserved; end; end; --- 289,300 ---- For Y:=0 to Bitmap.Height-1 do begin Line := Bitmap.ScanLine[Bitmap.Height-Y-1]; + Index:= Bitmap.Width * Y; For X:=0 to Bitmap.Width-1 do begin ! Data[Index].Red :=Line[X].rgbRed; ! Data[Index].Green:=Line[X].rgbGreen; ! Data[Index].Blue :=Line[X].rgbBlue; ! Data[Index].Alpha:=Line[X].rgbReserved; ! Inc(Index); end; end; *************** *** 303,312 **** Procedure ScaleBitmap24(Source, Dest: TBitmap; Scale: Single); var X, Y: Integer; - //var SPix : TRGBTriple ; var SLine: PRGBTripleArray; var DLine: PRGBTripleArray; begin ! // Can't scale to 0 ! IF Scale = 0 then Scale:= 1; Dest.PixelFormat:=pf24Bit; --- 305,313 ---- Procedure ScaleBitmap24(Source, Dest: TBitmap; Scale: Single); var X, Y: Integer; var SLine: PRGBTripleArray; var DLine: PRGBTripleArray; begin ! // Can't scale to zero ! IF Scale <= 0 then Scale:= 1; Dest.PixelFormat:=pf24Bit; *************** *** 326,335 **** Procedure ScaleBitmap32(Source, Dest: TBitmap; Scale: Single); var X, Y: Integer; - //var SPix : TRGBTriple ; var SLine: PRGBQuadArray; var DLine: PRGBQuadArray; begin ! // Can't scale to 0 ! IF Scale = 0 then Scale:= 1; Dest.PixelFormat:=pf24Bit; --- 327,335 ---- Procedure ScaleBitmap32(Source, Dest: TBitmap; Scale: Single); var X, Y: Integer; var SLine: PRGBQuadArray; var DLine: PRGBQuadArray; begin ! // Can't scale to zero ! IF Scale <= 0 then Scale:= 1; Dest.PixelFormat:=pf24Bit; Index: GLXTimer.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/GLXTimer.pas,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** GLXTimer.pas 11 Mar 2004 02:00:25 -0000 1.3 --- GLXTimer.pas 12 Mar 2004 07:31:20 -0000 1.4 *************** *** 3,7 **** // GLXTreem // // // ! // Date : 2004-03- 08 // // // // The contents of this file are used with permission, subject to // --- 3,7 ---- // GLXTreem // // // ! // Date : 2004-03-08 // // // // The contents of this file are used with permission, subject to // *************** *** 22,26 **** @author(Andreas Lago: an...@li...) @created(Mar 8, 2004) ! @lastmod(Mar 8, 2004) } unit GLXTimer; --- 22,26 ---- @author(Andreas Lago: an...@li...) @created(Mar 8, 2004) ! @lastmod(Mar 12, 2004) } unit GLXTimer; *************** *** 32,38 **** { The type of event that is called by the timer. } ! Type ! TGLXTimerEvent = procedure(Sender: TObject; FrameTime: Single) of object; ! PGLXTimerEvent = ^TGLXTimerEvent; --- 32,36 ---- { The type of event that is called by the timer. } ! Type TGLXTimerEvent = procedure(Sender: TObject; FrameTime: Single) of object; *************** *** 44,50 **** full speed.<br> <br> - When reacing 500-1000 fps the movement can become somewhat chompy to solve this - just set the interval to a non-zero value.<br> - <br> <b>Note</b> that when using the timer the CPU utilization will raise to 100% even when the interval is higher than zero, this is normal.<br> --- 42,45 ---- *************** *** 58,78 **** FInterval : Cardinal; FInitialized : Boolean; - FEventList : TList; FFrequency : Int64; // Time FAppStart : Single; FLastTime : Single; - FSuspendTime : Single; // Frame information FFrameTimes : Single; FFrameCount : Int64; ! FFrameRate : Single; FFrameRateCounter: Integer; FFrameRateTime : Single; ! function GetCount:Single; ! function GetElapsedTime:Single; function AppProc(var Message: TMessage): Boolean; procedure AppIdle(Sender: TObject; var Done: Boolean); --- 53,76 ---- FInterval : Cardinal; FInitialized : Boolean; FFrequency : Int64; + // Event + FOnTimer : TGLXTimerEvent; + // Time FAppStart : Single; FLastTime : Single; // Frame information FFrameTimes : Single; FFrameCount : Int64; ! FFrameRate : Integer; FFrameRateCounter: Integer; FFrameRateTime : Single; ! function GetCurrentTime: Single; ! function GetElapsedTime: Single; ! ! function AppProc(var Message: TMessage): Boolean; procedure AppIdle(Sender: TObject; var Done: Boolean); *************** *** 87,96 **** procedure SetInterval (Value: Cardinal); protected - { Protected declarations } - {@exclude} procedure Loaded; override; public - { Public declarations } {@exclude} constructor Create(AOwner: TComponent); override; --- 85,91 ---- *************** *** 98,109 **** destructor Destroy; override; - { TGLXDraw or other objects that want to be notified by the Timer subscribe here. } - procedure Subscribe(Event:TGLXTimerEvent); - { TGLXDraw or other objects that no longer want to be notified by the Timer unsubscribe here. } - procedure UnSubscribe(Event:TGLXTimerEvent); - - { The current framerate, is weighted over the last 500 ms. } ! property FrameRate : Single read FFrameRate; { The number of frames rendered since program start. } property FrameCount : Int64 read FFrameCount; --- 93,98 ---- destructor Destroy; override; { The current framerate, is weighted over the last 500 ms. } ! property FrameRate : Integer read FFrameRate; { The number of frames rendered since program start. } property FrameCount : Int64 read FFrameCount; *************** *** 117,122 **** --- 106,115 ---- { This tells if the timer shall be disabled when the window loses focus. } property ActiveOnly : Boolean read FActiveOnly write SetActiveOnly; + { The main timer event, this is called with the interval in milliseconds. } + property OnTimer : TGLXTimerEvent read FOnTimer write FOnTimer; end; + + implementation *************** *** 129,133 **** begin inherited Create(AOwner); - FEventList := TList.Create; FActiveOnly:= True; FActive := True; --- 122,125 ---- *************** *** 137,141 **** QueryPerformanceFrequency(FFrequency); ! FAppStart :=GetCount; FFramerateTime :=FAppStart; FLastTime :=FAppStart; --- 129,133 ---- QueryPerformanceFrequency(FFrequency); ! FAppStart :=GetCurrentTime; FFramerateTime :=FAppStart; FLastTime :=FAppStart; *************** *** 150,198 **** Finalize; Application.UnHookMainWindow(AppProc); - FEventList.Free; inherited ; end; - //------------------------------------------------------------------------------ - procedure TGLXTimer.Subscribe(Event:TGLXTimerEvent); - var - NewEvent : PGLXTimerEvent; - begin - New(NewEvent); - NewEvent^:=Event; - FEventList.Add(NewEvent); - end; - - //------------------------------------------------------------------------------ - procedure TGLXTimer.UnSubscribe(Event:TGLXTimerEvent); - var - i : Integer; - TestEvent : TGLXTimerEvent; - begin - if FEventList.Count>0 then begin - i:=0; - repeat - TestEvent:=PGLXTimerEvent(FEventList.Items[i])^; - if (@TestEvent=@Event) then begin - Dispose(PGLXTimerEvent(FEventList.Items[i])); - FEventList.Delete(i); - i := 0; - end else Inc(i); - until (i>=FEventList.Count); - end; - end; - //------------------------------------------------------------------------------ procedure TGLXTimer.AppIdle(Sender: TObject; var Done: Boolean); ! var ! FrameTime, FrameRateTime: Single; ! i: Integer; ! Event : TGLXTimerEvent; begin Done := False; ! FrameTime := (GetCount - FLastTime); IF (FrameTime >= FInterval) then begin ! FLastTime:=GetCount; Inc(FFramerateCounter); --- 142,158 ---- Finalize; Application.UnHookMainWindow(AppProc); inherited ; end; //------------------------------------------------------------------------------ procedure TGLXTimer.AppIdle(Sender: TObject; var Done: Boolean); ! var FrameTime : Single; ! var FrameRateTime: Single; begin Done := False; ! FrameTime := (GetCurrentTime - FLastTime); IF (FrameTime >= FInterval) then begin ! FLastTime:=GetCurrentTime; Inc(FFramerateCounter); *************** *** 203,213 **** FFrameRate := Round(1000/(FrameRateTime/FFramerateCounter)); FFramerateCounter := 0; ! FFramerateTime := GetCount(); end; ! for i:=0 to FEventList.Count-1 do begin ! Event:=PGLXTimerEvent(FEventList.Items[i])^; ! if Assigned(Event) then Event(Self,FrameTime); ! end; FFrameTimes:=FrameTime; --- 163,170 ---- FFrameRate := Round(1000/(FrameRateTime/FFramerateCounter)); FFramerateCounter := 0; ! FFramerateTime := GetCurrentTime(); end; ! if Assigned(FOnTimer) then FOnTimer(Self, (FFrameTimes + FrameTime) / 2); FFrameTimes:=FrameTime; *************** *** 242,247 **** procedure TGLXTimer.Finalize; begin ! if FInitialized then ! begin Suspend; FInitialized := False; --- 199,203 ---- procedure TGLXTimer.Finalize; begin ! if FInitialized then begin Suspend; FInitialized := False; *************** *** 260,265 **** procedure TGLXTimer.Resume; begin ! FLastTime:=GetCount; ! // FAppStart:=FAppStart+ (FLastTime-FSuspendTime); Application.OnIdle:= AppIdle; --- 216,221 ---- procedure TGLXTimer.Resume; begin ! // FAppStart:=FAppStart + (GetCurrentTime-FSuspendTime); ! FLastTime:=GetCurrentTime; Application.OnIdle:= AppIdle; *************** *** 269,273 **** procedure TGLXTimer.Suspend; begin ! FSuspendTime:=GetCount; Application.OnIdle:= nil; end; --- 225,229 ---- procedure TGLXTimer.Suspend; begin ! // FSuspendTime:=GetCurrentTime; Application.OnIdle:= nil; end; *************** *** 302,318 **** end; //------------------------------------------------------------------------------ ! function TGLXTimer.GetCount:Single; ! var ! t : Int64; begin ! QueryPerformanceCounter(t); ! result:=1000*t/FFrequency; end; //------------------------------------------------------------------------------ ! function TGLXTimer.GetElapsedTime:Single; begin ! Result:=GetCount() - FAppStart; end; --- 258,275 ---- end; + + //------------------------------------------------------------------------------ ! function TGLXTimer.GetCurrentTime: Single; ! var Time : Int64; begin ! QueryPerformanceCounter(Time); ! Result:= (Time / FFrequency) * 1000; end; //------------------------------------------------------------------------------ ! function TGLXTimer.GetElapsedTime: Single; begin ! Result:=GetCurrentTime - FAppStart; end; |
|
From: <dan...@us...> - 2004-03-11 02:18:48
|
Update of /cvsroot/glxtreem/GLXtreem/Source In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27469/Source Modified Files: GLXTimer.pas Log Message: Changed the timer so that it uses the PerformanceCounter Index: GLXTimer.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/GLXTimer.pas,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** GLXTimer.pas 11 Mar 2004 01:16:00 -0000 1.2 --- GLXTimer.pas 11 Mar 2004 02:00:25 -0000 1.3 *************** *** 59,76 **** FInitialized : Boolean; FEventList : TList; // Time ! FAppStart : DWord; ! FLastTime : DWord; ! FSuspendTime: DWord; // Frame information FFrameTimes : Single; FFrameCount : Int64; ! FFrameRate : Integer; FFrameRateCounter: Integer; ! FFrameRateTime : DWord; ! function GetElapsedTime: DWord; function AppProc(var Message: TMessage): Boolean; procedure AppIdle(Sender: TObject; var Done: Boolean); --- 59,78 ---- FInitialized : Boolean; FEventList : TList; + FFrequency : Int64; // Time ! FAppStart : Single; ! FLastTime : Single; ! FSuspendTime : Single; // Frame information FFrameTimes : Single; FFrameCount : Int64; ! FFrameRate : Single; FFrameRateCounter: Integer; ! FFrameRateTime : Single; ! function GetCount:Single; ! function GetElapsedTime:Single; function AppProc(var Message: TMessage): Boolean; procedure AppIdle(Sender: TObject; var Done: Boolean); *************** *** 103,111 **** { The current framerate, is weighted over the last 500 ms. } ! property FrameRate : Integer read FFrameRate; { The number of frames rendered since program start. } property FrameCount : Int64 read FFrameCount; { The time elapsed since program start, in milliseconds. } ! property ElapsedTime: DWord read GetElapsedTime; published { Determines if the timer shall be active or not. } --- 105,113 ---- { The current framerate, is weighted over the last 500 ms. } ! property FrameRate : Single read FFrameRate; { The number of frames rendered since program start. } property FrameCount : Int64 read FFrameCount; { The time elapsed since program start, in milliseconds. } ! property ElapsedTime: Single read GetElapsedTime; published { Determines if the timer shall be active or not. } *************** *** 134,138 **** Application.HookMainWindow(AppProc); ! FAppStart :=GetTickCount; FFramerateTime :=FAppStart; FLastTime :=FAppStart; --- 136,141 ---- Application.HookMainWindow(AppProc); ! QueryPerformanceFrequency(FFrequency); ! FAppStart :=GetCount; FFramerateTime :=FAppStart; FLastTime :=FAppStart; *************** *** 184,197 **** procedure TGLXTimer.AppIdle(Sender: TObject; var Done: Boolean); var ! FrameTime, FrameRateTime: DWord; ! Compensate: DWord; i: Integer; Event : TGLXTimerEvent; begin ! Done := False; ! FrameTime:=(GetTickCount - FLastTime); IF (FrameTime >= FInterval) then begin ! ! FLastTime:=GetTickCount; Inc(FFramerateCounter); --- 187,198 ---- procedure TGLXTimer.AppIdle(Sender: TObject; var Done: Boolean); var ! FrameTime, FrameRateTime: Single; i: Integer; Event : TGLXTimerEvent; begin ! Done := False; ! FrameTime := (GetCount - FLastTime); IF (FrameTime >= FInterval) then begin ! FLastTime:=GetCount; Inc(FFramerateCounter); *************** *** 200,221 **** IF FrameRateTime > 500 then begin IF FFramerateCounter = 0 then FFramerateCounter:=1; ! FFrameRate:=Round(1000 / ((FLastTime - FFramerateTime) / FFramerateCounter)); ! ! FFramerateCounter:=0; ! FFramerateTime :=GetTickCount(); ! end; for i:=0 to FEventList.Count-1 do begin Event:=PGLXTimerEvent(FEventList.Items[i])^; ! if Assigned(Event) then Event(Self, (FFrameTimes + FrameTime) / 2); end; FFrameTimes:=FrameTime; - Compensate:=FrameTime - FInterval; - - IF Compensate > FInterval then Compensate:=FInterval; - - IF (FInterval <> 0) then FLastTime:=FLastTime - Compensate; - Inc(FFrameCount); end; --- 201,215 ---- IF FrameRateTime > 500 then begin IF FFramerateCounter = 0 then FFramerateCounter:=1; ! FFrameRate := Round(1000/(FrameRateTime/FFramerateCounter)); ! FFramerateCounter := 0; ! FFramerateTime := GetCount(); ! end; for i:=0 to FEventList.Count-1 do begin Event:=PGLXTimerEvent(FEventList.Items[i])^; ! if Assigned(Event) then Event(Self,FrameTime); end; FFrameTimes:=FrameTime; Inc(FFrameCount); end; *************** *** 266,270 **** procedure TGLXTimer.Resume; begin ! FLastTime:=GetTickCount; // FAppStart:=FAppStart+ (FLastTime-FSuspendTime); --- 260,264 ---- procedure TGLXTimer.Resume; begin ! FLastTime:=GetCount; // FAppStart:=FAppStart+ (FLastTime-FSuspendTime); *************** *** 275,279 **** procedure TGLXTimer.Suspend; begin ! FSuspendTime:=GetTickCount; Application.OnIdle:= nil; end; --- 269,273 ---- procedure TGLXTimer.Suspend; begin ! FSuspendTime:=GetCount; Application.OnIdle:= nil; end; *************** *** 309,315 **** //------------------------------------------------------------------------------ ! function TGLXTimer.GetElapsedTime: DWord; begin ! Result:=GetTickCount() - FAppStart; end; --- 303,318 ---- //------------------------------------------------------------------------------ ! function TGLXTimer.GetCount:Single; ! var ! t : Int64; begin ! QueryPerformanceCounter(t); ! result:=1000*t/FFrequency; ! end; ! ! //------------------------------------------------------------------------------ ! function TGLXTimer.GetElapsedTime:Single; ! begin ! Result:=GetCount() - FAppStart; end; |
|
From: <dan...@us...> - 2004-03-11 01:35:14
|
Update of /cvsroot/glxtreem/GLXtreem/Source In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18326/Source Modified Files: GLXDraws.pas Log Message: Made some changes so that you can have multiple GLXDraws on the form Index: GLXDraws.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/GLXDraws.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** GLXDraws.pas 10 Mar 2004 16:55:30 -0000 1.1 --- GLXDraws.pas 11 Mar 2004 01:16:53 -0000 1.2 *************** *** 195,200 **** { Protected declarations } {@exclude} - Procedure Render(FrameTime: Single); - {@exclude} procedure Paint; override; {@exclude} --- 195,198 ---- *************** *** 209,212 **** --- 207,212 ---- + {@exclude} + Procedure Render(FrameTime: Single); { Initializes OpenGL. } *************** *** 349,353 **** implementation - // Component TGLXDraw //============================================================================== --- 349,352 ---- *************** *** 381,386 **** IF (csDesigning in ComponentState) then Exit; - InitOpenGL; - if Assigned(FOnSetup) then FOnSetup(Self); --- 380,383 ---- *************** *** 432,435 **** --- 429,434 ---- Procedure TGLXDraw.Render(FrameTime: Single); begin + Activate; + If Assigned(Camera) then begin Camera.Style:= csPerspective; *************** *** 442,445 **** --- 441,446 ---- Flip; + + Deactivate; end; *************** *** 573,578 **** procedure TGLXDraw.SetTimer(const Value: TGLXTimer); begin FTimer := Value; ! IF Assigned(Timer) then Timer.OnTimer:=TimerEvent; end; --- 574,580 ---- procedure TGLXDraw.SetTimer(const Value: TGLXTimer); begin + IF Assigned(Timer) then Timer.Unsubscribe(TimerEvent); FTimer := Value; ! IF Assigned(Timer) then Timer.Subscribe(TimerEvent); end; *************** *** 943,946 **** --- 945,951 ---- + initialization + //Has to be initialized only once per Application + InitOpenGL; |
|
From: <dan...@us...> - 2004-03-11 01:34:22
|
Update of /cvsroot/glxtreem/GLXtreem/Source In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18104/Source Modified Files: GLXTimer.pas Log Message: Changed Timer so that multiple GLXDraws can subscribe to the same Timer Index: GLXTimer.pas =================================================================== RCS file: /cvsroot/glxtreem/GLXtreem/Source/GLXTimer.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** GLXTimer.pas 10 Mar 2004 16:55:30 -0000 1.1 --- GLXTimer.pas 11 Mar 2004 01:16:00 -0000 1.2 *************** *** 32,36 **** { The type of event that is called by the timer. } ! Type TGLXTimerEvent = procedure(Sender: TObject; FrameTime: Single) of object; --- 32,38 ---- { The type of event that is called by the timer. } ! Type ! TGLXTimerEvent = procedure(Sender: TObject; FrameTime: Single) of object; ! PGLXTimerEvent = ^TGLXTimerEvent; *************** *** 56,62 **** FInterval : Cardinal; FInitialized : Boolean; ! ! // Event ! FOnTimer : TGLXTimerEvent; // Time --- 58,62 ---- FInterval : Cardinal; FInitialized : Boolean; ! FEventList : TList; // Time *************** *** 96,99 **** --- 96,105 ---- destructor Destroy; override; + { TGLXDraw or other objects that want to be notified by the Timer subscribe here. } + procedure Subscribe(Event:TGLXTimerEvent); + { TGLXDraw or other objects that no longer want to be notified by the Timer unsubscribe here. } + procedure UnSubscribe(Event:TGLXTimerEvent); + + { The current framerate, is weighted over the last 500 ms. } property FrameRate : Integer read FFrameRate; *************** *** 109,114 **** { This tells if the timer shall be disabled when the window loses focus. } property ActiveOnly : Boolean read FActiveOnly write SetActiveOnly; - { The main timer event, this is called with the interval in milliseconds. } - property OnTimer : TGLXTimerEvent read FOnTimer write FOnTimer; end; --- 115,118 ---- *************** *** 123,126 **** --- 127,131 ---- begin inherited Create(AOwner); + FEventList := TList.Create; FActiveOnly:= True; FActive := True; *************** *** 142,153 **** Finalize; Application.UnHookMainWindow(AppProc); inherited ; end; //------------------------------------------------------------------------------ procedure TGLXTimer.AppIdle(Sender: TObject; var Done: Boolean); ! Var FrameTime, FrameRateTime: DWord; ! var Compensate: DWord; begin Done := False; --- 147,191 ---- Finalize; Application.UnHookMainWindow(AppProc); + FEventList.Free; inherited ; end; + //------------------------------------------------------------------------------ + procedure TGLXTimer.Subscribe(Event:TGLXTimerEvent); + var + NewEvent : PGLXTimerEvent; + begin + New(NewEvent); + NewEvent^:=Event; + FEventList.Add(NewEvent); + end; + + //------------------------------------------------------------------------------ + procedure TGLXTimer.UnSubscribe(Event:TGLXTimerEvent); + var + i : Integer; + TestEvent : TGLXTimerEvent; + begin + if FEventList.Count>0 then begin + i:=0; + repeat + TestEvent:=PGLXTimerEvent(FEventList.Items[i])^; + if (@TestEvent=@Event) then begin + Dispose(PGLXTimerEvent(FEventList.Items[i])); + FEventList.Delete(i); + i := 0; + end else Inc(i); + until (i>=FEventList.Count); + end; + end; + //------------------------------------------------------------------------------ procedure TGLXTimer.AppIdle(Sender: TObject; var Done: Boolean); ! var ! FrameTime, FrameRateTime: DWord; ! Compensate: DWord; ! i: Integer; ! Event : TGLXTimerEvent; begin Done := False; *************** *** 168,172 **** end; ! if Assigned(FOnTimer) then FOnTimer(Self, (FFrameTimes + FrameTime) / 2); FFrameTimes:=FrameTime; --- 206,213 ---- end; ! for i:=0 to FEventList.Count-1 do begin ! Event:=PGLXTimerEvent(FEventList.Items[i])^; ! if Assigned(Event) then Event(Self, (FFrameTimes + FrameTime) / 2); ! end; FFrameTimes:=FrameTime; |
|
From: <dan...@us...> - 2004-03-11 00:02:04
|
Update of /cvsroot/glxtreem/GLXtreem/Packages In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1043/Packages Added Files: GLXtreem_6.dpk GLXtreem_6.res Log Message: Added Package for Delphi6 --- NEW FILE: GLXtreem_6.dpk --- package GLXtreem_6; {$R *.res} {$R '..\Source\GLXTreem.dcr'} {$ALIGN 8} {$ASSERTIONS ON} {$BOOLEVAL OFF} {$DEBUGINFO ON} {$EXTENDEDSYNTAX ON} {$IMPORTEDDATA ON} {$IOCHECKS ON} {$LOCALSYMBOLS ON} {$LONGSTRINGS ON} {$OPENSTRINGS ON} {$OPTIMIZATION ON} {$OVERFLOWCHECKS OFF} {$RANGECHECKS OFF} {$REFERENCEINFO ON} {$SAFEDIVIDE OFF} {$STACKFRAMES OFF} {$TYPEDADDRESS OFF} {$VARSTRINGCHECKS ON} {$WRITEABLECONST OFF} {$MINENUMSIZE 1} {$IMAGEBASE $400000} {$DESCRIPTION 'GLXTreem - OpenGL for Delphi'} {$IMPLICITBUILD OFF} requires vcljpg, designide, rtl, vcl, vclx; contains dglOpenGL in '..\Source\dglOpenGL.pas', GLXCamera in '..\Source\GLXCamera.pas', GLXClasses in '..\Source\GLXClasses.pas', GLXDraws in '..\Source\GLXDraws.pas', GLXScreens in '..\Source\GLXScreens.pas', GLXTimer in '..\Source\GLXTimer.pas', GLXRegister in '..\Source\Designtime\GLXRegister.pas', GLXNotification in '..\Source\GLXNotification.pas', GLXPrimitives in '..\Source\GLXPrimitives.pas', GLXTexture in '..\Source\GLXTexture.pas'; end. --- NEW FILE: GLXtreem_6.res --- (This appears to be a binary file; contents omitted.) |
|
From: <an...@us...> - 2004-03-10 17:19:50
|
Update of /cvsroot/glxtreem/GLXtreem/Demos In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8141/Demos Added Files: Project1.dpr Project1.res Unit1.dfm Unit1.pas crate.bmp Log Message: --- NEW FILE: Project1.dpr --- program Project1; uses Forms, Unit1 in 'Unit1.pas' {Form1}, GLXPrimitives in '..\Source\GLXPrimitives.pas', GLXTexture in '..\Source\GLXTexture.pas', GLXScene in '..\Source\GLXScene.pas'; {$R *.res} begin Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end. --- NEW FILE: Project1.res --- (This appears to be a binary file; contents omitted.) --- NEW FILE: Unit1.dfm --- object Form1: TForm1 Left = 275 Top = 112 Width = 870 Height = 640 Caption = 'Form1' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 object GLXDraw1: TGLXDraw Left = 0 Top = 0 Width = 862 Height = 606 Camera = GLXCamera1 Timer = GLXTimer1 Options = [doInitialize, doAutosize] RenderOptions.ColorBits = 32 RenderOptions.ZBits = 16 RenderOptions.StencilBits = 0 RenderOptions.AccumBits = 0 RenderOptions.AuxBuffers = 0 RenderOptions.doDepthTest = True RenderOptions.doWireframe = False RenderOptions.doTexturing = True RenderOptions.doBlending = False RenderOptions.doCulling = False RenderOptions.doLineStripple = False OnSetup = GLXDraw1Setup OnInitialize = GLXDraw1Initialize OnRender = GLXDraw1Render SurfaceWidth = 862 SurfaceHeight = 606 Align = alClient end object GLXCamera1: TGLXCamera Position.Z = -3.000000000000000000 MouseEnabled = False FarPlane = 1000.000000000000000000 NearPlane = 0.100000001490116100 FOV = 45.000000000000000000 Style = csPerspective Mode = cmTranslateFirst Left = 96 Top = 20 end object GLXTimer1: TGLXTimer Enabled = True Interval = 0 ActiveOnly = True Left = 128 Top = 20 end end --- NEW FILE: Unit1.pas --- unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, GLXTimer, GLXCamera, GLXDraws, GLXTexture, GLXClasses; type TForm1 = class(TForm) GLXDraw1: TGLXDraw; GLXCamera1: TGLXCamera; GLXTimer1: TGLXTimer; procedure GLXDraw1Setup(Sender: TObject); procedure GLXDraw1Render(Sender: TObject; FrameTime: Single); procedure GLXDraw1Initialize(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } Texture: TGLXTexture; end; var Form1: TForm1; implementation {$R *.dfm} Uses dglOpenGL, GLXPrimitives; //------------------------------------------------------------------------------ procedure TForm1.GLXDraw1Setup(Sender: TObject); begin end; //------------------------------------------------------------------------------ procedure DrawCube(x,y,z,width,height,deapth: glFloat); var w,h,d: glFloat; begin w:=Width / 2; h:=Height / 2; d:=Deapth / 2; glBegin(GL_QUADS); // Front Face glNormal3f(0.0, 0.0, 1.0); glTexCoord2f(0,0); glVertex3f(x-w, y-h, z+d); glTexCoord2f(1,0); glVertex3f(x+w, y-h, z+d); glTexCoord2f(1,1); glVertex3f(x+w, y+h, z+d); glTexCoord2f(0,1); glVertex3f(x-w, y+h, z+d); // Back Face glNormal3f( 0.0, 0.0,-1.0); glTexCoord2f(1,0); glVertex3f(x-w, y-h, z-d); glTexCoord2f(1,1); glVertex3f(x-w, y+h, z-d); glTexCoord2f(0,1); glVertex3f(x+w, y+h, z-d); glTexCoord2f(0,0); glVertex3f(x+w, y-h, z-d); // Top Face glNormal3f( 0.0, 1.0, 0.0); glTexCoord2f(0,0); glVertex3f(x-w, y+h, z-d); glTexCoord2f(0,1); glVertex3f(x-w, y+h, z+d); glTexCoord2f(1,1); glVertex3f(x+w, y+h, z+d); glTexCoord2f(1,0); glVertex3f(x+w, y+h, z-d); // Bottom Face glNormal3f( 0.0,-1.0, 0.0); glTexCoord2f(1,1); glVertex3f(x-w, y-h, z-d); glTexCoord2f(0,1); glVertex3f(x+w, y-h, z-d); glTexCoord2f(0,0); glVertex3f(x+w, y-h, z+d); glTexCoord2f(1,0); glVertex3f(x-w, y-h, z+d); // Right face glNormal3f( 1.0, 0.0, 0.0); glTexCoord2f(1,0); glVertex3f(x+w, y-h, z-d); glTexCoord2f(1,1); glVertex3f(x+w, y+h, z-d); glTexCoord2f(0,1); glVertex3f(x+w, y+h, z+d); glTexCoord2f(0,0); glVertex3f(x+w, y-h, z+d); // Left Face glNormal3f(-1.0, 0.0, 0.0); glTexCoord2f(0,0); glVertex3f(x-w, y-h, z-d); glTexCoord2f(1,0); glVertex3f(x-w, y-h, z+d); glTexCoord2f(1,1); glVertex3f(x-w, y+h, z+d); glTexCoord2f(0,1); glVertex3f(x-w, y+h, z-d); glEnd(); end; //------------------------------------------------------------------------------ procedure TForm1.GLXDraw1Initialize(Sender: TObject); begin //GLXCamera1.doLookAt(0,0.1, 2, 0, 0.1, 4); //GLXCamera1.Position.X:=GLXCamera1.Position.X; //GLXCamera1.Rotation.Y:=GLXCamera1.Rotation.Y; end; //------------------------------------------------------------------------------ procedure TForm1.GLXDraw1Render(Sender: TObject; FrameTime: Single); begin GLXCamera1.Style:= csPerspective; { glBegin(GL_LINES); glColor3f(1.0, 0.0, 0.0); glVertex3d(-100, 0, 0); glVertex3d(100, 0, 0); glColor3f(0.0, 1.0, 0.0); glVertex3d( 0,-100, 0); glVertex3d( 0, 100, 0); glColor3f(0.0, 0.0, 1.0); glVertex3d( 0, 0, -100); glVertex3d( 0, 0, 100); glEnd; glColor3f(1.0, 1.0, 1.0); } { glPushMatrix(); glTranslatef(-1.0, 0, 0); Primitives.Render(ptCube); glPopMatrix(); } Primitives.Primitive:=ptCube; Primitives.Position:=Vector3f(-1, 0, 0); Primitives.Size :=Vector3f( 2, 2, 2); Primitives.Render; GLXCamera1.Style:= csOrthogonal; GLXDraw1.RenderOptions.doTexturing:=False; glBegin(GL_QUADS); glColor3f(1.0, 0.0, 0.0); glVertex2d(100, 100); glColor3f(1.0, 1.0, 0.0); glVertex2d(200, 100); glColor3f(0.0, 1.0, 0.0); glVertex2d(200, 200); glColor3f(1.0, 0.0, 1.0); glVertex2d(100, 200); glEnd; GLXDraw1.RenderOptions.doTexturing:=True; GLXCamera1.Style:= csPerspective; glColor3f(1.0, 1.0, 1.0); glPushMatrix(); glTranslatef(1.0, 0, 0); Primitives.Render(ptPyramid); glPopMatrix(); GLXCamera1.doRotate(aY, FrameTime / 100); GLXCamera1.doRotate(aX, FrameTime / 50); Caption:=Format('GLXTreem [%d FPS]', [ GLXTimer1.FrameRate]); end; //------------------------------------------------------------------------------ procedure TForm1.FormCreate(Sender: TObject); begin Texture:= TGLXTexture.Create; Texture.LoadTexture('crate.bmp'); end; end. --- NEW FILE: crate.bmp --- (This appears to be a binary file; contents omitted.) |
|
From: <an...@us...> - 2004-03-10 17:18:55
|
Update of /cvsroot/glxtreem/GLXtreem/Demos In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7957/Demos Log Message: Directory /cvsroot/glxtreem/GLXtreem/Demos added to the repository |
|
From: <an...@us...> - 2004-03-10 17:17:50
|
Update of /cvsroot/glxtreem/GLXtreem/Source/GraphicEx In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7700/Source/GraphicEx Added Files: GraphicColor.pas GraphicCompression.pas GraphicConfiguration.inc GraphicEx.pas GraphicStrings.pas GraphicStringsDE.pas GraphicStringsFR.pas GraphicStringsRU.pas JPG.pas MZLib.pas Log Message: --- NEW FILE: GraphicColor.pas --- unit GraphicColor; // The contents of this file are subject to the Mozilla Public License // Version 1.1 (the "License"); you may not use this file except in compliance // with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ // // Software distributed under the License is distributed on an "AS IS" basis, // WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the // specific language governing rights and limitations under the License. // // The original code is GraphicColor.pas, released November 1, 1999. // // The initial developer of the original code is Dipl. Ing. Mike Lischke (Pleißa, Germany, www.delphi-gems.com), // // Portions created by Dipl. Ing. Mike Lischke are Copyright // (C) 1999-2003 Dipl. Ing. Mike Lischke. All Rights Reserved. //---------------------------------------------------------------------------------------------------------------------- // This file is part of the image library GraphicEx. // [...4467 lines suppressed...] begin // there must always be at least one value in an open array FYCbCrCoefficients[0] := Values[0]; if High(Values) > 0 then begin FYCbCrCoefficients[1] := Values[1]; if High(Values) > 1 then FYCbCrCoefficients[2] := Values[2]; end; // subsampling can be 1, 2 or 4 and vertical subsampling must always be <= horizontal subsampling if not (HSubSampling in [1, 2, 4]) then Error(gesInvalidSubSampling); if not (VSubSampling in [1, 2, 4]) then Error(gesInvalidSubSampling); if VSubSampling > HSubSampling then Error(gesVerticalSubSamplingError); FHSubSampling := HSubSampling; FVSubSampling := VSubSampling; end; //---------------------------------------------------------------------------------------------------------------------- end. --- NEW FILE: GraphicCompression.pas --- unit GraphicCompression; // The contents of this file are subject to the Mozilla Public License // Version 1.1 (the "License"); you may not use this file except in compliance // with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ // // Software distributed under the License is distributed on an "AS IS" basis, // WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the // specific language governing rights and limitations under the License. // // The original code is GraphicColor.pas, released November 1, 1999. // // The initial developer of the original code is Dipl. Ing. Mike Lischke (Pleißa, Germany, www.delphi-gems.com), // // Portions created by Dipl. Ing. Mike Lischke are Copyright // (C) 1999-2003 Dipl. Ing. Mike Lischke. All Rights Reserved. //---------------------------------------------------------------------------------------------------------------------- // This file is part of the image library GraphicEx. // [...2713 lines suppressed...] if Assigned(PCDTable[I]) then FreeMem(PCDTable[I]); Dec(PByte(RangeLimit), 255); if Assigned(RangeLimit) then FreeMem(RangeLimit); end; finally if Assigned(Buffer) then FreeMem(Buffer); end; end; //---------------------------------------------------------------------------------------------------------------------- procedure TPCDDecoder.Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal); begin end; //---------------------------------------------------------------------------------------------------------------------- end. --- NEW FILE: GraphicConfiguration.inc --- // The contents of this file are subject to the Mozilla Public License // Version 1.1 (the "License"); you may not use this file except in compliance // with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ // // Software distributed under the License is distributed on an "AS IS" basis, // WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the // specific language governing rights and limitations under the License. // // The original code is GraphicColor.pas, released November 1, 1999. // // The initial developer of the original code is Dipl. Ing. Mike Lischke (Pleißa, Germany, www.delphi-gems.com), // // Portions created by Dipl. Ing. Mike Lischke are Copyright // (C) 1999-2003 Dipl. Ing. Mike Lischke. All Rights Reserved. //---------------------------------------------------------------------------------------------------------------------- // This file is part of the image library GraphicEx. // // In this configuratin file you can determine which parts of the library are to be compiled. // This is in particular important for LZW compression code for which Unisys owns a patent. // If you want to use LZW decoding then you have to make a deal with Unisys. Don't make me // responsible for using the code. // Other configuration options include to limit the number of available image formats to // save memory, if necessary. // //---------------------------------------------------------------------------------------------------------------------- {.$define UseLZW} // if this is not defined (default) then neither the GIF format nor the // LZW compression decoder (e.g. for TIFF LZW compression) is available // Pick your preferred image formats here or leave them all enabled. By disabling // certain formats which are not of interest you can save some memory. {$define SGIGraphic} // *.bw, *.rgb, *.rgba, *.sgi images are supported {$define AutodeskGraphic} // *.cel, *.pic images {$define TIFFGraphic} // *.tif, *.tiff images {$define TargaGraphic} // *.tga, *.vst, *.icb, *.vda, *.win images {$define PCXGraphic} // *.pcx, *.pcc, *.scr images {$define PCDGraphic} // *.pcd images {$define PortableMapGraphic} // *.ppm, *.pgm, *.pbm images {$define CUTGraphic} // *.cut (+ *.pal) images {$define GIFGraphic} // *.gif images {$define RLAGraphic} // *.rla, *.rpf images {$define PhotoshopGraphic} // *.psd, *.pdd images {$define PaintshopProGraphic} // *.psp images {$define PortableNetworkGraphic} // *.png images {$define EPSGraphic} // *.eps images // adjust dependent definitions {$ifndef UseLZW} {$undef GIFGraphic} {$endif} {$ifndef TIFFGraphic} {$undef EPSGraphic} {$endif} --- NEW FILE: GraphicEx.pas --- unit GraphicEx; // The contents of this file are subject to the Mozilla Public License // Version 1.1 (the "License"); you may not use this file except in compliance // with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ // // Software distributed under the License is distributed on an "AS IS" basis, // WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the // specific language governing rights and limitations under the License. // // The original code is GraphicColor.pas, released November 1, 1999. // // The initial developer of the original code is Dipl. Ing. Mike Lischke (Pleißa, Germany, www.delphi-gems.com), // // Portions created by Dipl. Ing. Mike Lischke are Copyright // (C) 1999-2003 Dipl. Ing. Mike Lischke. All Rights Reserved. //---------------------------------------------------------------------------------------------------------------------- // // GraphicEx - [...8106 lines suppressed...] {$ifdef PaintshopProGraphic} UnregisterFileFormat('', TPSPGraphic); {$endif} {$ifdef PhotoshopGraphic} UnregisterFileFormat('', TPSDGraphic); {$endif} {$ifdef TargaGraphic} UnregisterFileFormat('', TTargaGraphic); {$endif} {$ifdef TIFFGraphic} UnregisterFileFormat('', TTIFFGraphic); {$endif} {$ifdef SGIGraphic} UnregisterFileFormat('', TSGIGraphic); {$endif} {$ifdef PCXGraphic} UnregisterFileFormat('', TPCXGraphic); {$endif} {$ifdef AutodeskGraphic} UnregisterFileFormat('', TAutodeskGraphic); {$endif} {$ifdef PCDGraphic} UnregisterFileFormat('', TPCDGraphic); {$endif} {$ifdef PortableMapGraphic} UnregisterFileFormat('', TPPMGraphic); {$endif} {$ifdef CUTGraphic} UnregisterFileFormat('', TCUTGraphic); {$endif} {$ifdef GIFGraphic} UnregisterFileFormat('', TGIFGraphic); {$endif} {$ifdef RLAGraphic} UnregisterFileFormat('', TRLAGraphic); {$endif} UnregisterFileFormat('rle', TBitmap); UnregisterFileFormat('dib', TBitmap); {$ifdef PortableNetworkGraphic} UnregisterFileFormat('', TPNGGraphic); {$endif} Free; end; end. --- NEW FILE: GraphicStrings.pas --- unit GraphicStrings; // The contents of this file are subject to the Mozilla Public License // Version 1.1 (the "License"); you may not use this file except in compliance // with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ // // Software distributed under the License is distributed on an "AS IS" basis, // WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the // specific language governing rights and limitations under the License. // // The original code is GraphicColor.pas, released November 1, 1999. // // The initial developer of the original code is Dipl. Ing. Mike Lischke (Pleißa, Germany, www.delphi-gems.com), // // Portions created by Dipl. Ing. Mike Lischke are Copyright // (C) 1999-2003 Dipl. Ing. Mike Lischke. All Rights Reserved. //---------------------------------------------------------------------------------------------------------------------- // This file is part of the image library GraphicEx. // // GraphicStrings contains the strings used in GraphicEx, which could be localized. // //---------------------------------------------------------------------------------------------------------------------- interface {$I GraphicConfiguration.inc} resourcestring // image file descriptions gesAllImages = 'All images'; gesRegistration = 'Attempt to register %s twice.'; gesBitmaps = 'Windows bitmaps'; gesRLEBitmaps = 'Run length encoded Windows bitmaps'; gesDIBs = 'Device independant Windows bitmaps'; gesEPS = 'Encapsulated Postscript images'; gesIcons = 'Windows icons'; gesMetaFiles = 'Windows metafiles'; gesEnhancedMetaFiles = 'Windows enhanced meta files'; gesJPGImages = 'JPG images'; gesJPEGImages = 'JPEG images'; gesJPEImages = 'JPE images'; gesJFIFImages = 'JFIF images'; gesTruevision = 'Truevision images'; gesTIFF = 'Tagged image file format images'; gesMacTIFF = 'Macintosh TIFF images'; gesPCTIF = 'PC TIF images'; gesGFIFax = 'GFI fax images'; gesSGI = 'SGI images'; gesSGITrueColor = 'SGI true color images'; gesZSoft = 'ZSoft Paintbrush images'; gesZSoftWord = 'Word 5.x screen capture images'; gesAliasWaveFront = 'Alias/Wavefront images'; gesSGITrueColorAlpha = 'SGI true color images with alpha'; gesSGIMono = 'SGI black/white images'; gesPhotoshop = 'Photoshop images'; gesPortable = 'Portable map images'; gesPortablePixel = 'Portable pixel map images'; gesPortableGray = 'Portable gray map images'; gesPortableMono = 'Portable bitmap images'; gesAutoDesk = 'Autodesk images'; gesKodakPhotoCD = 'Kodak Photo-CD images'; gesCompuserve = 'CompuServe images'; gesHalo = 'Dr. Halo images'; gesPaintShopPro = 'Paintshop Pro images'; gesPortableNetworkGraphic = 'Portable network graphic images'; // image specific error messages gesInvalidImage = 'Cannot load image. Invalid or unexpected %s image format.'; gesInvalidColorFormat = 'Invalid color format in %s file.'; gesStreamReadError = 'Stream read error in %s file.'; gesUnsupportedImage = 'Cannot load image. Unsupported %s image format.'; gesUnsupportedFeature = 'Cannot load image. %s not supported for %s files.'; gesInvalidCRC = 'Cannot load image. CRC error found in %s file.'; gesCompression = 'Cannot load image. Compression error found in %s file.'; gesExtraCompressedData = 'Cannot load image. Extra compressed data found in %s file.'; gesInvalidPalette = 'Cannot load image. Palette in %s file is invalid.'; gesUnknownCriticalChunk = 'Cannot load PNG image. Unexpected but critical chunk detected.'; // features (usually used together with unsupported feature string) gesCompressionScheme = 'The compression scheme is'; gesRLAPixelFormat = 'Image formats other than RGB and RGBA are'; gesPSPFileType = 'File versions other than 3 or 4 are'; // color manager error messages gesIndexedNotSupported = 'Conversion between indexed and non-indexed pixel formats is not supported.'; gesConversionUnsupported = 'Color conversion failed. Could not find a proper method.'; gesInvalidSampleDepth = 'Color depth is invalid. Bits per sample must be 1, 2, 4, 8 or 16.'; gesInvalidPixelDepth = 'Sample count per pixel does not correspond to the given color scheme.'; gesInvalidSubSampling = 'Subsampling value is invalid. Allowed are 1, 2 and 4.'; gesVerticalSubSamplingError = 'Vertical subsampling value must be <= horizontal subsampling value.'; // progress strings gesPreparing = 'Preparing...'; gesLoadingData = 'Loading data...'; gesUpsampling = 'Upsampling...'; gesTransfering = 'Transfering...'; // compression errors gesLZ77Error = 'LZ77 decompression error.'; gesJPEGEOI = 'JPEG decompression error. Unexpected end of input.'; gesJPEGStripSize = 'Improper JPEG strip/tile size.'; gesJPEGComponentCount = 'Improper JPEG component count.'; gesJPEGDataPrecision = 'Improper JPEG data precision.'; gesJPEGSamplingFactors = 'Improper JPEG sampling factors.'; gesJPEGBogusTableField = 'Bogus JPEG tables field.'; gesJPEGFractionalLine = 'Fractional JPEG scanline unsupported.'; // miscellaneous gesWarning = 'Warning'; //---------------------------------------------------------------------------------------------------------------------- implementation //---------------------------------------------------------------------------------------------------------------------- end. --- NEW FILE: GraphicStringsDE.pas --- unit GraphicStrings; // The contents of this file are subject to the Mozilla Public License // Version 1.1 (the "License"); you may not use this file except in compliance // with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ // // Software distributed under the License is distributed on an "AS IS" basis, // WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the // specific language governing rights and limitations under the License. // // The original code is GraphicColor.pas, released November 1, 1999. // // The initial developer of the original code is Dipl. Ing. Mike Lischke (Pleißa, Germany, www.delphi-gems.com), // // Portions created by Dipl. Ing. Mike Lischke are Copyright // (C) 1999-2003 Dipl. Ing. Mike Lischke. All Rights Reserved. //---------------------------------------------------------------------------------------------------------------------- // This file is part of the image library GraphicEx. // // GraphicStrings contains the strings used in GraphicEx which could be localized. // Rename the file to GraphicStrings.pas to use it as your favourite language file. // // This is the german version of GraphicStrings. // //---------------------------------------------------------------------------------------------------------------------- interface {$I GraphicConfiguration.inc} resourcestring // image file descriptions gesAllImages = 'Alle Bilder'; gesRegistration = 'Das Format %s ist schon registriert.'; gesBitmaps = 'Windows bitmaps'; gesRLEBitmaps = 'Run length encoded Windows bitmaps'; gesDIBs = 'Geräteunabhängige Windows bitmaps'; gesEPS = 'Encapsulated Postscript Bilder'; gesIcons = 'Windows icons'; gesMetaFiles = 'Windows metafiles'; gesEnhancedMetaFiles = 'Windows erweiterte metafiles'; gesJPGImages = 'JPG Bilder'; gesJPEGImages = 'JPEG Bilder'; gesJPEImages = 'JPE Bilder'; gesJFIFImages = 'JFIF Bilder'; gesTruevision = 'Truevision Bilder'; gesTIFF = 'Tagged image file format'; gesMacTIFF = 'Macintosh TIFF Bilder'; gesPCTIF = 'PC TIF Bilder'; gesGFIFax = 'GFI FAX Dateien'; gesSGI = 'SGI Bilder'; gesSGITrueColor = 'SGI True Color Bilder'; gesZSoft = 'ZSoft Paintbrush Bilder'; gesZSoftWord = 'Word 5.x Snapschuss Bilder'; gesAliasWaveFront = 'Alias/Wavefront Bilder'; gesSGITrueColorAlpha = 'SGI True Color Bilder mit Transparenz'; gesSGIMono = 'SGI schwarz/weiss Bilder'; gesPhotoshop = 'Photoshop Bilder'; gesPortable = 'Portable map Bilder'; gesPortablePixel = 'Portable pixel map Bilder'; gesPortableGray = 'Portable gray map Bilder'; gesPortableMono = 'Portable bitmap Bilder'; gesAutoDesk = 'Autodesk Bilder'; gesKodakPhotoCD = 'Kodak Photo-CD Bilder'; gesCompuserve = 'CompuServe Bilder'; gesHalo = 'Dr. Halo Bilder'; gesPaintShopPro = 'Paintshop Pro Bilder'; gesPortableNetworkGraphic = 'Portable network graphic Bilder'; // image specific error messages gesInvalidImage = 'Bild konnte nicht geladen werden. Ungültiges oder unerwartetes %s Bildformat.'; gesInvalidColorFormat = 'Ungültiges Farbformat in %s Bild.'; gesStreamReadError = 'Stream Lesefehler in %s Datei.'; gesUnsupportedImage = 'Bild konnte nicht geladen werden. Nicht unterstütztes %s Bildformat.'; gesUnsupportedFeature = 'Bild konnte nicht geladen werden. %s nicht unterstützt für %s Dateien.'; gesInvalidCRC = 'Bild konnte nicht geladen werden. Ein CRC Fehler ist in der %s Datei aufgetreten.'; gesCompression = 'Bild konnte nicht geladen werden. Kompressionsfehler in %s Datei gefunden.'; gesExtraCompressedData = 'Bild konnte nicht geladen werden. Zuviele komprimierte Daten in %s Datei gefunden.'; gesInvalidPalette = 'Bild konnte nicht geladen werden. Palette in %s Datei ist ungültig.'; gesUnknownCriticalChunk = 'PNG Bild konnte nicht geladen werden. Unerwarteter, aber als kritisch markierter Chunk gefunden.'; // features (usually used together with unsupported feature string) gesCompressionScheme = 'Das Kompressionsformat ist'; gesRLAPixelFormat = 'Andere Bildformat, als RGB und RGBA werden'; gesPSPFileType = 'Andere Dateiversionen als 3 or 4 werden'; // color manager error messages gesIndexedNotSupported = 'Konvertierung zwischen indizierten und nicht-indizierten Formaten wird nicht unterstützt.'; gesConversionUnsupported = 'Farbkonvertierung schlug fehl. Es konnte keine passende Konvertierungsmethode gefunden werden.'; gesInvalidSampleDepth = 'Farbtiefe ist nicht gültig. Bits pro Sample muss 1, 2, 4, 8 oder 16 sein.'; gesInvalidPixelDepth = 'Sampleanzahl pro Pixel korrespondiert nicht zum angegebenen Farbschema.'; gesInvalidSubSampling = 'Subsampling Wert ist ungültig. Erlaubt sind 1, 2 und 4.'; gesVerticalSubSamplingError = 'Der vertikale Subsampling Wert muss kleiner oder gleich dem horizontalen Wert sein.'; // progress strings gesPreparing = 'Vorbereitung...'; gesLoadingData = 'Daten werden geladen...'; gesUpsampling = 'Upsampling...'; gesTransfering = 'Übertragung...'; // compression errors gesLZ77Error = 'LZ77 Dekompressionsfehler.'; gesJPEGEOI = 'JPEG Dekompressionsfehler. Unerwartetes Ende der Eingabedaten.'; gesJPEGStripSize = 'Unpassende JPEG Strip oder Tile Größe.'; gesJPEGComponentCount = 'Unpassende JPEG Komponentenanzahl'; gesJPEGDataPrecision = 'Unpassende JPEG Datengenauigkeit.'; gesJPEGSamplingFactors = 'Unpassende JPEG Samplingfaktoren.'; gesJPEGBogusTableField = 'Falsches JPEG Tabellenfeld gefunden.'; gesJPEGFractionalLine = 'Unvollständige JPEG Bildzeilen werden nicht understützt.'; // miscellaneous gesWarning = 'Warnung'; //---------------------------------------------------------------------------------------------------------------------- implementation //---------------------------------------------------------------------------------------------------------------------- end. --- NEW FILE: GraphicStringsFR.pas --- unit GraphicStrings; // The contents of this file are subject to the Mozilla Public License // Version 1.1 (the "License"); you may not use this file except in compliance // with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ // // Software distributed under the License is distributed on an "AS IS" basis, // WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the // specific language governing rights and limitations under the License. // // The original code is GraphicColor.pas, released November 1, 1999. // // The initial developer of the original code is Dipl. Ing. Mike Lischke (Pleißa, Germany, www.delphi-gems.com), // // Portions created by Dipl. Ing. Mike Lischke are Copyright // (C) 1999-2003 Dipl. Ing. Mike Lischke. All Rights Reserved. //---------------------------------------------------------------------------------------------------------------------- // This file is part of the image library GraphicEx. // // GraphicStrings contains the strings used in GraphicEx which could be localized. // Rename the file to GraphicStrings.pas to use it as your favourite language file. // // This is the french version of GraphicStrings. // //---------------------------------------------------------------------------------------------------------------------- interface {$I GraphicConfiguration.inc} resourcestring // image file descriptions gesAllImages = 'Toutes les images'; gesRegistration = 'Tentative de re-enregistrement des fichiers %s.'; gesBitmaps = 'Bitmaps Windows'; gesRLEBitmaps = 'Bitmaps Windows (Run length encoded)'; gesDIBs = 'Bitmaps Windows (Device independant)'; gesEPS = 'Images Postscript Encapsulées'; gesIcons = 'Icone Windows'; gesMetaFiles = 'Metafiles Windows'; gesEnhancedMetaFiles = 'Metafiles Windows améliorés'; gesJPGImages = 'Images JPG'; gesJPEGImages = 'Images JPEG'; gesJPEImages = 'Images JPE images'; gesJFIFImages = 'Images JFIF images'; gesTruevision = 'Images Truevision'; gesTIFF = 'Images Tagged image file format'; gesMacTIFF = 'Images TIFF Macintosh'; gesPCTIF = 'Images PC TIF'; gesGFIFax = 'Images GFI fax'; gesSGI = 'Images SGI'; gesSGITrueColor = 'Images SGI true color'; gesZSoft = 'Images ZSoft Paintbrush'; gesZSoftWord = 'Capture d''ecrant Word 5.x'; gesAliasWaveFront = 'Images Alias/Wavefront'; gesSGITrueColorAlpha = 'Images SGI true color avec canal alpha'; gesSGIMono = 'Images SGI noir/blanc'; gesPhotoshop = 'Images Photoshop'; gesPortable = 'Images Portable map'; gesPortablePixel = 'Images Portable pixel map'; gesPortableGray = 'Images Portable gray map'; gesPortableMono = 'Images Portable bitmap'; gesAutoDesk = 'Images Autodesk'; gesKodakPhotoCD = 'Images Kodak Photo-CD'; gesCompuserve = 'Images CompuServe'; gesHalo = 'Images Dr. Halo'; gesPaintShopPro = 'Images Paintshop Pro'; gesPortableNetworkGraphic = 'Images Portable network graphic'; // image specific error messages gesInvalidImage = 'Ne peux pas charger l''image. Format de fichier %s invalide ou inattendue.'; gesInvalidColorFormat = 'Format de couleur invalide dans le fichier %s.'; gesStreamReadError = 'Erreur de lecture de flux dans le fichier %s.'; gesUnsupportedImage = 'Ne peux pas charger l''image. Format de fichier %s non supporté.'; gesUnsupportedFeature = 'Ne peux pas charger l''image. %s pas supporté par les fichiers %s.'; gesInvalidCRC = 'Ne peux pas charger l''image. Erreur de CRC dans le fichier %s.'; gesCompression = 'Ne peux pas charger l''image. Erreur de compression dans le fichier %s.'; gesExtraCompressedData = 'Ne peux pas charger l''image. Surplus de données compressé trouvé dans le fichier %s.'; gesInvalidPalette = 'Ne peux pas charger l''image. La palette du fichier %s est invalide.'; gesUnknownCriticalChunk = 'Ne peux pas charger l''image PNG. Morceau inattendue, mais critique détecté.'; // features (usually used together with unsupported feature string) gesCompressionScheme = 'Le procédé de compression n''est'; gesRLAPixelFormat = 'Les format d''images différents de RGB ou RGBA ne sont'; gesPSPFileType = 'Les fichiers de version différents de 3 ou 4 ne sont'; // color manager error messages gesIndexedNotSupported = 'La conversion entre les formats de pixels indexé et non-indexé n''est pas supportée.'; gesConversionUnsupported = 'la conversion des couleurs a échoué. Méthode approprié non trouvé.'; gesInvalidSampleDepth = 'Profondeur des couleurs invalide. Elle doit être de 1, 2, 4, 8, or 16 bits par échantillon.'; gesInvalidPixelDepth = 'La profondeur des pixels de l''échantillon ne correspond pas au format des couleurs.'; gesInvalidSubSampling = 'Valeur du sous échantillon est invalide. Les valeurs correctes sont 1, 2 et 4.'; gesVerticalSubSamplingError = 'La valeur du sous échantillon vertical doit être <= à la valeur du sous échantillon horizontal.'; // progress strings gesPreparing = 'Préparation...'; gesLoadingData = 'Chargement des données...'; gesUpsampling = 'Upsampling...'; gesTransfering = 'Transfert...'; // compression errors gesLZ77Error = 'Erreur de décompressionLZ77.'; gesJPEGEOI = 'Erreur de décompression JPEG. Fin inattendue des entrées.'; gesJPEGStripSize = 'Traille strip/tile incorrecte.'; gesJPEGComponentCount = 'Nombre d''élément JPEG incorrecte.'; gesJPEGDataPrecision = 'Précision des données JPEG incorrecte.'; gesJPEGSamplingFactors = 'Echantillon JPEG invalides.'; gesJPEGBogusTableField = 'Champs de la table JPEG fantôme.'; gesJPEGFractionalLine = 'Fractional JPEG scanline non supportée.'; // miscellaneous gesWarning = 'Attention'; //---------------------------------------------------------------------------------------------------------------------- implementation //---------------------------------------------------------------------------------------------------------------------- end. --- NEW FILE: GraphicStringsRU.pas --- unit GraphicStrings; // The contents of this file are subject to the Mozilla Public License // Version 1.1 (the "License"); you may not use this file except in compliance // with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ // // Software distributed under the License is distributed on an "AS IS" basis, // WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the // specific language governing rights and limitations under the License. // // The original code is GraphicColor.pas, released November 1, 1999. // // The initial developer of the original code is Dipl. Ing. Mike Lischke (Pleißa, Germany, www.delphi-gems.com), // // Portions created by Dipl. Ing. Mike Lischke are Copyright // (C) 1999-2003 Dipl. Ing. Mike Lischke. All Rights Reserved. //---------------------------------------------------------------------------------------------------------------------- // This file is part of the image library GraphicEx. // // GraphicStrings contains the strings used in GraphicEx which could be localized. // Rename the file to GraphicStrings.pas to use it as your favourite language file. // // This is the russian version of GraphicStrings. // //---------------------------------------------------------------------------------------------------------------------- interface {$I GraphicConfiguration.inc} resourcestring // image file descriptions gesAllImages = 'Âñå èçîáðàæåíèÿ'; gesRegistration = 'Ïîïûòêà õàðåãèñòðèðîâàòü %s ôàéëû (äâàæäû).'; gesBitmaps = 'Windows áèòîâûå êàðòû'; gesRLEBitmaps = 'Run length çàêîäèðîâàííûå áèòîâûå êàðòû Windows'; gesDIBs = 'Áèòîâûå êàðòû Windows, íåçàâèñèìûå îò óñòðîéñòâà'; gesIcons = 'Ïèêòîãðàììû Windows'; gesMetaFiles = 'Ìåòàôàéëû Windows'; gesEnhancedMetaFiles = 'Ðàñøèðåííûå ìåòàôàéëû Windows'; gesJPGImages = 'Èçîáðàæåíèÿ JPG'; gesJPEGImages = 'Èçîáðàæåíèÿ JPEG'; gesTruevision = 'Èçîáðàæåíèÿ Truevision'; gesTIFF = 'Èçîáðàæåíèÿ ôîðìàòà TIFF'; gesMacTIFF = 'Èçîáðàæåíèÿ TIFF äëÿ Macintosh'; gesPCTIF = 'PC TIF èçîáðàæåíèÿ'; gesGFIFax = 'GFI fax images'; gesSGI = 'Èçîáðàæåíèÿ SGI'; gesSGITrueColor = 'Ïîëíîöâåòíûå èçîáðàæåíèÿ SGI'; gesZSoft = 'Èçîáðàæåíèÿ ZSoft Paintbrush'; gesZSoftWord = 'Ñíèìêè ýêðàíà Word 5.x'; gesAliasWaveFront = 'Èçîáðàæåíèÿ Alias/Wavefront'; gesSGITrueColorAlpha = 'Ïîëíîöâåòíûå èçîáðàæåíèÿ SGI ñ àëüôà-êàíàëîì'; gesSGIMono = '׸ðíî-áåëûå èçîáðàæåíèÿ SGI'; gesPhotoshop = 'Èçîáðàæåíèÿ Photoshop'; gesPortable = 'Èçîáðàæåíèÿ Portable map'; gesPortablePixel = 'Èçîáðàæåíèÿ Portable pixel map'; gesPortableGray = 'Èçîáðàæåíèÿ Portable gray map'; gesPortableMono = 'Èçîáðàæåíèÿ Portable bitmap'; gesAutoDesk = 'Èçîáðàæåíèÿ Autodesk'; gesKodakPhotoCD = 'Èçîáðàæåíèÿ Kodak Photo-CD'; gesCompuserve = 'Èçîáðàæåíèÿ CompuServe'; gesHalo = 'Èçîáðàæåíèÿ Dr. Halo'; gesPaintShopPro = 'Èçîáðàæåíèÿ Paintshop Pro'; gesPortableNetworkGraphic = 'Èçîáðàæåíèÿ Portable network graphic (PNG)'; // image specific error messages gesInvalidImage = 'Íåâîçìîæíî çàãðóæèòü èçîáðàæåíèå. Íåïðàâèëüíûé èëè íåïîääåðæèâàåìûé ôîðìàò èçîáðàæåíèÿ %s.'; gesInvalidColorFormat = 'Íåïðàâèëüíûé ôîðìàò öâåòà â ôàéëå %s.'; gesStreamReadError = 'Îøèáêà ÷òåíèÿ èç ïîòîêà â ôàéëå %s.'; gesUnsupportedImage = 'Íåâîçìîæíî çàãðóæèòü èçîáðàæåíèå. Íåïîääåðæèâàåìûé ôîðìàò èçîáðàæåíèÿ %s.'; gesUnsupportedFeature = 'Íåâîçìîæíî çàãðóæèòü èçîáðàæåíèå. %s íå ïîääåðæèâàåòñÿ äëÿ ôàéëîâ %s.'; gesInvalidCRC = 'Íåâîçìîæíî çàãðóæèòü èçîáðàæåíèå. Îøèáêà CRC íàéäåíà â ôàéëû %s.'; gesCompression = 'Íåâîçìîæíî çàãðóæèòü èçîáðàæåíèå. Îøèáêà ñæàòèÿ â ôàéëå %s.'; gesExtraCompressedData = 'Íåâîçìîæíî çàãðóæèòü èçîáðàæåíèå. Äîïîëíèòåëüíûå äàííûå íàéäåíû â ôàéëå %s.'; gesInvalidPalette = 'Íåâîçìîæíî çàãðóæèòü èçîáðàæåíèå. Íåïðàâèëüíàÿ ïàëèòðà â ôàéëå %s.'; // features (usually used together with unsupported feature string) gesCompressionScheme = 'Ñõåìà ñæàòèÿ '; gesPCDImageSize = 'Ðàçìåðû èçîáðàæåíèÿ, îòëè÷íûå îò Base16, Base4 or Base '; gesRLAPixelFormat = 'Ôîðìàòû èçîáðàæåíèé, îòëè÷íûå îò RGB and RGBA '; gesPSPFileType = 'Âåðñèè ôîðìàòà ôàéëà, îòëè÷íûå îò 3é èëè 4é '; // errors which apply only to specific image types gesUnknownCriticalChunk = 'Íåâîçìîæíî çàãðóçèòü èçîáðàæåíèå PNG. Îáíàðóæåíà íåîæèäàííàÿ, íî êðèòè÷åñêàÿ îøèáêà.'; // color manager error messages gesIndexedNotSupported = 'Êîíâåðñèÿ ìåæäó èíäåêñèðîâàííûìè è íå-èíäåêñèðîâàííûìè ôîðìàòàìè èçîáðàæåíèé íå ïîääåðæèâàåòñÿ.'; gesConversionUnsupported = 'Öâåòîâàÿ êîíâåðñèÿ íå ïîääåðæèâàåòñÿ. Íå âîçìîæíî íàéòè ïðàâèëüíûé ìåòîä.'; gesInvalidSampleDepth = 'Íåïðàâèëüíàÿ öâåòîâàÿ ãëóáèíà. Ïîääåðæèâàåòñÿ ãëóáèíà â áèòàõ: 1, 2, 4, 8, or 16.'; gesInvalidPixelDepth = 'Ãëóáèíà èçîáðàæåíèÿ â áèòàõ íå ïîäõîäèò ê òåêóùåé öâåòîâîé ñõåìå.'; //---------------------------------------------------------------------------------------------------------------------- implementation //---------------------------------------------------------------------------------------------------------------------- end. --- NEW FILE: JPG.pas --- unit JPG; interface {$Z4} // Minimum enum size = dword uses Windows, SysUtils, Classes, Graphics; type TJPGColorDepth = (jpgAuto, jpgGray, jpg8Bit, jpg24Bit); TJPEGPixelFormat = (jf24Bit, jf8Bit); const JPEG_SUSPENDED = 0; { Suspended due to lack of input data } JPEG_HEADER_OK = 1; { Found valid image datastream } JPEG_HEADER_TABLES_ONLY = 2; { Found valid table-specs-only datastream } { If you pass require_image = TRUE (normal case), you need not check for a TABLES_ONLY return code; an abbreviated file will cause an error exit. [...1064 lines suppressed...] end; end; //---------------------------------------------------------------------------------------------------------------------- initialization with jpeg_std_error do begin error_exit := @JpegError; emit_message := @EmitMessage; output_message := @OutputMessage; format_message := @FormatMessage; reset_error_mgr := @ResetErrorMgr; end; end. --- NEW FILE: MZLib.pas --- unit MZLib; // Original copyright of the creators: // // zlib.H -- interface of the 'zlib' general purpose compression library version 1.1.0, Feb 24th, 1998 // // Copyright (C) 1995-1998 Jean-loup Gailly and Mark Adler // // This software is provided 'as-is', without any express or implied warranty. In no event will the authors be held // liable for any damages arising from the use of this software. // // Permission is granted to anyone to use this software for any purpose, including commercial applications, and to alter // it and redistribute it freely, subject to the following restrictions: // 1. The origin of this software must not be misrepresented; you must not claim that you wrote the original software. // If you use this software in a product, an acknowledgment in the product documentation would be appreciated but is // not required. // 2. Altered source versions must be plainly marked as such, and must not be misrepresented as being the original software. // 3. This notice may not be removed or altered from any Source distribution. // [...5705 lines suppressed...] end; //---------------------------------------------------------------------------------------------------------------------- function IsInflateSyncPoint(var Z: TZState): Integer; // Returns 1 if Inflate is currently at the end of a block generated by Z_SYNC_FLUSH or Z_FULL_FLUSH. // This function is used by one PPP implementation to provide an additional safety Check. PPP uses Z_SYNC_FLUSH but // removes the length bytes of the resulting empty stored block. When decompressing, PPP checks that at the end of input // packet, Inflate is waiting for these length bytes. begin if (Z.State = nil) or (Z.State.blocks = nil) then Result := Z_STREAM_ERROR else Result := Ord(IsInflateBlocksSynchPoint(Z.State.blocks^)); end; //---------------------------------------------------------------------------------------------------------------------- end. |
