glxtreem-commits Mailing List for GLXTreem

Brought to you by: andreaz

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

Flat | Threaded

1 2 3 4 > >> (Page 1 of 4)

[Glxtreem-commits] GLXtreem/Source/models - New directory

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

[Glxtreem-commits] GLXtreem/Source GLXSound.pas,NONE,1.1

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.

[Glxtreem-commits] GLXtreem/Source/fmod fmod.dll,NONE,1.1 fmod.pas,1.1,1.2 fmoddyn.pas,1.1,1.2 fmodtypes.pas,1.1,1.2

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.)

[Glxtreem-commits] GLXtreem/Source/Designtime GLXSoundEditor.dfm,NONE,1.1 GLXSoundEditor.pas,NONE,1.1 GLXRegister.pas,1.4,1.5 GLXStringListEditor.dfm,1.1,1.2

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;

[Glxtreem-commits] GLXtreem/Source GLXResource.pas,1.3,1.4

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

[Glxtreem-commits] GLXtreem/Packages GLXtreem_6.dpk,1.1,1.2 GLXtreem_6.res,1.1,1.2

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

[Glxtreem-commits] GLXtreem/Source/Designtime GLXResourceEditor.dfm,NONE,1.1 GLXResourceEditor.pas,NONE,1.1 GLXRegister.pas,1.3,1.4 GLXResourceSourceEditor.dfm,1.1,1.2 GLXResourceSourceEditor.pas,1.2,1.3

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.

[Glxtreem-commits] GLXtreem/Source GLXResource.pas,1.2,1.3

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

[Glxtreem-commits] GLXtreem/Source GLXTexture.pas,1.3,1.4

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.

[Glxtreem-commits] GLXtreem/Source/Designtime GLXTextureEditor.dfm,NONE,1.1 GLXTextureEditor.pas,NONE,1.1 GLXResourceSourceEditor.pas,1.1,1.2

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

[Glxtreem-commits] GLXtreem/Source GLXResource.pas,1.1,1.2 GLXTerrain.pas,1.2,1.3

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;
!       }
  
  //------------------------------------------------------------------------------

[Glxtreem-commits] GLXtreem/Source/Designtime GLXRegister.pas,1.2,1.3

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;

[Glxtreem-commits] GLXtreem/Source/Designtime GLXRegister.pas,1.1,1.2

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,

[Glxtreem-commits] GLXtreem/Source/Designtime GLXResourceSourceEditor.dfm,NONE,1.1 GLXResourceSourceEditor.pas,NONE,1.1 GLXStringListEditor.dfm,NONE,1.1 GLXStringListEditor.pas,NONE,1.1

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.

[Glxtreem-commits] GLXtreem/Source GLXResource.pas,NONE,1.1 HashTables.pas,NONE,1.1

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.

[Glxtreem-commits] GLXtreem/Source/GraphicEx JCAPIMIN.OBJ,NONE,1.1 JCAPISTD.OBJ,NONE,1.1 JCCOEFCT.OBJ,NONE,1.1 JCCOLOR.OBJ,NONE,1.1 JCDCTMGR.OBJ,NONE,1.1 JCHUFF.OBJ,NONE,1.1 JCINIT.OBJ,NONE,1.1 JCMAINCT.OBJ,NONE,1.1 JCMARKER.OBJ,NONE,1.1 JCMASTER.OBJ,NONE,1.1 JCOMAPI.OBJ,NONE,1.1 JCPARAM.OBJ,NONE,1.1 JCPHUFF.OBJ,NONE,1.1 JCPREPCT.OBJ,NONE,1.1 JCSAMPLE.OBJ,NONE,1.1 JCTRANS.OBJ,NONE,1.1 JDAPIMIN.OBJ,NONE,1.1 JDAPISTD.OBJ,NONE,1.1 JDATADST.OBJ,NONE,1.1 JDATASRC.OBJ,NONE,1.1 JDCOEFCT.OBJ,NONE,1.1 JDCOLOR.OBJ,NONE,1.1 JDDCTMGR.OBJ,NONE,1.1 JDHUFF.OBJ,NONE,1.1 JDINPUT.OBJ,NONE,1.1 JDMAINCT.OBJ,NONE,1.1 JDMARKER.OBJ,NONE,1.1 JDMASTER.OBJ,NONE,1.1 JDMERGE.OBJ,NONE,1.1 JDPHUFF.OBJ,NONE,1.1 JDPOSTCT.OBJ,NONE,1.1 JDSAMPLE.OBJ,NONE,1.1 JDTRANS.OBJ,NONE,1.1 JERROR.OBJ,NONE,1.1 JFDCTFLT.OBJ,NONE,1.1 JFDCTFST.OBJ,NONE,1.1 JFDCTINT.OBJ,NONE,1.1 JIDCTFLT.OBJ,NONE,1.1 JIDCTFST.OBJ,NONE,1.1 JIDCTINT.OBJ,NONE,1.1 JIDCTRED.OBJ,NONE,1.1 JMEMMGR.OBJ,NONE,1.1 JMEMNOBS.OBJ,NONE,1.1 JPEGTRAN.OBJ,NONE,1.1 JQUANT1.OBJ,NONE,1.1 JQUANT2.OBJ,NONE,1.1 JUTILS.OBJ,NONE,1.1

From: Markus L?d. <dan...@us...> - 2004-03-31 02:25:10

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.)

[Glxtreem-commits] GLXtreem/Source GLXImageList.pas,1.1,1.2 GLXTerrain.pas,1.1,1.2

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;
+

[Glxtreem-commits] GLXtreem/Source GLXDraws.pas,1.2,1.3 GLXNotification.pas,1.1,1.2 GLXPrimitives.pas,1.1,1.2 GLXTexture.pas,1.1,1.2 GLXTimer.pas,1.3,1.4

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;

[Glxtreem-commits] GLXtreem/Source GLXTimer.pas,1.2,1.3

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;

[Glxtreem-commits] GLXtreem/Source GLXDraws.pas,1.1,1.2

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;

[Glxtreem-commits] GLXtreem/Source GLXTimer.pas,1.1,1.2

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;

[Glxtreem-commits] GLXtreem/Packages GLXtreem_6.dpk,NONE,1.1 GLXtreem_6.res,NONE,1.1

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.)

[Glxtreem-commits] GLXtreem/Demos Project1.dpr,NONE,1.1 Project1.res,NONE,1.1 Unit1.dfm,NONE,1.1 Unit1.pas,NONE,1.1 crate.bmp,NONE,1.1

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.)

[Glxtreem-commits] GLXtreem/Demos - New directory

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

[Glxtreem-commits] GLXtreem/Source/GraphicEx GraphicColor.pas,NONE,1.1 GraphicCompression.pas,NONE,1.1 GraphicConfiguration.inc,NONE,1.1 GraphicEx.pas,NONE,1.1 GraphicStrings.pas,NONE,1.1 GraphicStringsDE.pas,NONE,1.1 GraphicStringsFR.pas,NONE,1.1 GraphicStringsRU.pas,NONE,1.1 JPG.pas,NONE,1.1 MZLib.pas,NONE,1.1

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.

Flat | Threaded

1 2 3 4 > >> (Page 1 of 4)